1.1--- a/lisp/bin/bin.asd Mon May 13 18:40:39 2024 -0400
1.2+++ b/lisp/bin/bin.asd Mon May 13 21:10:33 2024 -0400
1.3@@ -17,7 +17,7 @@
1.4 :build-pathname "homer"
1.5 :entry-point "bin/homer::main"
1.6 :depends-on (:uiop :cl-ppcre :std :cli
1.7- :organ :skel :nlp :rdb :packy)
1.8+ :organ :skel :nlp :rdb :packy :krypt)
1.9 :components ((:file "homer"))
1.10 :in-order-to ((test-op (test-op "app/tests")))
1.11 :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
2.1--- a/lisp/bin/homer.lisp Mon May 13 18:40:39 2024 -0400
2.2+++ b/lisp/bin/homer.lisp Mon May 13 21:10:33 2024 -0400
2.3@@ -3,26 +3,29 @@
2.4 ;;; Code:
2.5 (defpackage :bin/homer
2.6 (:nicknames :homer)
2.7- (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id)
2.8+ (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id :krypt :vc)
2.9 (:export :main :home-config))
2.10
2.11 (in-package :bin/homer)
2.12 (defvar *user* (sb-posix:getenv "USER"))
2.13 (defvar *user-homedir* (user-homedir-pathname))
2.14 (defvar *default-user-homerc* (merge-pathnames ".homerc" *user-homedir*))
2.15+(declaim (type home-config *home-config*))
2.16+(defvar *home-config*)
2.17
2.18 (defclass home-config (sxp id)
2.19 ((user :initform *user* :initarg :user :type string)
2.20 (path :initform nil :initarg :path :type (or pathname null))
2.21+ (src ::initform nil :initarg :src :type (or null pathname vc-repo))
2.22 (skel :initform (load-user-skelrc) :initarg :skel :type (or pathname sk-user-config))
2.23- (krypt :initarg :krypt)
2.24+ (krypt :initform (load-kryptrc) :initarg :krypt :type (or pathname krypt-config))
2.25 (packy :initarg :packy :type (or pathname pk-user-config))
2.26- (mail :initarg :mail)
2.27+ (mail :initarg :mail :type pathname)
2.28 (shell :initarg :shell :type (or pathname shell-user-config))
2.29 (editor :initarg :editor :type (or pathname editor-user-config))
2.30 (wm :initarg :wm :type (or pathname wm-user-config))
2.31- (browser :initarg :browser :type (or pathname browser-user-config))
2.32- (paths :initarg :paths :type list)))
2.33+ (browser :initarg :browser :type (or pathname browser-user-config))))
2.34+
2.35
2.36 (defmethod print-object ((self home-config) stream)
2.37 (print-unreadable-object (self stream :type t)
2.38@@ -37,8 +40,8 @@
2.39 ;; ast is valid, modify object, set ast nil
2.40 (progn
2.41 (sb-int:doplist (k v) ast
2.42- (when-let ((s (find-homer-symbol k)))
2.43- (setf (slot-value self s) v))) ;; needs to be correct package
2.44+ (when-let ((s (find-homer-symbol k))) ;; needs to be correct package
2.45+ (setf (slot-value self s) v)))
2.46 (setf (ast self) nil)
2.47 self)
2.48 ;; invalid ast, signal error
2.49@@ -56,14 +59,35 @@
2.50 (defun load-homerc (&optional (file *default-user-homerc*))
2.51 "Load a homerc configuration from FILE. Defaults to ~/.homerc."
2.52 (let ((form (file-read-forms file)))
2.53- (load-ast (make-instance 'home-config :ast form :path file :id (sxhash form)))))
2.54+ (setq *home-config* (load-ast (make-instance 'home-config :ast form :path file :id (sxhash form))))
2.55+ (with-slots (src) *home-config*
2.56+ (if src
2.57+ (setf src (pathname src))
2.58+ (setf src (pathname (sb-posix:getenv "HOMER")))))))
2.59
2.60+;;; CLI
2.61 (defopt homer-help (print-help $cli))
2.62 (defopt homer-version (print-version $cli))
2.63 (defopt homer-log-level (when $val (setq *log-level* :debug)))
2.64
2.65 (defcmd homer-show
2.66- (describe (load-homerc)))
2.67+ (describe *home-config*))
2.68+
2.69+(defun compare-to-home (src)
2.70+ "Compare a SRC path to what is stored in the user's home. Return a cons with
2.71+the last modified timestamp of each file (SRC . HOME) or NIL."
2.72+ (info! src))
2.73+
2.74+(defcmd homer-check
2.75+ (let ((cfg *home-config*))
2.76+ (with-slots (src) cfg
2.77+ (if-let ((src (probe-file src)))
2.78+ (mapcar #'compare-to-home (std/file:find-files src (push "readme.org" *hidden-paths*)))
2.79+ (error 'file-error :pathname src)))))
2.80+
2.81+(defcmd homer-push)
2.82+(defcmd homer-pull)
2.83+(defcmd homer-clean)
2.84
2.85 (define-cli $cli
2.86 :name "homer"
2.87@@ -75,11 +99,13 @@
2.88 (:name "help" :global t :description "print help" :thunk homer-help)
2.89 (:name "version" :global t :description "print version" :thunk homer-version))
2.90 :cmds (make-cmds
2.91- (:name show :thunk homer-show)))
2.92+ (:name show :thunk homer-show)
2.93+ (:name check :thunk homer-check)))
2.94
2.95 (defun run ()
2.96 (let ((*log-level* :info))
2.97 (with-cli (opts cmds args) $cli
2.98+ (load-homerc)
2.99 (do-cmd $cli)
2.100 (debug-opts $cli))))
2.101
3.1--- a/lisp/bin/skel.lisp Mon May 13 18:40:39 2024 -0400
3.2+++ b/lisp/bin/skel.lisp Mon May 13 21:10:33 2024 -0400
3.3@@ -71,8 +71,8 @@
3.4 (finish-output))))
3.5 (t (skel-error "unknown VC type"))))
3.6
3.7-(defun skc-show-case (sel)
3.8- (std/string:string-case (sel :default (skel-error))
3.9+(defun sk-slot-case (sel)
3.10+ (std/string:string-case (sel :default (skel-error "invalid slot"))
3.11 (":id" (std:format-sxhash (obj/id:id *skel-project*)))
3.12 (":name" (sk-name *skel-project*))
3.13 (":author" (sk-author *skel-project*))
3.14@@ -85,6 +85,8 @@
3.15 (":scripts" (sk-scripts *skel-project*))
3.16 (":snippets" (sk-snippets *skel-project*))
3.17 (":rules" (sk-rules *skel-project*))
3.18+ (":env" (sk-env *skel-project*))
3.19+ (":vars" (sk-vars *skel-project*))
3.20 (":imports" (sk-imports *skel-project*))
3.21 (":stash" (sk-stash *skel-project*))
3.22 (":store" (sk-store *skel-project*))
3.23@@ -94,7 +96,7 @@
3.24
3.25 (defcmd skc-show
3.26 (if $args
3.27- (mapc (lambda (x) (when-let ((ret (skc-show-case x))) (println ret))) $args)
3.28+ (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) $args)
3.29 (describe (if (boundp '*skel-project*) *skel-project*
3.30 (if (boundp '*skel-user-config*) *skel-user-config*
3.31 (if (boundp '*skel-system-config*) *skel-system-config*
4.1--- a/lisp/lib/krypt/krypt.asd Mon May 13 18:40:39 2024 -0400
4.2+++ b/lisp/lib/krypt/krypt.asd Mon May 13 21:10:33 2024 -0400
4.3@@ -2,12 +2,12 @@
4.4 :version "0.1.0"
4.5 :maintainer "ellis <ellis@rwest.io>"
4.6 :bug-tracker "https://vc.compiler.company/comp/core/issues"
4.7- :depends-on (:std :log :obj :dat :rdb)
4.8+ :depends-on (:std :log :obj :dat :rdb :cry)
4.9 :serial t
4.10 :components ((:file "pkg")
4.11 (:file "err")
4.12 (:file "krypt"))
4.13- :in-order-to ((test-op (test-op :cry/tests))))
4.14+ :in-order-to ((test-op (test-op :krypt/tests))))
4.15
4.16 (defsystem :krypt/tests
4.17 :depends-on (:rt :krypt)
5.1--- a/lisp/lib/skel/core/err.lisp Mon May 13 18:40:39 2024 -0400
5.2+++ b/lisp/lib/skel/core/err.lisp Mon May 13 21:10:33 2024 -0400
5.3@@ -1,7 +1,7 @@
5.4 ;;; Conditions
5.5 (in-package :skel/core)
5.6-
5.7-(define-condition skel-error (std-error) ())
5.8+(eval-always
5.9+ (deferror skel-error (std-error) () (:auto t)))
5.10
5.11 (deferror skel-syntax-error (sxp-syntax-error) () (:auto t))
5.12 (deferror skel-fmt-error (sxp-fmt-error) () (:auto t))
6.1--- a/lisp/lib/skel/core/obj.lisp Mon May 13 18:40:39 2024 -0400
6.2+++ b/lisp/lib/skel/core/obj.lisp Mon May 13 21:10:33 2024 -0400
6.3@@ -141,7 +141,7 @@
6.4 (print-unreadable-object (self stream :type t)
6.5 (format stream "~A" (sk-rule-target self))
6.6 (when-let ((source (sk-rule-source self)))
6.7- (format stream " :source ~A" source))))
6.8+ (format stream " :source ~A" source))))
6.9
6.10 ;; Note that SK-RUN directly on a rule currently does NOT touch the sources.
6.11 (defmethod sk-run ((self sk-rule))
6.12@@ -392,6 +392,8 @@
6.13 :initform (make-array 0 :element-type 'sk-document :adjustable t)
6.14 :accessor sk-docs :type (vector sk-document))
6.15 (components :initarg :components :initform nil :accessor sk-components :type list)
6.16+ (vars :initarg :vars :initform nil :accessor sk-vars :type list)
6.17+ (env :initarg :env :initform nil :accessor sk-env :type list)
6.18 (scripts :initarg :scripts
6.19 :initform (make-array 0 :element-type 'sk-script :adjustable t)
6.20 :accessor sk-scripts
6.21@@ -437,6 +439,20 @@
6.22 (setf (sk-docs self) (map 'vector (lambda (d) (apply #'make-sk-document d)) docs)))
6.23 (when-let ((scripts (sk-scripts self)))
6.24 (setf (sk-scripts self) (map 'vector #'make-sk-script scripts)))
6.25+ (when-let ((env (sk-env self)))
6.26+ (setf (sk-env self) (mapcar
6.27+ (lambda (e)
6.28+ (etypecase e
6.29+ (symbol (cons
6.30+ (sb-int:keywordicate e)
6.31+ (sb-posix:getenv (format nil "~a" (symbol-name e)))))
6.32+ (string (cons
6.33+ (sb-int:keywordicate e)
6.34+ (sb-posix:getenv (format nil "~a" (symbol-name e)))))
6.35+ (list
6.36+ (cons (sb-int:keywordicate (car e)) (cdr e)))))
6.37+
6.38+ env)))
6.39 (when-let ((rules (sk-rules self)))
6.40 (setf (sk-rules self) (map 'vector
6.41 (lambda (x)
6.42@@ -470,15 +486,15 @@
6.43 (if (listp (ast self))
6.44 (with-open-stream (st stream)
6.45 (loop for (k v . rest) on (ast self)
6.46- by #'cddr
6.47- unless (or (null v) (null k))
6.48- do
6.49- (write k :stream stream :pretty pretty :case case :readably t :array t :escape t)
6.50- (write-char #\space st)
6.51- (if (or (eq (type-of v) 'skel) (subtypep (type-of v) 'structure-object))
6.52- (write-sxp-stream v stream :pretty pretty :case case)
6.53- (write v :stream stream :pretty pretty :case case :readably t :array t :escape t))
6.54- (write-char #\newline st)))
6.55+ by #'cddr
6.56+ unless (or (null v) (null k))
6.57+ do
6.58+ (write k :stream stream :pretty pretty :case case :readably t :array t :escape t)
6.59+ (write-char #\space st)
6.60+ (if (or (eq (type-of v) 'skel) (subtypep (type-of v) 'structure-object))
6.61+ (write-sxp-stream v stream :pretty pretty :case case)
6.62+ (write v :stream stream :pretty pretty :case case :readably t :array t :escape t))
6.63+ (write-char #\newline st)))
6.64 (error 'sxp-fmt-error)))
6.65 (t (write (ast self) :stream stream :pretty pretty :case case :readably t :array t :escape t))))
6.66
6.67@@ -513,7 +529,6 @@
6.68
6.69 (defmethod sk-install-user-config ((self sk-project) (cfg sk-user-config))
6.70 (with-slots (vc store stash license author) (debug! cfg) ;; log-level, custom, fmt
6.71- ;; (trace! "sk-user-config VC:" vc)
6.72 (cas (sk-vc self) nil vc)
6.73 (cas (sk-stash self) nil stash)
6.74 (cas (sk-store self) nil store)
7.1--- a/lisp/lib/skel/pkg.lisp Mon May 13 18:40:39 2024 -0400
7.2+++ b/lisp/lib/skel/pkg.lisp Mon May 13 21:10:33 2024 -0400
7.3@@ -79,6 +79,7 @@
7.4 :edit-skelrc
7.5 :skel :sk-meta :def-sk-class :sk-project :sk-target :sk-source :sk-vc
7.6 :sk-vc-meta :sk-vc-meta-kind :sk-vc-meta-remotes
7.7+ :sk-vars :sk-env
7.8 :sk-rule :sk-rule-target :sk-rule-source :sk-rule-recipe :make-sk-rule
7.9 :sk-make
7.10 :sk-description :sk-kind :sk-rules :sk-version :sk-name :sk-docs :sk-document
8.1--- a/lisp/std/file.lisp Mon May 13 18:40:39 2024 -0400
8.2+++ b/lisp/std/file.lisp Mon May 13 21:10:33 2024 -0400
8.3@@ -397,14 +397,18 @@
8.4 (and (not (pathname-name path))
8.5 (not (pathname-type path))))
8.6
8.7-(defun hidden-path-p (path)
8.8- "Return T if PATH is a hidden file or directory or NIL else."
8.9+(defvar *hidden-paths* (list ".hg" ".git"))
8.10+
8.11+(defun hidden-path-p (path &optional strict)
8.12+ "Return T if PATH is strictly a hidden file or directory or NIL else."
8.13 (declare (type pathname path))
8.14 (let ((name (if (directory-path-p path)
8.15 (car (last (pathname-directory path)))
8.16 (file-namestring path))))
8.17 (and (plusp (length name))
8.18- (eq (char name 0) #\.))))
8.19+ (if strict
8.20+ (eq (char name 0) #\.)
8.21+ (member name *hidden-paths* :test 'equal)))))
8.22
8.23 (defun directory-path (path)
8.24 "If PATH is a directory pathname, return it as it is. If it is a file
8.25@@ -417,7 +421,7 @@
8.26 (list (file-namestring path)))
8.27 :name nil :type nil :defaults path)))
8.28
8.29-(defun find-files (path)
8.30+(defun find-files (path &optional (hide *hidden-paths*))
8.31 "Return a list of all files contained in the directory at PATH or any of its
8.32 subdirectories."
8.33 (declare (type (or pathname string) path))
8.34@@ -428,7 +432,7 @@
8.35 (let ((paths nil)
8.36 (children (list-directory (directory-path path))))
8.37 (dolist (child children paths)
8.38- (unless (hidden-path-p child)
8.39+ (unless (and hide (hidden-path-p child (eq t hide)))
8.40 (if (directory-path-p child)
8.41 (setf paths (append paths (find-files child)))
8.42 (push child paths)))))))
9.1--- a/lisp/std/pkg.lisp Mon May 13 18:40:39 2024 -0400
9.2+++ b/lisp/std/pkg.lisp Mon May 13 21:10:33 2024 -0400
9.3@@ -353,6 +353,7 @@
9.4 :file-date
9.5 :file-timestamp
9.6 :directory-path-p
9.7+ :*hidden-paths*
9.8 :hidden-path-p
9.9 :directory-path
9.10 :find-files
10.1--- a/skelfile Mon May 13 18:40:39 2024 -0400
10.2+++ b/skelfile Mon May 13 21:10:33 2024 -0400
10.3@@ -11,6 +11,7 @@
10.4 :vc :hg
10.5 :docs ((:org "readme"))
10.6 :scripts "x.lisp"
10.7+:env (home (cc "clang") shell term)
10.8 :rules
10.9 ((all (x compile std prelude build))
10.10 (x () #$if [ ! -f x ];
