1.1--- a/lisp/lib/cli/clap/cmd.lisp	Tue Sep 10 21:52:14 2024 -0400
     1.2+++ b/lisp/lib/cli/clap/cmd.lisp	Wed Sep 11 17:24:07 2024 -0400
     1.3@@ -88,7 +88,7 @@
     1.4         ;; maybe issue warning here? report to user
     1.5         (if (cli-lock-p c)
     1.6             c
     1.7-            (clap-error c))
     1.8+            (clap-simple-error "inactive (unlocked) cmd: ~A" c))
     1.9         c)))
    1.10 
    1.11 (defmethod active-cmds ((self cli-cmd))
    1.12@@ -129,6 +129,12 @@
    1.13 (defun solop (self)
    1.14   (and (= 0 (length (active-cmds self)) (length (active-opts self)))))
    1.15 
    1.16+(defmacro with-opt-restart-case (arg condition)
    1.17+  "Bind restarts 'use-as-arg' and 'discard-arg' for duration of BODY."
    1.18+  `(restart-case ,condition
    1.19+     (use-as-arg () () (make-cli-node 'arg ,arg))
    1.20+     (discard-arg () () nil)))
    1.21+
    1.22 (defmethod proc-args ((self cli-cmd) args)
    1.23   "Process ARGS into an ast. Each element of the ast is a node with a
    1.24 :kind slot, indicating the type of node and a :form slot which stores
    1.25@@ -145,37 +151,35 @@
    1.26        for (a . args) on args
    1.27        if (member i holes)
    1.28          do (continue) ;; skip args which have been consumed already
    1.29-       else
    1.30-         if (= (length a) 1)
    1.31-           collect (make-cli-node 'arg a) ; always treat single-char as arg
    1.32+       ;; else
    1.33+       ;;   if (= (length a) 1)
    1.34+       ;;     collect (make-cli-node 'arg a) ; always treat single-char as arg
    1.35        else
    1.36          if (short-opt-p a) ;; SHORT OPT
    1.37            collect
    1.38            (if-let ((o (find-short-opts self (aref a 1) :recurse t)))
    1.39              (%compose-short-opt (car o) a)
    1.40-             (make-cli-node 'arg a))
    1.41+             ;;  TODO 2024-09-11: signal error?
    1.42+             (with-opt-restart-case a
    1.43+               (clap-unknown-argument a)))
    1.44        else
    1.45          if (long-opt-p a) ;; LONG OPT
    1.46-           collect
    1.47-           (let ((o (find-opts self (string-left-trim "-" a) :recurse t))
    1.48-                 (has-eq (long-opt-has-eq-p a)))
    1.49-             (cond
    1.50-               ((and has-eq o)
    1.51-                (setf (cli-opt-val o) (cdr has-eq))
    1.52-                (make-cli-node 'opt o))
    1.53-               ((and (not has-eq) o)
    1.54-                (prog1 (%compose-long-opt (car o) args)
    1.55-                  (push (1+ i) holes)))
    1.56-               ((and has-eq (not o))
    1.57-                (warn 'warning "opt not recognized" a)
    1.58-                (let ((val (cdr has-eq)))
    1.59-                  (make-cli-node 'opt (make-cli-opt :name (car has-eq) :kind (type-of val) :val val))))
    1.60-               (t ;; (not o) (not has-eq)
    1.61-                (warn 'warning "opt not recognized" a)
    1.62-                (make-cli-node 'arg a))))
    1.63+           collect           
    1.64+             (let ((o (find-opts self (string-left-trim "-" a) :recurse t))
    1.65+                   (has-eq (long-opt-has-eq-p a)))
    1.66+               (cond
    1.67+                 ((and has-eq o)
    1.68+                  (setf (cli-opt-val o) (cdr has-eq))
    1.69+                  (make-cli-node 'opt o))
    1.70+                 ((and (not has-eq) o)
    1.71+                  (prog1 (%compose-long-opt (car o) args)
    1.72+                    (push (1+ i) holes)))
    1.73+                 (t ;; (not o) (not has-eq)
    1.74+                  (with-opt-restart-case a
    1.75+                    (clap-unknown-argument a)))))
    1.76            ;; OPT GROUP
    1.77        else 
    1.78-         if (opt-group-p a) 
    1.79+         if (opt-group-p a)
    1.80            collect nil
    1.81        ;; CMD
    1.82        else