mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-06 10:31:19 -08:00
125 lines
4.4 KiB
Common Lisp
125 lines
4.4 KiB
Common Lisp
;;; generate global vars in a package named :ui for all QML items with
|
|
;;; 'objectName' set
|
|
;;;
|
|
;;; this expects all QML files to be under 'qml/'
|
|
;;;
|
|
;;; since 'objectName' must be unique, an error message box will be shown
|
|
;;; if more than one occurrence of the same name is found
|
|
;;;
|
|
;;; usage:
|
|
;;; - run app, e.g. 'eql5 run.lisp' (use -qtpl if called from the console)
|
|
;;; - call '(eql:qml)'
|
|
;;; - generated file is 'lisp/ui-vars.lisp' (replaced without warning)
|
|
|
|
(defpackage qml-ui-variables
|
|
(:use :cl :eql))
|
|
|
|
(in-package :qml-ui-variables)
|
|
|
|
(defparameter *warn-if-exists* nil)
|
|
|
|
(defparameter *qml-items* (qfind-children qml:*quick-view*))
|
|
|
|
(defun class-name* (item)
|
|
(let ((name (|className| (|metaObject| item))))
|
|
(subseq name
|
|
(let ((start 0))
|
|
(dolist (q '("QDeclarative" "QQuick" "QQml" "Qml"))
|
|
(when (x:starts-with q name)
|
|
(setf start (length q))
|
|
(return)))
|
|
start)
|
|
(position #\_ name))))
|
|
|
|
(defun sort* (list key &optional stable)
|
|
(funcall (if stable 'stable-sort 'sort)
|
|
list 'string< :key key))
|
|
|
|
(defun filter (list)
|
|
(remove-if (lambda (it)
|
|
(or (x:empty-string (|objectName| it))
|
|
(find (class-name* it)
|
|
'("MnemonicLabel") ; exclude internal items
|
|
:test 'string=)))
|
|
list))
|
|
|
|
(defun grep (name)
|
|
(ext:run-program "grep" (list "-rn"
|
|
"--include"
|
|
"*.qml"
|
|
(format nil "objectName:[[:space:]]*~S" name)
|
|
"qml/")))
|
|
|
|
(defun one-space (string)
|
|
(x:join (remove-if 'x:empty-string (x:split string))))
|
|
|
|
(defun collect ()
|
|
(setf *qml-items*
|
|
(sort* (sort* (filter *qml-items*)
|
|
'|objectName| t)
|
|
'class-name*))
|
|
(let ((max-name 0)
|
|
(max-class 0)
|
|
collected not-unique grepped)
|
|
(dolist (item *qml-items*)
|
|
(let* ((name (|objectName| item))
|
|
(class* (class-name* item))
|
|
(grep (ignore-errors (read-line (grep name)))))
|
|
(when (and grep
|
|
(not (find grep grepped :test 'string=)))
|
|
(push (list (substitute #\- #\_ name)
|
|
name
|
|
class*
|
|
(subseq grep 0 (position #\: grep)))
|
|
collected)
|
|
(setf max-name (max (length name) max-name)
|
|
max-class (max (length class*) max-class))
|
|
(when (and (find name not-unique :test 'string=)
|
|
(not (find grep grepped :test 'string=)))
|
|
(qmsg (format nil "<font color=red>QML: not unique:</font><br><pre>~A</pre>"
|
|
(one-space (read-line (grep name))))))
|
|
(pushnew grep grepped :test 'string=)
|
|
(pushnew name not-unique :test 'string=))))
|
|
(values (setf collected (nreverse collected))
|
|
max-name
|
|
max-class)))
|
|
|
|
(defun write-ui-file (out &optional (ui-package "ui"))
|
|
(multiple-value-bind (items max-name max-class)
|
|
(collect)
|
|
(format out ";;; THIS FILE IS GENERATED, see '(eql:qml)'~
|
|
~%~
|
|
~%(defpackage ~(~A~)~% (:use :cl :eql)"
|
|
ui-package)
|
|
(format out "~% (:export~{~% #:*~A*~}))~%~%"
|
|
(sort (mapcar 'first items) 'string<))
|
|
(format out "(provide :ui-vars)~%~%(in-package ~(:~A~))~%~%" ui-package)
|
|
(dolist (item items)
|
|
(let ((diff-name (make-string (- max-name (length (first item)))))
|
|
(diff-class (make-string (- max-class (length (third item))))))
|
|
(format out "(defvar *~A*~A ~S)~A ; ~A~A ~S~%"
|
|
(first item)
|
|
diff-name
|
|
(second item)
|
|
diff-name
|
|
(third item)
|
|
diff-class
|
|
(fourth item))))
|
|
(terpri)))
|
|
|
|
(defun run ()
|
|
(let ((ui "lisp/ui-vars.lisp"))
|
|
(when (and *warn-if-exists*
|
|
(probe-file ui)
|
|
(/= |QMessageBox.Yes|
|
|
(|question.QMessageBox| nil "Replace?"
|
|
(format nil "File ~S already exists.<br>Replace it?" ui)
|
|
(logior |QMessageBox.Yes| |QMessageBox.Cancel|))))
|
|
(return-from run))
|
|
(ensure-directories-exist ui)
|
|
(with-open-file (out ui :direction :output :if-exists :supersede)
|
|
(write-ui-file out)
|
|
(format t "~%UI file generated: ~S~%~%" ui))))
|
|
|
|
(run)
|
|
|