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