changeset 342: |
254cca648492 |
parent: |
94d358919982
|
child: |
6c02d3d77326 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Mon, 13 May 2024 21:10:33 -0400 |
permissions: |
-rw-r--r-- |
description: |
homer fixups |
1 ;;; homer.lisp --- homectl utility 6 (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id :krypt :vc) 7 (:export :main :home-config)) 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*)) 13 (declaim (type home-config *home-config*)) 14 (defvar *home-config*) 16 (defclass home-config (sxp id) 17 ((user :initform *user* :initarg :user :type string) 18 (path :initform nil :initarg :path :type (or pathname null)) 19 (src ::initform nil :initarg :src :type (or null pathname vc-repo)) 20 (skel :initform (load-user-skelrc) :initarg :skel :type (or pathname sk-user-config)) 21 (krypt :initform (load-kryptrc) :initarg :krypt :type (or pathname krypt-config)) 22 (packy :initarg :packy :type (or pathname pk-user-config)) 23 (mail :initarg :mail :type pathname) 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)) 27 (browser :initarg :browser :type (or pathname browser-user-config)))) 30 (defmethod print-object ((self home-config) stream) 31 (print-unreadable-object (self stream :type t) 32 (format stream "~S ~A" :id (format-sxhash (id self))))) 34 (defun find-homer-symbol (s) 35 (find-symbol* (symbol-name s) :homer nil)) 37 (defmethod load-ast ((self home-config)) 38 (with-slots (ast) self 40 ;; ast is valid, modify object, set ast nil 42 (sb-int:doplist (k v) ast 43 (when-let ((s (find-homer-symbol k))) ;; needs to be correct package 44 (setf (slot-value self s) v))) 47 ;; invalid ast, signal error 48 (error 'sxp-syntax-error)))) 51 (defmethod build-ast ((self home-config) &key (nullp nil) (exclude '(ast id))) 59 (defun load-homerc (&optional (file *default-user-homerc*)) 60 "Load a homerc configuration from FILE. Defaults to ~/.homerc." 61 (let ((form (file-read-forms file))) 62 (setq *home-config* (load-ast (make-instance 'home-config :ast form :path file :id (sxhash form)))) 63 (with-slots (src) *home-config* 65 (setf src (pathname src)) 66 (setf src (pathname (sb-posix:getenv "HOMER"))))))) 69 (defopt homer-help (print-help $cli)) 70 (defopt homer-version (print-version $cli)) 71 (defopt homer-log-level (when $val (setq *log-level* :debug))) 74 (describe *home-config*)) 76 (defun compare-to-home (src) 77 "Compare a SRC path to what is stored in the user's home. Return a cons with 78 the last modified timestamp of each file (SRC . HOME) or NIL." 82 (let ((cfg *home-config*)) 84 (if-let ((src (probe-file src))) 85 (mapcar #'compare-to-home (std/file:find-files src (push "readme.org" *hidden-paths*))) 86 (error 'file-error :pathname src))))) 95 :description "user home manager" 98 (:name "level" :global t :description "set the log level" :thunk homer-log-level) 99 (:name "help" :global t :description "print help" :thunk homer-help) 100 (:name "version" :global t :description "print version" :thunk homer-version)) 102 (:name show :thunk homer-show) 103 (:name check :thunk homer-check))) 106 (let ((*log-level* :info)) 107 (with-cli (opts cmds args) $cli 113 (let ((*print-readably* t)) 115 (sb-ext:exit :code 0)))