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

adapt '(qml)' for Sailfish

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

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

@ -16,8 +16,8 @@
(in-package :qml-ui-variables)
(defparameter *qml-items* (qfind-children #+sailfish (qml:root-item)
#-sailfish qml:*quick-view*))
(defparameter *qml-items* #+sailfish (cons (qml:root-item) (qfind-children (qml:root-item)))
#-sailfish (qfind-children qml:*quick-view*))
(defun class-name* (item)
(let ((name (|className| (|metaObject| item))))
@ -43,16 +43,58 @@
: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"
#-sailfish "--include" #-sailfish "*.qml"
(format nil "objectName:[[:space:]]*~S" name)
"qml/"))))
(loop :for line = (read-line s nil nil)
:while line :collect (one-space line)))))
(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/"))))
(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*)