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)))