changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: work on homer check

changeset 345: feab62701ad1
parent 344: 6c02d3d77326
child 346: cf840165e1a8
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 13 May 2024 21:58:28 -0400
files: lisp/bin/homer.lisp
description: work on homer check
     1.1--- a/lisp/bin/homer.lisp	Mon May 13 21:16:15 2024 -0400
     1.2+++ b/lisp/bin/homer.lisp	Mon May 13 21:58:28 2024 -0400
     1.3@@ -74,16 +74,28 @@
     1.4 (defcmd homer-show
     1.5   (describe *home-config*))
     1.6 
     1.7+(defun mtime (path) (sb-posix:stat-mtime (sb-posix:stat path)))
     1.8+
     1.9 (defun compare-to-home (src)
    1.10   "Compare a SRC path to what is stored in the user's home. Return a cons with
    1.11 the last modified timestamp of each file (SRC . HOME) or NIL."
    1.12-  (info! src))
    1.13+  (let* ((name (enough-namestring src))
    1.14+         (home (merge-pathnames name (user-homedir-pathname)))
    1.15+         (m1 (mtime src))
    1.16+         (m2 (when (probe-file home) (mtime home)))
    1.17+         (status (if (null m2) :new
    1.18+                     (if (< m2 m1) :pull
    1.19+                         :push))))
    1.20+    (cons name (list status m1 m2))))
    1.21 
    1.22 (defcmd homer-check
    1.23   (let ((cfg *home-config*))
    1.24     (with-slots (src) cfg
    1.25       (if-let ((src (probe-file src)))
    1.26-        (mapcar #'compare-to-home (std/file:find-files src (push "readme.org" *hidden-paths*)))
    1.27+        (let ((*default-pathname-defaults* src))
    1.28+          (debug!
    1.29+           (mapcar #'compare-to-home
    1.30+                   (std/file:find-files *default-pathname-defaults* (push "readme.org" *hidden-paths*)))))
    1.31         (error 'file-error :pathname src)))))
    1.32 
    1.33 (defcmd homer-push)