1.1--- a/lisp/bin/homer.lisp	Tue May 14 13:53:07 2024 -0400
     1.2+++ b/lisp/bin/homer.lisp	Tue May 14 15:09:28 2024 -0400
     1.3@@ -12,6 +12,7 @@
     1.4 (defvar *default-user-homerc* (merge-pathnames ".homerc" *user-homedir*))
     1.5 (declaim (type home-config *home-config*))
     1.6 (defvar *home-config*)
     1.7+(defvar *home-hidden-paths* (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))
     1.8 
     1.9 (defclass home-config (sxp id)
    1.10   ((user :initform *user* :initarg :user :type string)
    1.11@@ -26,7 +27,6 @@
    1.12    (wm :initarg :wm :type (or pathname wm-user-config))
    1.13    (browser :initarg :browser :type (or pathname browser-user-config))))
    1.14 
    1.15-
    1.16 (defmethod print-object ((self home-config) stream)
    1.17   (print-unreadable-object (self stream :type t)
    1.18     (format stream "~S ~A" :id (format-sxhash (id self)))))
    1.19@@ -78,7 +78,7 @@
    1.20 
    1.21 (defun mtime (path) (sb-posix:stat-mtime (sb-posix:stat path)))
    1.22 
    1.23-(defun compare-to-home (src)
    1.24+(defun compare-home-file (src)
    1.25   "Compare a SRC path to what is stored in the user's home. Return a cons with
    1.26 the last modified timestamp of each file (SRC . HOME) or NIL."
    1.27   (let* ((name (enough-namestring src))
    1.28@@ -92,18 +92,8 @@
    1.29                    (t))))
    1.30     (cons status (cons src home))))
    1.31 
    1.32-(defprompt homer-check "install file? [y/n]: ")
    1.33-
    1.34-(defun homer-ask (form)
    1.35-  (let ((home (cddr form))
    1.36-      (src (cadr form)))
    1.37-  (let ((input (homer-check-prompt)))
    1.38-    (unless (or (zerop (length input))
    1.39-                (not (char= (aref input 0) #\y)))
    1.40-      (uiop:copy-file src home)))))
    1.41-
    1.42 (defun homer-status (file)
    1.43-  (let ((form (compare-to-home file)))
    1.44+  (let ((form (compare-home-file file)))
    1.45     (case (car form)
    1.46       ;; confirm with user
    1.47       (:new (println (format nil ":NEW ~A" (cdr form))))
    1.48@@ -118,11 +108,11 @@
    1.49         (mapcar #'homer-status
    1.50                 (find-files
    1.51                  *default-pathname-defaults*
    1.52-                 (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
    1.53+                 *home-hidden-paths*)))
    1.54       (error 'file-error :pathname src))))
    1.55 
    1.56 (defun homer-maybe-push (file)
    1.57-  (let ((form (compare-to-home file)))
    1.58+  (let ((form (compare-home-file file)))
    1.59     (case (car form)
    1.60       (:push (progn
    1.61                (println (format nil ":PUSH ~A" (cddr form)))
    1.62@@ -130,19 +120,31 @@
    1.63       (t nil))))
    1.64 
    1.65 (defun homer-maybe-pull (file)
    1.66-  (let ((form (compare-to-home file)))
    1.67+  (let ((form (compare-home-file file)))
    1.68     (case (car form)
    1.69       (:pull (progn
    1.70-               (println (format nil ":PUSH ~A" (cddr form)))
    1.71+               (println (format nil ":PULL ~A" (cddr form)))
    1.72                (uiop:copy-file (cadr form) (cddr form))))
    1.73       (t nil))))
    1.74 
    1.75+(defun homer-maybe-install (file)
    1.76+  (let ((form (compare-home-file file)))
    1.77+    (case (car form)
    1.78+      (:pull (progn
    1.79+               (println (format nil ":PULL ~A" (cddr form)))
    1.80+               (uiop:copy-file (cadr form) (cddr form))))
    1.81+      (:new (progn
    1.82+              (println (format nil ":NEW ~A" (cddr form)))
    1.83+              (uiop:copy-file (cadr form) (cddr form))))
    1.84+      (:push (warn! "skipping file:" (cddr form)))
    1.85+      (t nil))))
    1.86+
    1.87 (defcmd homer-push
    1.88   (with-slots (src) *home-config*
    1.89     (if-let ((src (probe-file src)))
    1.90       (let ((*default-pathname-defaults* src))
    1.91         (mapc #'homer-maybe-push
    1.92-              (find-files src (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
    1.93+              (find-files src *home-hidden-paths*)))
    1.94       (error 'file-error :pathname src))))
    1.95 
    1.96 (defcmd homer-pull
    1.97@@ -150,10 +152,17 @@
    1.98     (if-let ((src (probe-file src)))
    1.99       (let ((*default-pathname-defaults* src))
   1.100         (mapc #'homer-maybe-pull
   1.101-              (find-files src (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
   1.102+              (find-files src *home-hidden-paths*)))
   1.103       (error 'file-error :pathname src))))
   1.104 
   1.105-(defcmd homer-install)
   1.106+(defcmd homer-install
   1.107+  (with-slots (src) *home-config*
   1.108+    (if-let ((src (probe-file src)))
   1.109+      (let ((*default-pathname-defaults* src))
   1.110+        (mapc #'homer-maybe-install
   1.111+              (find-files src *home-hidden-paths*)))
   1.112+      (error 'file-error :pathname src))))
   1.113+
   1.114 (defcmd homer-clean)
   1.115 
   1.116 (define-cli $cli
   1.117@@ -166,10 +175,11 @@
   1.118           (:name "help" :global t :description "print help" :thunk homer-help)
   1.119           (:name "version" :global t :description "print version" :thunk homer-version))
   1.120   :cmds (make-cmds
   1.121-          (:name show :thunk homer-show)
   1.122-          (:name check :thunk homer-check)
   1.123-          (:name push :thunk homer-push)
   1.124-          (:name pull :thunk homer-pull)))
   1.125+         (:name show :thunk homer-show)
   1.126+         (:name check :thunk homer-check)
   1.127+         (:name push :thunk homer-push)
   1.128+         (:name pull :thunk homer-pull)
   1.129+         (:name install :thunk homer-install)))
   1.130 
   1.131 (defun run ()
   1.132   (let ((*log-level* :info))