1.1--- a/lisp/lib/cli/clap/cli.lisp Wed Sep 11 18:08:29 2024 -0400
1.2+++ b/lisp/lib/cli/clap/cli.lisp Wed Sep 11 21:40:01 2024 -0400
1.3@@ -56,13 +56,13 @@
1.4 (defun make-cmds (cmds)
1.5 "Make a vector of CLI-CMDs based on CMDS."
1.6 (map 'vector
1.7- (lambda (x)
1.8- (etypecase x
1.9- (cli-cmd x)
1.10- (string (make-cli :cmd :name x))
1.11- (list (apply #'make-cli :cmd x))
1.12- (t (make-cli :cmd :name (format nil "~(~A~)" x)))))
1.13- cmds))
1.14+ (lambda (x)
1.15+ (etypecase x
1.16+ (cli-cmd x)
1.17+ (string (make-cli :cmd :name x))
1.18+ (list (apply #'make-cli :cmd x))
1.19+ (t (make-cli :cmd :name (format nil "~(~A~)" x)))))
1.20+ cmds))
1.21
1.22 (defclass cli (cli-cmd)
1.23 ;; name slot defaults to *package*, must be string
1.24@@ -70,7 +70,7 @@
1.25 (version :initarg :version :initform "0.1.0" :accessor cli-version :type string)
1.26 ;; TODO 2023-10-11: look into pushd popd - cd-stack?
1.27 (cd :initarg :cd :initform (sb-posix:getcwd) :type string :accessor cli-cd
1.28- :documentation "working directory of the top-level CLI."))
1.29+ :documentation "working directory of the top-level CLI."))
1.30 (:documentation "CLI"))
1.31
1.32 (defmethod print-usage ((self cli) &optional stream)
1.33@@ -114,15 +114,16 @@
1.34 (loop for opt across (active-opts self global)
1.35 do (do-opt opt)))
1.36
1.37-(defmacro with-cli (slots cli &body body)
1.38+(defmacro with-cli ((cli &rest slots) args &body body)
1.39 "Like with-slots with some extra bindings.
1.40
1.41 SLOTS is a list passed to WITH-SLOTS.
1.42
1.43-CLI is updated based on the current environment and dynamically bound to
1.44-*CLI*."
1.45+CLI is updated based on the current environment and dynamically bound
1.46+to *CLI*. ARGS is a list of CLI args, defaults to *POSIX-ARGV* at
1.47+runtime if nil."
1.48 `(progn
1.49- (setq *cli* ,cli)
1.50- (setf (cli-cd ,cli) (sb-posix:getcwd))
1.51- (with-slots ,slots (parse-args ,cli (args) :compile t)
1.52- ,@body)))
1.53+ (let ((*cli* ,cli))
1.54+ (setf (cli-cd *cli*) *default-pathname-defaults*)
1.55+ (with-slots ,slots (parse-args *cli* ,args :compile t)
1.56+ ,@body))))