;;; 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)