Add a models module and an agendaFilesModel within it

harbour-sextant.pro

@@ -11,6 +11,10 @@
 
 LISP_FILES = make.lisp \
     lisp/system-index.txt \
+    lisp/local-projects/sextant/models/all.lisp \
+    lisp/local-projects/sextant/models/utils.lisp \
+    lisp/local-projects/sextant/models/models.lisp \
+    lisp/local-projects/sextant/models/files-model.lisp \
     lisp/local-projects/sextant/options/all.lisp \
     lisp/local-projects/sextant/options/config.lisp \
     lisp/local-projects/sextant/options/options.lisp \

lisp/local-projects/sextant/models/all.lisp

@@ -0,0 +1,6 @@
+(uiop:define-package :sextant/models/all
+  (:nicknames :models)
+  (:use-reexport
+   :sextant/models/utils
+   :sextant/models/models
+   :sextant/models/files-model))

lisp/local-projects/sextant/models/files-model.lisp

@@ -0,0 +1,58 @@
+(uiop:define-package :sextant/models/files-model
+  (:use :cl :eql
+        :sextant/options/options
+        :sextant/models/utils)
+  (:export #:populate-agenda-files
+           #:make-agenda-files-model))
+(in-package :sextant/models/files-model)
+
+(define-roles #.|Qt.UserRole|
+  +filename-role+)
+
+(defvar *agenda-files-list* nil)
+(defvar *agenda-files-model* nil)
+
+(defun populate-agenda-files (files)
+  (when *agenda-files-model*
+    (|beginResetModel| *agenda-files-model*))
+  (setf *agenda-files-list*
+        (mapcar (lambda (dir)
+                  (cons dir (directory (merge-pathnames "**/*.org" dir))))
+                files))
+  (when *agenda-files-model*
+    (|endResetModel| *agenda-files-model*)))
+
+(defun make-agenda-files-model ()
+  (let ((model (qnew "QAbstractListModel")))
+    (qoverride model "rowCount(QModelIndex)"
+               (lambda (index)
+                 (declare (ignore index))
+                 (let ((len 0))
+                   (mapc (lambda (list)
+                           (incf len (length (cdr list))))
+                         *agenda-files-list*)
+                   len)))
+    (qoverride model "data(QModelIndex,int)"
+               (lambda (index role)
+                 (let* ((row (|row| index))
+                        section
+                        (item (when (> row -1)
+                                (loop for list = *agenda-files-list* then (cdr list)
+                                      while list
+                                      do (progn
+                                           (setf section (caar list))
+                                           (if (>= row (length (cdar list)))
+                                               (decf row (length (cdar list)))
+                                               (return (nth row (cdar list)))))))))
+                   (if item
+                       (case role
+                         (#.+filename-role+
+                          (qvariant-from-value (enough-namestring item (truename section)) "QString")))
+                       *empty-variant*))))
+    (qoverride model "roleNames()"
+               (lambda ()
+                 (list (cons +filename-role+ "filename"))))
+    (when *agenda-files-model*
+      (qdelete *agenda-files-model*))
+    (setf *agenda-files-model* model)
+    (|setContextProperty| (|rootContext| qml:*quick-view*) "agendaFilesModel" *agenda-files-model*)))

lisp/local-projects/sextant/models/models.lisp

@@ -0,0 +1,7 @@
+(uiop:define-package :sextant/models/models
+  (:use :cl :eql :sextant/models/files-model)
+  (:export #:make-models))
+(in-package :sextant/models/models)
+
+(defun make-models ()
+  (make-agenda-files-model))

lisp/local-projects/sextant/models/utils.lisp

@@ -0,0 +1,12 @@
+(uiop:define-package :sextant/models/utils
+  (:use :cl :eql)
+  (:export #:define-roles
+           #:*empty-variant*))
+(in-package :sextant/models/utils)
+
+(defmacro define-roles (start &rest roles)
+  (let ((n start))
+    `(progn
+       ,@(mapcar (lambda (role) `(defconstant ,role ,(incf n))) roles))))
+
+(defvar *empty-variant* (qnew "QVariant"))

lisp/local-projects/sextant/sextant.asd

@@ -6,7 +6,9 @@
                     (proclaim '(optimize (debug 3) (safety 3) (speed 0)))
                     (funcall thunk))
   :depends-on #.(append (uiop:read-file-form (merge-pathnames #p"dependencies.sexp" (or *load-pathname* *compile-file-pathname*)))
-                        '("sextant/options/all"))
+                        '("sextant/options/all")
+                        '("sextant/models/all"))
   :components ((:file "sextant")))
 
 (register-system-packages "sextant/options/all" '(:options))
+(register-system-packages "sextant/models/all" '(:models))

lisp/local-projects/sextant/sextant.lisp

@@ -1,5 +1,5 @@
 (uiop:define-package :sextant
-  (:use :cl :eql :options)
+  (:use :cl :eql :options :models)
   (:export #:start-slynk
            #:stop-slynk
            #:slynkp
@@ -28,8 +28,10 @@
 
   (defun slynkp () slynkp))
 
-(defun setup-config ()
-  (load-config-file "config.lisp"))
+(defun setup ()
+  (load-config-file "config.lisp")
+  (populate-agenda-files agenda-files)
+  (make-models))
 
 (defun cleanup ()
   (save-config-file "config.lisp"))
@@ -39,7 +41,7 @@
   (qrun #'qquit))
 
 (defun start ()
-  (setup-config)
+  (setup)
   (when slynk-at-startup-p
     (start-slynk))
   (ext:catch-signal ext:+SIGTERM+ :catch)

qml/pages/Files.qml

@@ -14,12 +14,11 @@ Page {
             title: qsTr("Files")
         }
 
-        model: ListModel {
-            ListElement { filename: "org.org"; datetime: "8 oct 2020"}
-        }
+        model: agendaFilesModel
 
         delegate: ListItem {
             id: fileItem
+
             anchors {
                 left: parent.left
                 right: parent.right
@@ -27,8 +26,7 @@ Page {
             contentHeight: Theme.itemSizeSmall
 
             Label {
-                id: filename
-                text: model.filename
+                text: filename
                 anchors {
                     top: parent.top
                     left: parent.left
@@ -38,8 +36,7 @@ Page {
             }
 
             Label {
-                id: datetime
-                text: model.datetime
+                text: "datetime"
                 anchors {
                     bottom: parent.bottom
                     right: parent.right