changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: homer push/pull

changeset 351: 770f2d03efd8
parent 350: 87546048623e
child 352: 840cce757946
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 14 May 2024 13:53:07 -0400
files: lisp/bin/homer.lisp lisp/std/file.lisp
description: homer push/pull
     1.1--- a/lisp/bin/homer.lisp	Mon May 13 22:29:35 2024 -0400
     1.2+++ b/lisp/bin/homer.lisp	Tue May 14 13:53:07 2024 -0400
     1.3@@ -50,12 +50,12 @@
     1.4 ;; obj -> ast
     1.5 (defmethod build-ast ((self home-config) &key (nullp nil) (exclude '(ast id)))
     1.6   (setf (ast self)
     1.7-         (unwrap-object self
     1.8-                        :slots t
     1.9-                        :methods nil
    1.10-                        :nullp nullp
    1.11-                        :exclude exclude)))
    1.12-        
    1.13+        (unwrap-object self
    1.14+                       :slots t
    1.15+                       :methods nil
    1.16+                       :nullp nullp
    1.17+                       :exclude exclude)))
    1.18+
    1.19 (defun load-homerc (&optional (file *default-user-homerc*))
    1.20   "Load a homerc configuration from FILE. Defaults to ~/.homerc."
    1.21   (unless (null (probe-file file))
    1.22@@ -85,25 +85,75 @@
    1.23          (home (merge-pathnames name (user-homedir-pathname)))
    1.24          (m1 (mtime src))
    1.25          (m2 (when (probe-file home) (mtime home)))
    1.26-         (status (if (null m2) :new
    1.27-                     (if (< m2 m1) :pull
    1.28-                         :push))))
    1.29-    (cons name (list status m1 m2))))
    1.30+         (status (cond
    1.31+                   ((null m2) :new)
    1.32+                   ((> m1 m2) :pull)
    1.33+                   ((< m1 m2) :push)
    1.34+                   (t))))
    1.35+    (cons status (cons src home))))
    1.36+
    1.37+(defprompt homer-check "install file? [y/n]: ")
    1.38+
    1.39+(defun homer-ask (form)
    1.40+  (let ((home (cddr form))
    1.41+      (src (cadr form)))
    1.42+  (let ((input (homer-check-prompt)))
    1.43+    (unless (or (zerop (length input))
    1.44+                (not (char= (aref input 0) #\y)))
    1.45+      (uiop:copy-file src home)))))
    1.46+
    1.47+(defun homer-status (file)
    1.48+  (let ((form (compare-to-home file)))
    1.49+    (case (car form)
    1.50+      ;; confirm with user
    1.51+      (:new (println (format nil ":NEW ~A" (cdr form))))
    1.52+      (:pull (println (format nil ":PULL ~A" (cadr form))))
    1.53+      (:push (println (format nil ":PUSH ~A" (cddr form))))
    1.54+      (t nil))))
    1.55 
    1.56 (defcmd homer-check
    1.57-  (let ((cfg *home-config*))
    1.58-    (with-slots (src) cfg
    1.59-      (if-let ((src (probe-file src)))
    1.60-        (let ((*default-pathname-defaults* src))
    1.61-          (debug!
    1.62-           (mapcar #'compare-to-home
    1.63-                   (std/file:find-files
    1.64-                    *default-pathname-defaults*
    1.65-                    (nconc std/file:*hidden-paths* (list "stash" "store" "readme.org"))))))
    1.66-        (error 'file-error :pathname src)))))
    1.67+  (with-slots (src) *home-config*
    1.68+    (if-let ((src (probe-file src)))
    1.69+      (let ((*default-pathname-defaults* src))
    1.70+        (mapcar #'homer-status
    1.71+                (find-files
    1.72+                 *default-pathname-defaults*
    1.73+                 (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
    1.74+      (error 'file-error :pathname src))))
    1.75+
    1.76+(defun homer-maybe-push (file)
    1.77+  (let ((form (compare-to-home file)))
    1.78+    (case (car form)
    1.79+      (:push (progn
    1.80+               (println (format nil ":PUSH ~A" (cddr form)))
    1.81+               (uiop:copy-file (cddr form) (cadr form))))
    1.82+      (t nil))))
    1.83 
    1.84-(defcmd homer-push)
    1.85-(defcmd homer-pull)
    1.86+(defun homer-maybe-pull (file)
    1.87+  (let ((form (compare-to-home file)))
    1.88+    (case (car form)
    1.89+      (:pull (progn
    1.90+               (println (format nil ":PUSH ~A" (cddr form)))
    1.91+               (uiop:copy-file (cadr form) (cddr form))))
    1.92+      (t nil))))
    1.93+
    1.94+(defcmd homer-push
    1.95+  (with-slots (src) *home-config*
    1.96+    (if-let ((src (probe-file src)))
    1.97+      (let ((*default-pathname-defaults* src))
    1.98+        (mapc #'homer-maybe-push
    1.99+              (find-files src (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
   1.100+      (error 'file-error :pathname src))))
   1.101+
   1.102+(defcmd homer-pull
   1.103+  (with-slots (src) *home-config*
   1.104+    (if-let ((src (probe-file src)))
   1.105+      (let ((*default-pathname-defaults* src))
   1.106+        (mapc #'homer-maybe-pull
   1.107+              (find-files src (nconc *hidden-paths* (list "stash" "store" "readme.org" ".hgignore")))))
   1.108+      (error 'file-error :pathname src))))
   1.109+
   1.110+(defcmd homer-install)
   1.111 (defcmd homer-clean)
   1.112 
   1.113 (define-cli $cli
   1.114@@ -117,7 +167,9 @@
   1.115           (:name "version" :global t :description "print version" :thunk homer-version))
   1.116   :cmds (make-cmds
   1.117           (:name show :thunk homer-show)
   1.118-          (:name check :thunk homer-check)))
   1.119+          (:name check :thunk homer-check)
   1.120+          (:name push :thunk homer-push)
   1.121+          (:name pull :thunk homer-pull)))
   1.122 
   1.123 (defun run ()
   1.124   (let ((*log-level* :info))
     2.1--- a/lisp/std/file.lisp	Mon May 13 22:29:35 2024 -0400
     2.2+++ b/lisp/std/file.lisp	Tue May 14 13:53:07 2024 -0400
     2.3@@ -370,8 +370,8 @@
     2.4 The size is computed by opening the file and getting the length of the
     2.5 resulting stream.
     2.6 
     2.7-If all you want is to read the file's size in octets from its
     2.8-metadata, consider `trivial-file-size:file-size-in-octets' instead."
     2.9+If all you want is to read the file's size in octets from its metadata,
    2.10+consider FILE-SIZE-IN-OCTETS instead."
    2.11   (check-type file (or string pathname))
    2.12   (with-input-from-file (in file :element-type element-type)
    2.13     (file-length in)))