sfos/eql5
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

revision of 'lib/qml-ui-vars.lisp'

Browse source
This commit is contained in:
polos 2020-07-24 13:44:43 +02:00
parent ca22ff0254
commit a29abb19b9
1 changed files with 46 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

83
lib/qml-ui-vars.lisp
View file

@ -44,14 +44,15 @@
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))))
(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*
@ -64,21 +65,26 @@
(dolist (item *qml-items*)
(let* ((name (|objectName| item))
(class* (class-name* item))
(grep (ignore-errors (read-line (grep name)))))
(grep (grep name))
(occur (mapcar (lambda (x) (find x grepped :test 'string=))
grep)))
(when (and grep
(not (find grep grepped :test 'string=)))
(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 grep 0 (position #\: grep)))
(subseq (first grep) 0 (position #\: (first 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=)
(dolist (gr grep)
(pushnew gr grepped :test 'string=))
(pushnew name not-unique :test 'string=))))
(values (setf collected (nreverse collected))
max-name
@ -87,25 +93,27 @@
(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)))
(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 "(defvar *~A*~A ~S)~A ; ~A~A ~S~%"
(first item)
diff-name
(second item)
diff-name
(third item)
diff-class
(fourth item))))
(terpri)
t)))
(defun run ()
(let ((ui "lisp/ui-vars.lisp"))
@ -118,8 +126,9 @@
(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))))
(if (write-ui-file out)
(format t "~%UI file generated: ~S~%~%" ui)
(format t "~%File not generated, please correct names and try again.~%~%")))))
(run)