1.1--- a/lisp/bin/homer.lisp Fri Jul 26 23:12:33 2024 -0400
1.2+++ b/lisp/bin/homer.lisp Fri Jul 26 23:55:27 2024 -0400
1.3@@ -76,10 +76,10 @@
1.4 (error "missing HOMER directory")))))))
1.5
1.6 ;;; CLI
1.7-(defopt homer-help (print-help $cli))
1.8-(defopt homer-version (print-version $cli))
1.9-(defopt homer-log-level (when $val (setq *log-level* :debug)))
1.10-(defopt homer-force (when $val (setq *homer-force* t)))
1.11+(defopt homer-help (print-help *cli*))
1.12+(defopt homer-version (print-version *cli*))
1.13+(defopt homer-log-level (when *arg* (setq *log-level* :debug)))
1.14+(defopt homer-force (when *arg* (setq *homer-force* t)))
1.15
1.16 (defcmd homer-show
1.17 (describe *home-config*))
1.18@@ -181,7 +181,7 @@
1.19 (find-files src *home-hidden-paths*)))
1.20 (error 'file-error :pathname src))))
1.21
1.22-(define-cli $cli
1.23+(define-cli *cli*
1.24 :name "homer"
1.25 :version "0.1.0"
1.26 :description "user home manager"
1.27@@ -200,11 +200,11 @@
1.28
1.29 (defun run ()
1.30 (let ((*log-level* :info))
1.31- (with-cli (opts cmds args) $cli
1.32+ (with-cli (opts cmds args) *cli*
1.33 (init-homer-vars)
1.34 (load-homerc)
1.35- (do-cmd $cli)
1.36- (debug-opts $cli))))
1.37+ (do-cmd *cli*)
1.38+ (debug-opts *cli*))))
1.39
1.40 (defmain ()
1.41 (let ((*print-readably* t))
2.1--- a/lisp/bin/organ.lisp Fri Jul 26 23:12:33 2024 -0400
2.2+++ b/lisp/bin/organ.lisp Fri Jul 26 23:55:27 2024 -0400
2.3@@ -4,36 +4,36 @@
2.4
2.5 ;;; Code:
2.6 (defpackage :bin/organ
2.7- (:use :cl :organ :std :cli :log)
2.8+ (:use :cl :organ :std :cli :log :clap)
2.9 (:export :main))
2.10
2.11 (in-package :bin/organ)
2.12-(defopt organ-help (print-help $cli))
2.13-(defopt organ-version (print-version $cli))
2.14-(defopt organ-log-level (setq *log-level* (if $val t :info)))
2.15-;; (defopt organ-output (when $val (trace! (or $val "output.organ"))))
2.16+(defopt organ-help (print-help *cli*))
2.17+(defopt organ-version (print-version *cli*))
2.18+(defopt organ-log-level (setq *log-level* (if *arg* t :info)))
2.19+;; (defopt organ-output (when *arg* (trace! (or *arg* "output.organ"))))
2.20 (defcmd organ-describe
2.21- (if $args
2.22+ (if *args*
2.23 ;; TODO typed args
2.24- (describe (org-parse :document (pathname (car $args))))
2.25+ (describe (org-parse :document (pathname (car *args*))))
2.26 (describe (org-parse :document #P"readme.org"))))
2.27
2.28 (defcmd organ-inspect
2.29- (if $args
2.30+ (if *args*
2.31 ;; TODO typed args
2.32- (inspect (org-parse :document (pathname (car $args))))
2.33+ (inspect (org-parse :document (pathname (car *args*))))
2.34 (inspect (org-parse :document #P"readme.org"))))
2.35
2.36 (defcmd organ-show
2.37- (if $args
2.38- (print (org-parse-lines t (uiop:read-file-string (car $args))))
2.39+ (if *args*
2.40+ (print (org-parse-lines t (uiop:read-file-string (car *args*))))
2.41 (error! "missing file arg")))
2.42
2.43 (defcmd organ-parse
2.44- (let ((input (if $args (car $args) #P"readme.org")))
2.45+ (let ((input (if *args* (car *args*) #P"readme.org")))
2.46 (describe (org-parse :document input))))
2.47
2.48-(define-cli $cli
2.49+(define-cli *cli*
2.50 :name "organ"
2.51 :version "0.0.1"
2.52 :description "org-mode toolbox"
2.53@@ -59,9 +59,9 @@
2.54
2.55 (defun run ()
2.56 (let ((*log-level* :info))
2.57- (with-cli (opts cmds args) $cli
2.58- (do-cmd $cli)
2.59- (debug-opts $cli))))
2.60+ (with-cli (opts cmds args) *cli*
2.61+ (do-cmd *cli*)
2.62+ (debug-opts *cli*))))
2.63
2.64 (defmain ()
2.65 (run)
3.1--- a/lisp/bin/packy.lisp Fri Jul 26 23:12:33 2024 -0400
3.2+++ b/lisp/bin/packy.lisp Fri Jul 26 23:55:27 2024 -0400
3.3@@ -1,17 +1,17 @@
3.4 (defpackage :bin/packy
3.5- (:use :cl :std :sb-ext :cli :packy)
3.6+ (:use :cl :std :sb-ext :cli :packy :clap)
3.7 (:export :main))
3.8
3.9 (in-package :bin/packy)
3.10
3.11 ;;; CLI
3.12-(defopt pk-help (print-help $cli))
3.13-(defopt pk-version (print-version $cli))
3.14-(defopt pk-log-level (when $val (setq *log-level* :debug)))
3.15+(defopt pk-help (print-help *cli*))
3.16+(defopt pk-version (print-version *cli*))
3.17+(defopt pk-log-level (when *arg* (setq *log-level* :debug)))
3.18
3.19 (defcmd pk-show)
3.20
3.21-(define-cli $cli
3.22+(define-cli *cli*
3.23 :name "packy"
3.24 :version "0.1.0"
3.25 :description "Universal Package Manager"
3.26@@ -25,9 +25,9 @@
3.27
3.28 (defun run ()
3.29 (let ((*log-level* :info))
3.30- (with-cli (opts cmds args) $cli
3.31- (do-cmd $cli)
3.32- (debug-opts $cli))))
3.33+ (with-cli (opts cmds args) *cli*
3.34+ (do-cmd *cli*)
3.35+ (debug-opts *cli*))))
3.36
3.37 (defmain ()
3.38 (let ((*print-readably* t))
4.1--- a/lisp/bin/rdb.lisp Fri Jul 26 23:12:33 2024 -0400
4.2+++ b/lisp/bin/rdb.lisp Fri Jul 26 23:55:27 2024 -0400
4.3@@ -2,18 +2,18 @@
4.4
4.5 ;;; Code:
4.6 (uiop:define-package :bin/rdb
4.7- (:use :cl :rdb :std :cli/clap :log)
4.8+ (:use :cl :rdb :std :cli/clap :log :clap)
4.9 (:export :main))
4.10
4.11 (in-package :bin/rdb)
4.12 (rocksdb:load-rocksdb t)
4.13-(defopt rdb-help (print-help $cli))
4.14-(defopt rdb-version (print-version $cli))
4.15-(defopt rdb-log-level (when $val (setq *log-level* :debug)))
4.16+(defopt rdb-help (print-help *cli*))
4.17+(defopt rdb-version (print-version *cli*))
4.18+(defopt rdb-log-level (when *arg* (setq *log-level* :debug)))
4.19 (defvar *rdb*)
4.20-(defopt rdb-target-db (setq *rdb* (create-db (or $val "rdb") :open nil)))
4.21+(defopt rdb-target-db (setq *rdb* (create-db (or *arg* "rdb") :open nil)))
4.22
4.23-;; (defopt rdb-config (init-rdb-user-config (parse-file-opt $val)))
4.24+;; (defopt rdb-config (init-rdb-user-config (parse-file-opt *arg*)))
4.25
4.26 (defcmd rdb-new
4.27 (set-opt *rdb* :error-if-exists t)
4.28@@ -21,8 +21,8 @@
4.29 (println (rdb-name *rdb*)))
4.30
4.31 (defcmd rdb-show
4.32- (let ((db-path (cli-opt-val (car (find-opts $cli "db")))))
4.33- (if (and (null db-path) (zerop $argc))
4.34+ (let ((db-path (cli-opt-val (car (find-opts *cli* "db")))))
4.35+ (if (and (null db-path) (zerop *argc*))
4.36 (mapc (lambda (x) (println (format nil "~a ~a" (car x) (cdr x))))
4.37 (hash-table-alist (backfill-opts (default-rdb-opts) :full t)))
4.38 (with-db (db (create-db db-path :open t))
4.39@@ -38,18 +38,18 @@
4.40 finally (rocksdb::rocksdb-iter-destroy %it)))))))
4.41
4.42 (defcmd rdb-set
4.43- (if (> 2 $argc)
4.44+ (if (> 2 *argc*)
4.45 (rdb-error "missing args: KEY VAL")
4.46 (with-db (db *rdb*)
4.47 (open-db db)
4.48- (insert-key db (pop $args) (pop $args)))))
4.49+ (insert-key db (pop *args*) (pop *args*)))))
4.50
4.51 (defcmd rdb-get
4.52- (if (> 1 $argc)
4.53+ (if (> 1 *argc*)
4.54 (rdb-error "missing arg: KEY")
4.55 (with-db (db *rdb*)
4.56 (open-db db)
4.57- (when-let ((val (get-key db (car $args))))
4.58+ (when-let ((val (get-key db (car *args*))))
4.59 (println val)))))
4.60
4.61 (defcmd rdb-destroy
4.62@@ -59,7 +59,7 @@
4.63 (with-db (db *rdb*)
4.64 (open-db db)
4.65 (let ((val (make-array 32 :element-type 'octet)))
4.66- (dotimes (i (if (zerop $argc) 1000 (parse-integer (car $args))))
4.67+ (dotimes (i (if (zerop *argc*) 1000 (parse-integer (car *args*))))
4.68 (nreversef val)
4.69 (let ((seed (random 32)))
4.70 (dotimes (ii seed)
4.71@@ -69,7 +69,7 @@
4.72 (sb-ext:string-to-octets (string (gensym "foo")))
4.73 val)))))
4.74
4.75-(define-cli $cli
4.76+(define-cli *cli*
4.77 :name "rdb"
4.78 :version "0.1.0"
4.79 :thunk rdb-show
4.80@@ -92,8 +92,8 @@
4.81 (with-slots (opts cmds args) *cli*
4.82 ;; FIXME 2024-05-07: needs to be triggered explicitly - need to support
4.83 ;; running global opt thunks even when no arg present - macro key
4.84- (if (active-cmds $cli)
4.85- (prog2 (do-opt (car (find-opts $cli "db")))
4.86- (do-cmd $cli)
4.87+ (if (active-cmds *cli*)
4.88+ (prog2 (do-opt (car (find-opts *cli* "db")))
4.89+ (do-cmd *cli*)
4.90 (close-db *rdb*))
4.91- (print-help $cli)))))
4.92+ (print-help *cli*)))))
5.1--- a/lisp/bin/skel.lisp Fri Jul 26 23:12:33 2024 -0400
5.2+++ b/lisp/bin/skel.lisp Fri Jul 26 23:55:27 2024 -0400
5.3@@ -14,25 +14,25 @@
5.4 (in-package :bin/skel)
5.5 (in-readtable :shell)
5.6
5.7-(defopt skc-help (print-help $cli) $val)
5.8-(defopt skc-version (print-version $cli))
5.9+(defopt skc-help (print-help *cli*) *arg*)
5.10+(defopt skc-version (print-version *cli*))
5.11 (defopt skc-level *log-level*
5.12- (setq *log-level* (if $val (if (stringp $val)
5.13- (sb-int:keywordicate (string-upcase $val))
5.14- $val)
5.15+ (setq *log-level* (if *arg* (if (stringp *arg*)
5.16+ (sb-int:keywordicate (string-upcase *arg*))
5.17+ *arg*)
5.18 :info)))
5.19
5.20 ;; TODO 2023-10-13: almost there
5.21 ;; (defopt skc-config
5.22-;; (init-user-skelrc (when $val (parse-file-opt $val))))
5.23+;; (init-user-skelrc (when *arg* (parse-file-opt *arg*))))
5.24
5.25 (defcmd skc-edit
5.26- (let ((file (or (when $args (pop $args)) (sk-path *skel-project*))))
5.27+ (let ((file (or (when *args* (pop *args*)) (sk-path *skel-project*))))
5.28 (cli/ed:run-emacsclient (namestring file))))
5.29
5.30 (defcmd skc-init
5.31- (let ((file (when $args (pop $args)))
5.32- (name (when (> $argc 1) (pop $args)))) ;; TODO: test, may need to be
5.33+ (let ((file (when *args* (pop *args*)))
5.34+ (name (when (> *argc* 1) (pop *args*)))) ;; TODO: test, may need to be
5.35 ;; sequential for side-effect
5.36 ;; of pop
5.37 (handler-bind
5.38@@ -47,8 +47,8 @@
5.39
5.40 (defcmd skc-describe
5.41 (describe
5.42- (if (> $argc 0)
5.43- (find-skelfile (pathname (car $args)) :load t)
5.44+ (if (> *argc* 0)
5.45+ (find-skelfile (pathname (car *args*)) :load t)
5.46 (or *skel-project* *skel-user-config* *skel-system-config*))))
5.47
5.48
5.49@@ -57,14 +57,14 @@
5.50 (setq *no-exit* t)
5.51 (inspect
5.52 (find-skelfile
5.53- (if $args (pathname (car $args))
5.54+ (if *args* (pathname (car *args*))
5.55 #P".")
5.56 :load t)))
5.57
5.58 #+tools
5.59 (defcmd skc-view
5.60- (if $args
5.61- (let ((stuff (loop for a in $args
5.62+ (if *args*
5.63+ (let ((stuff (loop for a in *args*
5.64 collect (sk-slot-case a))))
5.65 (sk-view (if (= 1 (length stuff)) (car stuff) stuff)))
5.66 (sk-view (if (boundp '*skel-project*) *skel-project*
5.67@@ -132,8 +132,8 @@
5.68 (":cache" (sk-cache *skel-user-config*))))
5.69
5.70 (defcmd skc-show
5.71- (if $args
5.72- (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) $args)
5.73+ (if *args*
5.74+ (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) *args*)
5.75 (describe (if (boundp '*skel-project*) *skel-project*
5.76 (if (boundp '*skel-user-config*) *skel-user-config*
5.77 (if (boundp '*skel-system-config*) *skel-system-config*
5.78@@ -141,14 +141,14 @@
5.79
5.80 (defcmd skc-push
5.81 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
5.82- (:git (run-git-command "push" $args t))
5.83- (:hg (run-hg-command "push" $args t))
5.84+ (:git (run-git-command "push" *args* t))
5.85+ (:hg (run-hg-command "push" *args* t))
5.86 (t (skel-simple-error "unknown VC type"))))
5.87
5.88 (defcmd skc-pull
5.89 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
5.90- (:git (run-git-command "pull" $args t))
5.91- (:hg (run-hg-command "pull" (append '("-u") $args) t))
5.92+ (:git (run-git-command "pull" *args* t))
5.93+ (:hg (run-hg-command "pull" (append '("-u") *args*) t))
5.94 (t (skel-simple-error "unknown VC type"))))
5.95
5.96 (defun hg-status ()
5.97@@ -171,44 +171,44 @@
5.98
5.99 (defcmd skc-clone
5.100 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
5.101- (:git (run-git-command "clone" $args t))
5.102- (:hg (run-hg-command "clone" $args t))
5.103+ (:git (run-git-command "clone" *args* t))
5.104+ (:hg (run-hg-command "clone" *args* t))
5.105 (t (skel-simple-error "unknown VC type"))))
5.106
5.107 (defcmd skc-commit
5.108- ;; (debug! $optc $argc)
5.109+ ;; (debug! *optc* *argc*)
5.110 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
5.111- (:git (run-git-command "commit" $args t))
5.112- (:hg (run-hg-command "commit" $args t))
5.113+ (:git (run-git-command "commit" *args* t))
5.114+ (:hg (run-hg-command "commit" *args* t))
5.115 (t (skel-simple-error "unknown VC type"))))
5.116
5.117 (defcmd skc-make
5.118 (let ((sk (find-skelfile #P"." :load t)))
5.119 (sb-ext:enable-debugger)
5.120- (print $args)
5.121+ (print *args*)
5.122 ;; (setq *no-exit* t)
5.123- (if $args
5.124- (loop for a in $args
5.125+ (if *args*
5.126+ (loop for a in *args*
5.127 do (debug!
5.128 (when-let ((rule (sk-find-rule a sk)))
5.129 (sk-make sk rule))))
5.130 (debug! (sk-make sk (aref (sk-rules sk) 0))))))
5.131
5.132 (defcmd skc-run
5.133- (if $args
5.134+ (if *args*
5.135 (mapc (lambda (script)
5.136 (debug!
5.137 (sk-run
5.138 (sk-find-script
5.139 (pathname-name script)
5.140- (find-skelfile #P"." :load t))))) $args)
5.141+ (find-skelfile #P"." :load t))))) *args*)
5.142 (required-argument 'name)))
5.143
5.144 (defcmd skc-vc
5.145- (if $args
5.146- (std/string:string-case ((car $args) :default (skel-simple-error "invalid command"))
5.147+ (if *args*
5.148+ (std/string:string-case ((car *args*) :default (skel-simple-error "invalid command"))
5.149 ("status" (skc-status nil nil)))
5.150- (skc-status nil $opts)))
5.151+ (skc-status nil *opts*)))
5.152
5.153 (defcmd skc-shell
5.154 (sb-ext:enable-debugger)
5.155@@ -225,9 +225,9 @@
5.156 (sb-impl::toplevel-repl nil))))
5.157
5.158 (defcmd skc-new
5.159- (trace! $args $opts))
5.160+ (trace! *args* *opts*))
5.161
5.162-(define-cli $cli
5.163+(define-cli *cli*
5.164 :name "skel"
5.165 :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))
5.166 :description "A hacker's project compiler."
5.167@@ -346,9 +346,9 @@
5.168 (in-package :sk-user)
5.169 (let ((*log-level* :info))
5.170 (in-readtable :shell)
5.171- (with-cli (opts cmds) $cli
5.172+ (with-cli (opts cmds) *cli*
5.173 (init-skel-vars)
5.174 (when-let ((project (find-skelfile #P".")))
5.175 (setq *skel-project* (load-skelfile project)))
5.176- (do-cmd $cli)
5.177- (debug-opts $cli))))
5.178+ (do-cmd *cli*)
5.179+ (debug-opts *cli*))))
6.1--- a/lisp/lib/cli/clap/macs.lisp Fri Jul 26 23:12:33 2024 -0400
6.2+++ b/lisp/lib/cli/clap/macs.lisp Fri Jul 26 23:55:27 2024 -0400
6.3@@ -31,17 +31,17 @@
6.4
6.5 ;; TODO fix these macros
6.6 (defmacro defcmd (name &body body)
6.7- `(defun ,name (*args* *opts*)
6.8- (declare (ignorable *args* *opts*))
6.9- (let ((*argc* (length *args*))
6.10- (*optc* (length *opts*)))
6.11- (declare (ignorable *argc* *optc*))
6.12- ,@body)))
6.13+ `(defun ,name (args opts)
6.14+ (declare (ignorable args opts))
6.15+ (setq *argc* (length args)
6.16+ *optc* (length opts))
6.17+ ,@body))
6.18
6.19 (defmacro defopt (name &body body)
6.20- `(defun ,name (&optional *arg*)
6.21- (declare (ignorable *arg*))
6.22- ,@body))
6.23+ `(defun ,name (&optional arg)
6.24+ (declare (ignorable arg))
6.25+ (setq *arg* arg)
6.26+ ,@body))
6.27
6.28 (declaim (inline walk-cli-slots))
6.29 (defun walk-cli-slots (cli)
7.1--- a/lisp/lib/cli/clap/pkg.lisp Fri Jul 26 23:12:33 2024 -0400
7.2+++ b/lisp/lib/cli/clap/pkg.lisp Fri Jul 26 23:55:27 2024 -0400
7.3@@ -7,7 +7,7 @@
7.4 (:use :cl)
7.5 (:export :*cli-group-separator* :*no-exit* :*default-cli-def*
7.6 :*default-cli-class* :*cli-opt-kinds* :*cli* :*opts*
7.7- :*args* :*argc* :*arg*))
7.8+ :*args* :*argc* :*arg* :*optc*))
7.9
7.10 (defpackage :cli/clap/util
7.11 (:use :cl :std :log :sb-ext :cli/clap/vars)
7.12@@ -16,11 +16,9 @@
7.13 :default-thunk))
7.14
7.15 (defpackage :cli/clap/macs
7.16- (:use :cl :std :log :sb-ext :cli/clap/util)
7.17- (:import-from :cli/clap/vars :*no-exit*)
7.18+ (:use :cl :std :log :sb-ext :cli/clap/util :cli/clap/vars)
7.19 (:export :defopt :defcmd :walk-cli-slots
7.20- :$val :$args :$argc :$opts
7.21- :$optc :make-opt-parser :with-cli-handlers :make-shorty))
7.22+ :make-opt-parser :with-cli-handlers :make-shorty))
7.23
7.24 (defpackage :cli/clap/proto
7.25 (:use :cl :std :log :sb-ext)
