added support for running an update thread; but am not using it yet

1 files changed, 24 insertions, 1 deletions

diff --git a/fussy.lisp b/fussy.lisp
index 692c911..04c3592 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -233,7 +233,9 @@ returns a list of those names."
     :documentation "These paths are by default equal to the config directory.")
    (port :std 8888)
    (domain :std "localhost")
-   (address :std "0.0.0.0")))
+   (address :std "0.0.0.0")
+   (fetch-time :std (list 0 0)
+               :documentation "(Hour Minute) at which fussy updates its themes.")))
 
 
 (defvar *config* nil)
@@ -320,6 +322,27 @@ that they are not loaded during image gen.")
           (or variant (pathname-name (first (image-files-for-theme theme))))))
 
 
+(defun the-update-time ()
+  (multiple-value-bind (sec min hour date month year) (get-decoded-time)
+    (declare (ignore min hour))
+    (destructuring-bind (hh mm) (fetch-time *config*)
+      (encode-universal-time sec mm hh date month year))))
+
+(defun time-to-update-p ()
+  (<= (abs (- (get-universal-time) (the-update-time))) 60))
+
+(defvar *fetcher-thread* nil)
+
+(defun start-fetch-thread ()
+  (setf *fetcher-thread*
+        (bt:make-thread
+         (lambda ()
+           (loop :while t
+                 :when (time-to-update-p)
+                   :do (handler-case (update-theme-packages)
+                         (error (e) (format *error-output* "~a while updating." e)))
+                 :do (sleep 59))))))
+
 (defun start (&key config-file)
   (unless config-file
     (setf config-file