diff options
| -rw-r--r-- | fussy.lisp | 57 |
1 files changed, 31 insertions, 26 deletions
@@ -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))) |