# HG changeset patch # User Richard Westhaver # Date 1726195102 14400 # Node ID 6e5006dfe7b8d56311f1d4f48cfb5bbb3f6f0d1e # Parent 926d95e5fdc708275319874171274684ff474c04 clap parsing updates diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/clap/cmd.lisp --- a/lisp/lib/cli/clap/cmd.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/clap/cmd.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -103,6 +103,9 @@ (defmethod active-cmds ((self cli-cmd)) (remove-if-not #'cli-lock-p (cli-cmds self))) +(defmethod activate-cmd ((self cli-cmd)) + (setf (cli-lock-p self) t)) + (defmethod find-opts ((self cli-cmd) name &key active recurse) (let ((ret)) (flet ((%find (o obj) @@ -149,52 +152,45 @@ :kind slot, indicating the type of node and a :form slot which stores a value." (make-cli-ast - (let ((holes)) ;; list of arg indexes which can be skipped since they're - ;; consumed by an opt - (loop - for i below (length args) - for (a . args) on args - if (member i holes) - do (continue) ;; skip args which have been consumed already - ;; else - ;; if (= (length a) 1) - ;; collect (make-cli-node 'arg a) ; always treat single-char as arg - else - if (short-opt-p a) ;; SHORT OPT - collect - (if-let ((o (find-short-opts self (aref a 1) :recurse t))) - (%compose-short-opt (car o) a) - ;; TODO 2024-09-11: signal error? + (loop + with skip + for i below (length args) + for (a . args) on args + if skip + do (setq skip nil) + else if (short-opt-p a) ;; SHORT OPT + collect + (if-let ((o (car (find-short-opts self (aref a 1) :recurse t)))) + (%compose-short-opt o) + ;; TODO 2024-09-11: signal error? + (with-opt-restart-case a + (clap-unknown-argument a))) + else if (long-opt-p a) ;; LONG OPT + collect + (let ((o (car (find-opts self (string-left-trim "-" a) :recurse t))) + (has-eq (long-opt-has-eq-p a))) + (cond + ((and has-eq o) + (setf (cli-opt-val o) (cdr has-eq)) + (make-cli-node 'opt o)) + ((and (not has-eq) o) + (prog1 + (%compose-long-opt o (pop args)) + (setq skip t))) + (t ;; (not o) (not has-eq) (with-opt-restart-case a - (clap-unknown-argument a))) - else - if (long-opt-p a) ;; LONG OPT - collect - (let ((o (find-opts self (string-left-trim "-" a) :recurse t)) - (has-eq (long-opt-has-eq-p a))) - (cond - ((and has-eq o) - (setf (cli-opt-val o) (cdr has-eq)) - (make-cli-node 'opt o)) - ((and (not has-eq) o) - (prog1 (%compose-long-opt (car o) args) - (push (1+ i) holes))) - (t ;; (not o) (not has-eq) - (with-opt-restart-case a - (clap-unknown-argument a))))) - ;; OPT GROUP - else - if (opt-group-p a) - collect nil - ;; CMD - else - collect - (let ((cmd (find-cmd self a))) - (if cmd - ;; TBD - (make-cli-node 'cmd (find-cmd self a)) - ;; ARG - (make-cli-node 'arg a))))))) + (clap-unknown-argument a))))) + ;; OPT GROUP + else if (opt-group-p a) + collect (make-cli-node 'group nil) + else ;; CMD or ARG + collect + (let ((cmd (find-cmd self a))) + (if cmd + ;; CMD + (make-cli-node 'cmd cmd) + ;; ARG + (make-cli-node 'arg a)))))) (defmethod install-ast ((self cli-cmd) (ast cli-ast)) "Install the given AST, recursively filling in value slots." @@ -203,10 +199,10 @@ ;; itself is consumed. validation is performed in proc-args. ;; before doing anything else we lock SELF, which should remain - ;; locked for the full runtime duration. - (setf (cli-lock-p self) t) + ;; locked until all subcommands have completed + (activate-cmd self) (loop named install - for (node . tail) on (debug! (ast ast)) + for (node . tail) on (ast ast) until (null node) do (let ((kind (cli-node-kind node)) (form (cli-node-form node))) @@ -259,4 +255,4 @@ (call-cmd self (cli-cmd-args self) (active-opts self)) (loop for c across (active-cmds self) do (do-cmd c)))) - + diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/clap/opt.lisp --- a/lisp/lib/cli/clap/opt.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/clap/opt.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -42,14 +42,15 @@ (description nil :type (or null string)) (lock nil :type boolean)) -(defun %compose-short-opt (o arg) - (declare (ignorable arg)) +(defmethod activate-opt ((self cli-opt)) + (setf (cli-lock-p self) t)) + +(defun %compose-short-opt (o) (setf (cli-opt-val o) t) (make-cli-node 'opt o)) -(defun %compose-long-opt (o args) - (declare (ignorable args)) - (setf (cli-opt-val o) (or (pop args) t)) +(defun %compose-long-opt (o &optional val) + (setf (cli-opt-val o) val) (make-cli-node 'opt o)) (defmethod handle-unknown-argument ((self cli-opt) arg)) diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/clap/pkg.lisp --- a/lisp/lib/cli/clap/pkg.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/clap/pkg.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -41,7 +41,9 @@ :handle-missing-arg :handle-invalid-arg :clap-missing-argument - :clap-invalid-argument)) + :clap-invalid-argument + :activate-cmd + :activate-opt)) (defpackage :cli/clap/ast (:use :cl :std :log :dat/sxp) @@ -58,7 +60,8 @@ :parse-form-opt :parse-list-op :parse-sym-op :parse-key-op :pasre-num-op :parse-file-op :parse-dir-op :cli :cli-cd :with-cli :opts :cmds :debug-opts - :cli-opt :cli-cmd :cli-opt-val :cli-opt-lock :cli-opt-name)) + :cli-opt :cli-cmd :cli-opt-val :cli-opt-lock :cli-opt-name + :active-cmds)) (defpackage :cli/clap/simple (:use :cl :std :log :sb-ext) diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/clap/proto.lisp --- a/lisp/lib/cli/clap/proto.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/clap/proto.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -41,6 +41,10 @@ (defgeneric active-opts (self &optional global)) +(defgeneric activate-opt (self)) + +(defgeneric activate-cmd (self)) + (defgeneric find-short-opts (self ch &key)) (defgeneric call-opt (self arg)) diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/clap/util.lisp --- a/lisp/lib/cli/clap/util.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/clap/util.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -14,8 +14,8 @@ (defun long-opt-p (str) (declare (simple-string str)) - (and (char= (aref str 0) (aref str 1) #\-) - (> (length str) 2))) + (and (> (length str) 2) + (char= (aref str 0) (aref str 1) #\-))) (defun long-opt-has-eq-p (str) "Return non-nil if STR is a long-opt which has an '=' somewhere, @@ -27,8 +27,8 @@ (defun short-opt-p (str) (declare (simple-string str)) (and (char= (aref str 0) #\-) - (not (char= (aref str 1) #\-)) - (> (length str) 1))) + (> (length str) 1) + (not (char= (aref str 1) #\-)))) (defun opt-group-p (str) (declare (simple-string str)) diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/multi.lisp --- a/lisp/lib/cli/multi.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/multi.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -39,9 +39,9 @@ When you save an executable lisp image with this function you should arrange for symlinks for each handled value of (ARG0) to be generated ." - `(defmain (:exit ,exit :export ,export) - (string-case ((pathname-name (arg0)) :default ,default) - ,@mains))) + `(cli/clap::defmain (:exit ,exit :export ,export) + (string-case ((pathname-name (arg0)) :default ,default) + ,@mains))) (defun make-symlinks (src &optional directory &rest names) "Make a set of symlinks from SRC to NAMES. diff -r 926d95e5fdc7 -r 6e5006dfe7b8 lisp/lib/cli/pkg.lisp --- a/lisp/lib/cli/pkg.lisp Thu Sep 12 16:48:47 2024 -0400 +++ b/lisp/lib/cli/pkg.lisp Thu Sep 12 22:38:22 2024 -0400 @@ -99,7 +99,7 @@ (:export :run-emacs :run-emacsclient :org-store-link)) (defpackage :cli/multi - (:use :cl :std :cli/clap :cli/repl) + (:use :cl :std) (:export #:define-multi-main #:make-symlinks))