add save-theme/load-theme persistence

org/theme.org

@@ -50,7 +50,8 @@ and the backend's ~*theme-colors*~ for SGR resolution.
   (:use :cl :cl-tty.backend)
   (:export
    #:theme #:make-theme #:theme-mode
-   #:theme-color #:load-preset #:define-preset))
+   #:theme-color #:load-preset #:define-preset
+   #:save-theme #:load-theme))
 (in-package :cl-tty.theme)
 #+END_SRC
 
@@ -395,5 +396,43 @@ contrast than default, designed for reduced eye strain.
           :markdown-link "#81A1C1" :markdown-quote "#8F9BB3"
           :syntax-keyword "#81A1C1" :syntax-function "#A3BE8C"
           :syntax-string "#D08770" :syntax-number "#B48EAD"
-          :syntax-comment "#8F9BB3" :syntax-type "#88C0D0"))
+           :syntax-comment "#8F9BB3" :syntax-type "#88C0D0"))
+#+END_SRC
+
+** Persistence
+
+The theme system provides functions to save and restore a theme's role
+map to and from a Lisp data file. The file format is an alist of
+~(role . hex)~ pairs, written by ~prin1~ and read with ~read~.
+
+*** defun save-theme
+
+Serialises the theme's role hash table to a file. Each ~(role . hex)~
+pair is written as a cons cell in an alist.
+
+#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
+(defun save-theme (theme path)
+  "Persist THEME's role map to file at PATH as an alist."
+  (ensure-directories-exist path)
+  (with-open-file (out path :direction :output :if-exists :supersede)
+    (let (alist)
+      (maphash (lambda (k v) (push (cons k v) alist)) (theme-roles theme))
+      (prin1 (nreverse alist) out))
+    t))
+#+END_SRC
+
+*** defun load-theme
+
+Restores a theme's role map from a file previously written by
+~save-theme~. The file is an alist of ~(role . hex)~ pairs. If the
+file does not exist, returns nil silently.
+
+#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
+(defun load-theme (theme path)
+  "Restore THEME's role map from file at PATH.
+Returns T on success, nil if the file does not exist."
+  (when (probe-file path)
+    (with-open-file (in path :direction :input)
+      (dolist (pair (read in) t)
+        (setf (gethash (car pair) (theme-roles theme)) (cdr pair))))))
 #+END_SRC