1.1--- a/lisp/lib/cli/clap/cmd.lisp Sun Sep 08 21:14:30 2024 -0400
1.2+++ b/lisp/lib/cli/clap/cmd.lisp Tue Sep 10 21:26:30 2024 -0400
1.3@@ -144,29 +144,48 @@
1.4 for i below (length args)
1.5 for (a . args) on args
1.6 if (member i holes)
1.7- do (continue) ;; skip args which have been consumed already
1.8- else if (= (length a) 1)
1.9- collect (make-cli-node 'arg a) ; always treat single-char as arg
1.10- else if (short-opt-p a) ;; SHORT OPT
1.11- collect (if-let ((o (find-short-opts self (aref a 1) :recurse t)))
1.12- (%compose-short-opt (car o) a)
1.13- (make-cli-node 'arg a))
1.14- else if (long-opt-p a) ;; LONG OPT
1.15- collect (if-let ((o (find-opts self (string-left-trim "-" a) :recurse t)))
1.16- (prog1 (%compose-long-opt (car o) args)
1.17- (push (1+ i) holes))
1.18- (make-cli-node 'arg a))
1.19- ;; OPT GROUP
1.20- else if (opt-group-p a)
1.21- collect nil
1.22+ do (continue) ;; skip args which have been consumed already
1.23+ else
1.24+ if (= (length a) 1)
1.25+ collect (make-cli-node 'arg a) ; always treat single-char as arg
1.26+ else
1.27+ if (short-opt-p a) ;; SHORT OPT
1.28+ collect
1.29+ (if-let ((o (find-short-opts self (aref a 1) :recurse t)))
1.30+ (%compose-short-opt (car o) a)
1.31+ (make-cli-node 'arg a))
1.32+ else
1.33+ if (long-opt-p a) ;; LONG OPT
1.34+ collect
1.35+ (let ((o (find-opts self (string-left-trim "-" a) :recurse t))
1.36+ (has-eq (long-opt-has-eq-p a)))
1.37+ (cond
1.38+ ((and has-eq o)
1.39+ (setf (cli-opt-val o) (cdr has-eq))
1.40+ (make-cli-node 'opt o))
1.41+ ((and (not has-eq) o)
1.42+ (prog1 (%compose-long-opt (car o) args)
1.43+ (push (1+ i) holes)))
1.44+ ((and has-eq (not o))
1.45+ (warn 'warning "opt not recognized" a)
1.46+ (let ((val (cdr has-eq)))
1.47+ (make-cli-node 'opt (make-cli-opt :name (car has-eq) :kind (type-of val) :val val))))
1.48+ (t ;; (not o) (not has-eq)
1.49+ (warn 'warning "opt not recognized" a)
1.50+ (make-cli-node 'arg a))))
1.51+ ;; OPT GROUP
1.52+ else
1.53+ if (opt-group-p a)
1.54+ collect nil
1.55 ;; CMD
1.56- else
1.57- collect (let ((cmd (find-cmd self a)))
1.58- (if cmd
1.59- ;; TBD
1.60- (make-cli-node 'cmd (find-cmd self a))
1.61- ;; ARG
1.62- (make-cli-node 'arg a)))))))
1.63+ else
1.64+ collect
1.65+ (let ((cmd (find-cmd self a)))
1.66+ (if cmd
1.67+ ;; TBD
1.68+ (make-cli-node 'cmd (find-cmd self a))
1.69+ ;; ARG
1.70+ (make-cli-node 'arg a)))))))
1.71
1.72 (defmethod install-ast ((self cli-cmd) (ast cli-ast))
1.73 "Install the given AST, recursively filling in value slots."