changelog shortlog graph tags branches changeset file revisions annotate raw help

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

revision 643: f901de70a80e
parent 626: cc13027df6fa
child 645: 3e6a17fb5712
     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."