changeset 350: | 87546048623e |
parent: | 1b3761849c98 |
child: | 770f2d03efd8 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Mon, 13 May 2024 22:29:35 -0400 |
permissions: | -rw-r--r-- |
description: | homer: also ignore special dirs stash and store |
96 | 1 | ;;; homer.lisp --- homectl utility |
2 | ||
3 | ;;; Code: |
|
4 | (defpackage :bin/homer |
|
5 | (:nicknames :homer) |
|
342 | 6 | (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id :krypt :vc) |
96 | 7 | (:export :main :home-config)) |
8 | ||
9 | (in-package :bin/homer) |
|
10 | (defvar *user* (sb-posix:getenv "USER")) |
|
11 | (defvar *user-homedir* (user-homedir-pathname)) |
|
12 | (defvar *default-user-homerc* (merge-pathnames ".homerc" *user-homedir*)) |
|
342 | 13 | (declaim (type home-config *home-config*)) |
14 | (defvar *home-config*) |
|
96 | 15 | |
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
16 | (defclass home-config (sxp id) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
17 | ((user :initform *user* :initarg :user :type string) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
18 | (path :initform nil :initarg :path :type (or pathname null)) |
342 | 19 | (src ::initform nil :initarg :src :type (or null pathname vc-repo)) |
347 | 20 | (skel :initform (load-user-skelrc) :initarg :skel :type (or null pathname sk-user-config)) |
21 | (krypt :initform (load-kryptrc) :initarg :krypt :type (or null pathname krypt-config)) |
|
22 | (packy :initform nil :initarg :packy :type (or null pathname pk-user-config)) |
|
342 | 23 | (mail :initarg :mail :type pathname) |
96 | 24 | (shell :initarg :shell :type (or pathname shell-user-config)) |
25 | (editor :initarg :editor :type (or pathname editor-user-config)) |
|
26 | (wm :initarg :wm :type (or pathname wm-user-config)) |
|
342 | 27 | (browser :initarg :browser :type (or pathname browser-user-config)))) |
28 | ||
96 | 29 | |
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
30 | (defmethod print-object ((self home-config) stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
31 | (print-unreadable-object (self stream :type t) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
32 | (format stream "~S ~A" :id (format-sxhash (id self))))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
33 | |
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
34 | (defun find-homer-symbol (s) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
35 | (find-symbol* (symbol-name s) :homer nil)) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
36 | |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
37 | (defmethod load-ast ((self home-config)) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
38 | (with-slots (ast) self |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
39 | (if (formp ast) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
40 | ;; ast is valid, modify object, set ast nil |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
41 | (progn |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
42 | (sb-int:doplist (k v) ast |
342 | 43 | (when-let ((s (find-homer-symbol k))) ;; needs to be correct package |
44 | (setf (slot-value self s) v))) |
|
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
45 | (setf (ast self) nil) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
46 | self) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
47 | ;; invalid ast, signal error |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
48 | (error 'sxp-syntax-error)))) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
49 | |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
50 | ;; obj -> ast |
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
51 | (defmethod build-ast ((self home-config) &key (nullp nil) (exclude '(ast id))) |
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
52 | (setf (ast self) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
53 | (unwrap-object self |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
54 | :slots t |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
55 | :methods nil |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
56 | :nullp nullp |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
57 | :exclude exclude))) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
58 | |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
59 | (defun load-homerc (&optional (file *default-user-homerc*)) |
96 | 60 | "Load a homerc configuration from FILE. Defaults to ~/.homerc." |
344 | 61 | (unless (null (probe-file file)) |
62 | (let ((form (file-read-forms file))) |
|
63 | (setq *home-config* (load-ast (make-instance 'home-config :ast form :path file :id (sxhash form)))) |
|
64 | (with-slots (src) *home-config* |
|
349 | 65 | (if src |
344 | 66 | (setf src (pathname src)) |
349 | 67 | (if-let ((homer (sb-posix:getenv "HOMER"))) |
68 | (setf src (pathname homer)) |
|
69 | (error "missing HOMER directory"))))))) |
|
96 | 70 | |
342 | 71 | ;;; CLI |
96 | 72 | (defopt homer-help (print-help $cli)) |
73 | (defopt homer-version (print-version $cli)) |
|
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
74 | (defopt homer-log-level (when $val (setq *log-level* :debug))) |
96 | 75 | |
76 | (defcmd homer-show |
|
342 | 77 | (describe *home-config*)) |
78 | ||
345 | 79 | (defun mtime (path) (sb-posix:stat-mtime (sb-posix:stat path))) |
80 | ||
342 | 81 | (defun compare-to-home (src) |
82 | "Compare a SRC path to what is stored in the user's home. Return a cons with |
|
83 | the last modified timestamp of each file (SRC . HOME) or NIL." |
|
345 | 84 | (let* ((name (enough-namestring src)) |
85 | (home (merge-pathnames name (user-homedir-pathname))) |
|
86 | (m1 (mtime src)) |
|
87 | (m2 (when (probe-file home) (mtime home))) |
|
88 | (status (if (null m2) :new |
|
89 | (if (< m2 m1) :pull |
|
90 | :push)))) |
|
91 | (cons name (list status m1 m2)))) |
|
342 | 92 | |
93 | (defcmd homer-check |
|
94 | (let ((cfg *home-config*)) |
|
95 | (with-slots (src) cfg |
|
96 | (if-let ((src (probe-file src))) |
|
345 | 97 | (let ((*default-pathname-defaults* src)) |
98 | (debug! |
|
99 | (mapcar #'compare-to-home |
|
350
87546048623e
homer: also ignore special dirs stash and store
Richard Westhaver <ellis@rwest.io>
parents:
349
diff
changeset
|
100 | (std/file:find-files |
87546048623e
homer: also ignore special dirs stash and store
Richard Westhaver <ellis@rwest.io>
parents:
349
diff
changeset
|
101 | *default-pathname-defaults* |
87546048623e
homer: also ignore special dirs stash and store
Richard Westhaver <ellis@rwest.io>
parents:
349
diff
changeset
|
102 | (nconc std/file:*hidden-paths* (list "stash" "store" "readme.org")))))) |
342 | 103 | (error 'file-error :pathname src))))) |
104 | ||
105 | (defcmd homer-push) |
|
106 | (defcmd homer-pull) |
|
107 | (defcmd homer-clean) |
|
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
108 | |
96 | 109 | (define-cli $cli |
110 | :name "homer" |
|
111 | :version "0.1.0" |
|
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
112 | :description "user home manager" |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
113 | :thunk homer-show |
96 | 114 | :opts (make-opts |
309
94d358919982
refactor rust, fixing cli issues and rdb error handling
Richard Westhaver <ellis@rwest.io>
parents:
308
diff
changeset
|
115 | (:name "level" :global t :description "set the log level" :thunk homer-log-level) |
94d358919982
refactor rust, fixing cli issues and rdb error handling
Richard Westhaver <ellis@rwest.io>
parents:
308
diff
changeset
|
116 | (:name "help" :global t :description "print help" :thunk homer-help) |
94d358919982
refactor rust, fixing cli issues and rdb error handling
Richard Westhaver <ellis@rwest.io>
parents:
308
diff
changeset
|
117 | (:name "version" :global t :description "print version" :thunk homer-version)) |
96 | 118 | :cmds (make-cmds |
342 | 119 | (:name show :thunk homer-show) |
120 | (:name check :thunk homer-check))) |
|
96 | 121 | |
122 | (defun run () |
|
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
123 | (let ((*log-level* :info)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
124 | (with-cli (opts cmds args) $cli |
342 | 125 | (load-homerc) |
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
126 | (do-cmd $cli) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
206
diff
changeset
|
127 | (debug-opts $cli)))) |
96 | 128 | |
129 | (defmain () |
|
206
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
130 | (let ((*print-readably* t)) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
131 | (run) |
a0f64fed8f2a
refactor nu ci, skel and homer updates
Richard Westhaver <ellis@rwest.io>
parents:
96
diff
changeset
|
132 | (sb-ext:exit :code 0))) |