changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/lib/cli/clap/cli.lisp

revision 647: 74e563ed4537
parent 644: f59072409c7a
child 651: af486e0a40c9
     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))))