Add a config save / load facility

harbour-sextant.pro

@@ -11,6 +11,7 @@
 
 LISP_FILES = make.lisp \
     lisp/system-index.txt \
+    lisp/local-projects/sextant/config.lisp \
     lisp/local-projects/sextant/sextant.lisp \
     lisp/local-projects/sextant/sextant.asd
 

lisp/local-projects/sextant/config.lisp

@@ -0,0 +1,83 @@
+(defpackage :config
+  (:use :cl)
+  (:export #:enumerate-config-symbols
+           #:set-config
+           #:get-config-from-string
+           #:get-config
+           #:defconfig
+           #:load-config-file
+           #:save-config-file))
+(defpackage :config-internal
+  (:use :cl))
+(in-package :config)
+
+(defvar config-probe ";;; Auto generated from here, do not edit")
+(defvar config-list nil
+  "List of values registered as configuration.")
+
+(defun enumerate-config-symbols () (mapcar #'first config-list))
+
+(defun sym (symbol package)
+  (intern (symbol-name symbol) package))
+
+(defun set-config (symbol value)
+  (setf (symbol-value (sym symbol :config-internal)) value))
+
+(defun config-file (filename)
+  (merge-pathnames (concatenate 'string "harbour-sextant/" filename)
+                   (uiop:xdg-config-pathname)))
+
+(defun get-config-from-string (symbol)
+  (symbol-value (intern (string-upcase symbol) :config-internal)))
+
+(defmacro get-config (symbol)
+  (get-config-from-string (if (stringp symbol) symbol (symbol-name symbol))))
+
+(defun %defconfig (symbol default doc-string)
+  (proclaim '(special symbol))
+  (setf (symbol-value symbol) default)
+  (when doc-string
+    (setf (documentation symbol 'variable) doc-string)))
+
+(defmacro defconfig (symbol default &optional doc-string)
+  `(let ((interned (intern (symbol-name ',symbol) :config-internal)))
+     (unless (member interned config-list :key #'car)
+       (push (list interned ',default ,doc-string) config-list))))
+
+(defun load-config-file (filename)
+  "Load `filename' from standard config path."
+  (mapc (lambda (config)
+          (%defconfig (first config) (second config) (third config)))
+        config-list)
+  (let ((config-pathname (config-file filename)))
+    (when (probe-file config-pathname)
+      (load config-pathname))))
+
+(defun save-config-file (filename)
+  "Save config values to `filename'."
+  (let* ((config-pathname (config-file filename))
+         (config-string (with-open-file (stream config-pathname :if-does-not-exist nil)
+                          (when stream
+                            (let ((str (make-string (file-length stream))))
+                              (read-sequence str stream)
+                              str)))))
+    (with-open-file (stream (ensure-directories-exist config-pathname)
+                            :direction :output :if-exists :supersede)
+      (if config-string
+          (let ((pos (search config-probe config-string)))
+            (princ (subseq config-string 0 pos) stream))
+          (progn
+            (princ ";;; Configuration file for Sextant" stream)
+            (terpri stream)
+            (princ ";;; You are free to edit this section" stream)
+            (terpri stream)
+            (terpri stream)))
+      (princ config-probe stream)
+      (terpri stream)
+      (princ "(in-package :config-internal)" stream)
+      (terpri stream)
+      (mapc (lambda (config-pair)
+              (format stream "~%(setf ~(~a~) ~s)" (symbol-name (first config-pair))
+                      (symbol-value (first config-pair))))
+            config-list)
+      (terpri stream))))

lisp/local-projects/sextant/sextant.asd

@@ -5,5 +5,6 @@
   :around-compile (lambda (thunk)
                     (proclaim '(optimize (debug 3) (safety 3) (speed 0)))
                     (funcall thunk))
-  :depends-on ("alexandria")
-  :components ((:file "sextant")))
+  :depends-on ("alexandria" "uiop")
+  :components ((:file "config")
+               (:file "sextant")))

lisp/local-projects/sextant/sextant.lisp

@@ -1,6 +1,8 @@
 (defpackage :sextant
-  (:use :cl :eql)
-  (:export #:start))
+  (:use :cl :eql :config)
+  (:export #:update-config
+           #:start
+           ))
 (in-package :sextant)
 
 (qrequire :quick)
@@ -21,7 +23,20 @@
   (when (find-package :slynk)
     (funcall (sym 'stop-server :slynk) 4005)))
 
+(defun setup-config ()
+  (defconfig agenda-files "~/Documents/org/")
+  (load-config-file "sextant.lisp"))
+
+(defun update-config ()
+  "Update all configuration values set in Settings page."
+  (loop for c in (config::enumerate-config-symbols)
+        do (let ((property (string-downcase (symbol-name c))))
+             (set-config c (qget qml:*caller* property))
+             (format t "(set-config ~a ~s)~%" c (qget qml:*caller* property))))
+  (save-config-file "config"))
+
 (defun start ()
+  (setup-config)
   #+sextant-repl
   (start-slynk)
   (qconnect qml:*quick-view* "statusChanged(QQuickView::Status)"