summaryrefslogtreecommitdiff
path: root/fussy.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'fussy.lisp')
-rw-r--r--fussy.lisp57
1 files changed, 31 insertions, 26 deletions
diff --git a/fussy.lisp b/fussy.lisp
index bfe31a8..2b419ee 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -93,9 +93,6 @@ the emacs' reader readtable."
(theme-pkg-keywords pkg) (cdr (assoc :keywords meta-alist))))))
-(defvar *update-batch* nil
- "Collected archive-packages in need of further processing.")
-
(defun process-archive-theme (archive-theme)
;; ugg this is ugly. I hate it when code is all dense like this.
(a:if-let (pkg
@@ -106,31 +103,31 @@ the emacs' reader readtable."
(update-theme-pkg-from-archive-theme pkg archive-theme))
(make-theme-pkg-from-archive-theme archive-theme)))
-(defun mark-theme-to-update (archive-theme)
- (a:if-let (pkg
- (theme-pkg-with-name
- (archive-theme-name archive-theme)))
- (when (not (equalp (archive-theme-version archive-theme)
- (theme-pkg-version pkg)))
- (push archive-theme *update-batch*))
- (push archive-theme *update-batch*))) ;; 🤮
-
+(defun theme-needs-update-p (archive-theme)
+ "A theme should be updated if eithe it is new or if its version
+differs from the theme-pkg instance already in the data store."
+ (let ((pkg
+ (theme-pkg-with-name
+ (archive-theme-name archive-theme))))
+ (not
+ (and pkg
+ (equalp (archive-theme-version archive-theme)
+ (theme-pkg-version pkg))))))
(defun update-theme-packages ()
- (let ((all-themes-from-archive
- (remove-if-not #'theme-package-p (fetch-emacs-archive)))
- (*update-batch* nil))
- (dolist (archive-theme all-themes-from-archive)
- (mark-theme-to-update archive-theme))
-
+ (let ((themes-to-update
+ (remove-if-not
+ (a:conjoin #'theme-package-p #'theme-needs-update-p)
+ (fetch-emacs-archive))))
;; just going to let this throw an error. will either introduce a
;; restart-case with some restarts or something later, or will
;; just catch the error in the caller of update-theme-packages
- (generate-images-for-packages
- (mapcar #'archive-theme-name *update-batch*))
- ;; if we didn't error: update the db
- (dolist (archive-theme *update-batch*)
- (process-archive-theme archive-theme))))
+ (when themes-to-update
+ (generate-images-for-packages
+ (mapcar #'archive-theme-name themes-to-update))
+ ;; if we didn't error: update the db
+ (dolist (archive-theme themes-to-update)
+ (process-archive-theme archive-theme)))))
(defun all-theme-keywords ()
(delete-duplicates
@@ -207,6 +204,9 @@ are treated as such.")
(defun full-theme-image-directory (&optional (config *config*))
(uiop:merge-pathnames* (theme-image-directory config) *config-directory*))
+(defun emacs-dot-d-directory (&optional (config *config*))
+ (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory config)))
+
(defun create-db ()
(unless (boundp 'db:*store* )
(ensure-directories-exist (full-store-directory))
@@ -219,7 +219,7 @@ are treated as such.")
(unless config-file
(setf config-file
(or (uiop:getenv "FUSSY_CONFIG")
- (asdf:system-relative-pathname :fussy "files/config.sexp"))))
+ (asdf:system-relative-pathname :fussy "config.sexp"))))
(setf *config*
(load-config-from-file config-file)
*config-directory*
@@ -259,5 +259,10 @@ that they are not loaded during image gen.")
(defun generate-images-for-packages (package-names)
- (uiop:launch-program
- (format-emacs-evocation-script package-names)))
+ (when package-names
+ (uiop:run-program
+ (format-emacs-evocation-script package-names))
+ ;; we delete the custom location .emacs.d directory after each run.
+ ;; I'm doing this so that
+ (uiop:delete-directory-tree
+ (emacs-dot-d-directory) :validate t)))