mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-06 10:31:19 -08:00
131 lines
4.8 KiB
Common Lisp
131 lines
4.8 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 *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)
|
|
(flet ((one-space (s)
|
|
(x:join (remove-if 'x:empty-string (x:split s)))))
|
|
(let ((s (ext:run-program "grep" (list "-rn"
|
|
"--include"
|
|
"*.qml"
|
|
(format nil "objectName:[[:space:]]*~S" name)
|
|
"qml/"))))
|
|
(loop :for line = (read-line s nil nil)
|
|
:while line :collect (one-space line)))))
|
|
|
|
(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 (grep name))
|
|
(occur (mapcar (lambda (x) (find x grepped :test 'string=))
|
|
grep)))
|
|
(when (and grep
|
|
(or (rest grep)
|
|
(not (find (first grep) grepped :test 'string=))))
|
|
(when (and (find name not-unique :test 'string=)
|
|
(rest occur))
|
|
(qmsg (format nil "<font color=red>QML: not unique:</font><br><pre>~A</pre>"
|
|
(x:join grep #\Newline)))
|
|
(return-from collect :error))
|
|
(push (list (substitute #\- #\_ name)
|
|
name
|
|
class*
|
|
(subseq (first grep) 0 (position #\: (first grep))))
|
|
collected)
|
|
(setf max-name (max (length name) max-name)
|
|
max-class (max (length class*) max-class))
|
|
(dolist (gr grep)
|
|
(pushnew gr 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)
|
|
(unless (eql :error items)
|
|
(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 "(defparameter *~A*~A ~S)~A ; ~A~A ~S~%"
|
|
(first item)
|
|
diff-name
|
|
(second item)
|
|
diff-name
|
|
(third item)
|
|
diff-class
|
|
(fourth item))))
|
|
(terpri out)
|
|
t)))
|
|
|
|
(defun run ()
|
|
(let ((ui "lisp/ui-vars.lisp.try"))
|
|
(ensure-directories-exist ui)
|
|
(with-open-file (out ui :direction :output :if-exists :supersede)
|
|
(if (write-ui-file out)
|
|
(progn
|
|
(let ((new (subseq ui 0 (- (length ui) #.(length ".try")))))
|
|
(when (probe-file new)
|
|
(delete-file new))
|
|
(rename-file ui (file-namestring new))
|
|
(format t "~%UI file generated: ~S~%~%" new)
|
|
(load new))) ; make changes available immediately
|
|
(format t "~%File not generated, please correct names and try again.~%~%")))))
|
|
|
|
(run)
|
|
|