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

fix 'qml-ui-vars', see '(qml)'

Browse source
This commit is contained in:
polos 2021-04-05 11:54:05 +02:00
parent 8c6a45d9e4
commit dab9b53283
1 changed files with 10 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -11,6 +11,8 @@
;;; - call '(eql:qml)'
;;; - generated file is 'lisp/ui-vars.lisp' (replaced without warning)
;;(pushnew :sailfish *features*) ; for testing
(defpackage qml-ui-variables
(:use :cl :eql))
@ -46,55 +48,13 @@
(defun one-space (string)
(x:join (remove-if 'x:empty-string (x:split string))))
#+sailfish
(defun grep (name)
(ext:run-program "sh" (list "-c"
(format nil "find qml/ -name *.qml -print0 | xargs -0 grep -rn \"objectName:[[:space:]]*\\\"~A\\\"\""
name))))
#-sailfish
(defun grep (name)
(let ((s (ext:run-program "grep" (list "-rn" "--include" "*.qml"
(format nil "objectName:[[:space:]]*~S"
name)
"qml/"))))
(let ((s (ext:run-program "sh" (list "-c"
(format nil "find qml/ -name *.qml -print0 | xargs -0 grep -rn \"objectName:[[:space:]]*\\\"~A\\\"\""
name)))))
(loop :for line = (read-line s nil nil)
:while line :collect (one-space line))))
#+sailfish
(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
(search ".qml:" 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=)))
(print (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)))
#-sailfish
(defun collect ()
(setf *qml-items*
(sort* (sort* (filter *qml-items*)
@ -104,6 +64,7 @@
(max-class 0)
collected not-unique grepped)
(dolist (item *qml-items*)
(print item)
(let* ((name (|objectName| item))
(class* (class-name* item))
(grep (grep name))
@ -114,6 +75,10 @@
(not (find (first grep) grepped :test 'string=))))
(when (and (find name not-unique :test 'string=)
(rest occur))
#+sailfish
(princ (format nil "~%~%### QML: not unique:~%~%~A~%~%"
(x:join grep #\Newline)))
#-sailfish
(qmsg (format nil "<font color=red>QML: not unique:</font><br><pre>~A</pre>"
(x:join grep #\Newline)))
(return-from collect :error))