changeset 643: | f901de70a80e |
parent: | cc13027df6fa |
child: | 3e6a17fb5712 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Tue, 10 Sep 2024 21:26:30 -0400 |
permissions: | -rw-r--r-- |
description: | opt fixes and test updates |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
1 | ;;; cli/clap/cmd.lisp --- Clap Commands |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
2 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
3 | ;; Command Objects used to build CLI Applications. |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
4 | |
560
b9c64be96888
make cli/clap more dynamic
Richard Westhaver <ellis@rwest.io>
parents:
486
diff
changeset
|
5 | ;;; Commentary: |
b9c64be96888
make cli/clap more dynamic
Richard Westhaver <ellis@rwest.io>
parents:
486
diff
changeset
|
6 | |
b9c64be96888
make cli/clap more dynamic
Richard Westhaver <ellis@rwest.io>
parents:
486
diff
changeset
|
7 | ;; |
b9c64be96888
make cli/clap more dynamic
Richard Westhaver <ellis@rwest.io>
parents:
486
diff
changeset
|
8 | |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
9 | ;;; Code: |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
10 | (in-package :cli/clap/obj) |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
11 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
12 | (defclass cli-cmd () |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
13 | ;; name slot is required and must be a string |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
14 | ((name :initarg :name :initform (required-argument :name) :accessor cli-name :type string) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
15 | (opts :initarg :opts :initform (make-array 0 :element-type 'cli-opt :adjustable t) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
16 | :accessor cli-opts :type (vector cli-opt)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
17 | (cmds :initarg :cmds :initform (make-array 0 :element-type 'cli-cmd :adjustable t) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
18 | :accessor cli-cmds :type (vector cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
19 | (thunk :initform #'default-thunk :initarg :thunk :accessor cli-thunk :type function-lambda-expression) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
20 | (lock :initform nil :initarg :lock :accessor cli-lock-p :type boolean) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
21 | (description :initarg :description :accessor cli-description :type string) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
22 | (args :initform nil :initarg :args :accessor cli-cmd-args)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
23 | (:documentation "CLI command class inherited by both the 'main' command which is executed when |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
24 | a CLI is called without arguments, and all subcommands.")) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
25 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
26 | (defmethod initialize-instance :after ((self cli-cmd) &key) |
567 | 27 | (with-slots (name thunk opts cmds) self |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
28 | (unless (stringp name) (setf name (format nil "~(~A~)" name))) |
567 | 29 | (unless (vectorp cmds) (setf cmds (make-cmds cmds))) |
30 | (unless (vectorp opts) (setf opts (make-opts opts))) |
|
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
31 | (when (symbolp thunk) (setf thunk (symbol-function thunk))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
32 | self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
33 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
34 | (defmethod print-object ((self cli-cmd) stream) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
35 | (print-unreadable-object (self stream :type t) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
36 | (format stream "~A :opts ~A :cmds ~A :args ~A" |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
37 | (cli-name self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
38 | (length (cli-opts self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
39 | (length (cli-cmds self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
40 | (length (cli-cmd-args self))))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
41 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
42 | (defmethod print-usage ((self cli-cmd) &optional stream) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
43 | (with-slots (opts cmds) self |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
44 | (format stream "~(~A~) ~A~A~A" |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
45 | (cli-name self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
46 | (if-let ((d (and (slot-boundp self 'description) (cli-description self)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
47 | (format nil ": ~A" d) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
48 | "") |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
49 | (if (null opts) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
50 | "" |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
51 | (format nil "~{~% ~A~^~}" (loop for o across opts collect (print-usage o nil)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
52 | (if (null cmds) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
53 | "" |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
54 | (format nil "~{!~A~}" (loop for c across cmds collect (print-usage c nil))))))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
55 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
56 | (defmethod push-cmd ((self cli-cmd) (place cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
57 | (vector-push self (cli-cmds place))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
58 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
59 | (defmethod push-opt ((self cli-opt) (place cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
60 | (vector-push self (cli-opts place))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
61 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
62 | (defmethod pop-cmd ((self cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
63 | (vector-pop (cli-cmds self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
64 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
65 | (defmethod pop-opt ((self cli-opt)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
66 | (vector-pop (cli-opts self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
67 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
68 | (defmethod cli-equal ((a cli-cmd) (b cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
69 | (with-slots (name opts cmds) a |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
70 | (with-slots ((bn name) (bo opts) (bc cmds)) b |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
71 | (and (string= name bn) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
72 | (if (and (null opts) (null bo)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
73 | t |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
74 | (unless (member nil (loop for oa across opts |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
75 | for ob across bo |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
76 | collect (cli-equal oa ob))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
77 | t)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
78 | (if (and (null cmds) (null bc)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
79 | t |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
80 | (unless (member nil (loop for ca across cmds |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
81 | for cb across bc |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
82 | collect (cli-equal ca cb))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
83 | t)))))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
84 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
85 | (defmethod find-cmd ((self cli-cmd) name &optional active) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
86 | (when-let ((c (find name (cli-cmds self) :key #'cli-name :test #'string=))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
87 | (if active |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
88 | ;; maybe issue warning here? report to user |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
89 | (if (cli-lock-p c) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
90 | c |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
91 | (clap-error c)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
92 | c))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
93 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
94 | (defmethod active-cmds ((self cli-cmd)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
95 | (remove-if-not #'cli-lock-p (cli-cmds self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
96 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
97 | (defmethod find-opts ((self cli-cmd) name &key active recurse) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
98 | (let ((ret)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
99 | (flet ((%find (o obj) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
100 | (when-let ((found (find o (cli-opts obj) :key #'cli-opt-name :test 'equal))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
101 | (push found ret)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
102 | (when (and recurse (cli-cmds self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
103 | (loop for c across (cli-cmds self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
104 | do (%find name c))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
105 | (%find name self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
106 | (when active |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
107 | (setf ret (remove-if-not #'cli-lock-p ret))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
108 | ret))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
109 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
110 | (defmethod active-opts ((self cli-cmd) &optional global) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
111 | (remove-if-not |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
112 | (if global |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
113 | #'active-global-opt-p |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
114 | #'cli-opt-lock) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
115 | (cli-opts self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
116 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
117 | (defmethod find-short-opts ((self cli-cmd) ch &key recurse) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
118 | (let ((ret)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
119 | (flet ((%find (ch obj) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
120 | (when-let ((found (find ch (cli-opts obj) :key #'cli-opt-name :test #'opt-string-prefix-eq))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
121 | (push found ret)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
122 | (when (and recurse (cli-cmds self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
123 | (loop for c across (cli-cmds self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
124 | do (%find ch c))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
125 | (%find ch self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
126 | ret))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
127 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
128 | (declaim (inline solop)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
129 | (defun solop (self) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
130 | (and (= 0 (length (active-cmds self)) (length (active-opts self))))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
131 | |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
132 | (defmethod proc-args ((self cli-cmd) args) |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
133 | "Process ARGS into an ast. Each element of the ast is a node with a |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
134 | :kind slot, indicating the type of node and a :form slot which stores |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
135 | a value. |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
136 | |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
137 | For now we parse group separators '--' and insert a nil into the tree, |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
138 | this will likely change to generating a new branch in the ast as it |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
139 | should be." |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
140 | (make-cli-ast |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
141 | (let ((holes)) ;; list of arg indexes which can be skipped since they're |
567 | 142 | ;; consumed by an opt |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
143 | (loop |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
144 | for i below (length args) |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
145 | for (a . args) on args |
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
146 | if (member i holes) |
643
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
147 | do (continue) ;; skip args which have been consumed already |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
148 | else |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
149 | if (= (length a) 1) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
150 | collect (make-cli-node 'arg a) ; always treat single-char as arg |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
151 | else |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
152 | if (short-opt-p a) ;; SHORT OPT |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
153 | collect |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
154 | (if-let ((o (find-short-opts self (aref a 1) :recurse t))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
155 | (%compose-short-opt (car o) a) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
156 | (make-cli-node 'arg a)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
157 | else |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
158 | if (long-opt-p a) ;; LONG OPT |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
159 | collect |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
160 | (let ((o (find-opts self (string-left-trim "-" a) :recurse t)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
161 | (has-eq (long-opt-has-eq-p a))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
162 | (cond |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
163 | ((and has-eq o) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
164 | (setf (cli-opt-val o) (cdr has-eq)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
165 | (make-cli-node 'opt o)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
166 | ((and (not has-eq) o) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
167 | (prog1 (%compose-long-opt (car o) args) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
168 | (push (1+ i) holes))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
169 | ((and has-eq (not o)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
170 | (warn 'warning "opt not recognized" a) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
171 | (let ((val (cdr has-eq))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
172 | (make-cli-node 'opt (make-cli-opt :name (car has-eq) :kind (type-of val) :val val)))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
173 | (t ;; (not o) (not has-eq) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
174 | (warn 'warning "opt not recognized" a) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
175 | (make-cli-node 'arg a)))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
176 | ;; OPT GROUP |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
177 | else |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
178 | if (opt-group-p a) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
179 | collect nil |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
180 | ;; CMD |
643
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
181 | else |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
182 | collect |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
183 | (let ((cmd (find-cmd self a))) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
184 | (if cmd |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
185 | ;; TBD |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
186 | (make-cli-node 'cmd (find-cmd self a)) |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
187 | ;; ARG |
f901de70a80e
opt fixes and test updates
Richard Westhaver <ellis@rwest.io>
parents:
626
diff
changeset
|
188 | (make-cli-node 'arg a))))))) |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
189 | |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
190 | (defmethod install-ast ((self cli-cmd) (ast cli-ast)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
191 | "Install the given AST, recursively filling in value slots." |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
192 | (with-slots (cmds opts) self |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
193 | ;; we assume all nodes in the ast have been validated and the ast |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
194 | ;; itself is consumed. validation is performed in proc-args. |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
195 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
196 | ;; before doing anything else we lock SELF, which should remain |
485 | 197 | ;; locked for the full runtime duration. |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
198 | (setf (cli-lock-p self) t) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
199 | (loop named install |
560
b9c64be96888
make cli/clap more dynamic
Richard Westhaver <ellis@rwest.io>
parents:
486
diff
changeset
|
200 | for (node . tail) on (debug! (ast ast)) |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
201 | until (null node) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
202 | do |
426
3e721a3349a0
completed phase2 of clap migration
Richard Westhaver <ellis@rwest.io>
parents:
419
diff
changeset
|
203 | (let ((kind (cli-node-kind node)) (form (cli-node-form node))) |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
204 | (case kind |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
205 | ;; opts |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
206 | (opt |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
207 | (let ((name (cli-opt-name form))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
208 | (when-let ((o (car (find-opts self name)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
209 | (setf o form) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
210 | (setf (cli-opt-lock o) t)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
211 | ;; when we encounter a command we recurse over the tail |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
212 | (cmd |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
213 | (when-let ((c (find-cmd self (cli-name form)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
214 | ;; handle the rest of the AST |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
215 | (setf c (install-ast c (make-cli-ast tail))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
216 | (return-from install))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
217 | (arg (push-arg form self))))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
218 | (setf (cli-cmd-args self) (nreverse (cli-cmd-args self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
219 | self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
220 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
221 | (defmethod install-thunk ((self cli-cmd) (lambda function) &optional compile) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
222 | "Install THUNK into the corresponding slot in cli-cmd SELF." |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
223 | (let ((%thunk (if compile (compile nil lambda) lambda))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
224 | (setf (cli-thunk self) %thunk) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
225 | self)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
226 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
227 | (defmethod push-arg (arg (self cli-cmd)) |
485 | 228 | "Push an ARG onto the corresponding slot of a CLI-CMD." |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
229 | (push arg (cli-cmd-args self))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
230 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
231 | (defmethod parse-args ((self cli-cmd) args &key (compile t)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
232 | "Parse ARGS and return the updated object SELF. |
485 | 233 | ARGS is assumed to be a valid cli-ast (list of cli-nodes), unless COMPILE is |
234 | t, in which case a list of strings is assumed." |
|
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
235 | (with-slots (opts cmds) self |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
236 | (let ((args (if compile (proc-args self args) args))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
237 | (install-ast self args)))) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
238 | |
626 | 239 | ;; WARNING: make sure to fill in the opt and cmd slots with values |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
240 | ;; from the top-level args before calling a command. |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
241 | (defmethod call-cmd ((self cli-cmd) args opts) |
485 | 242 | (trace! "calling command:" args opts) |
419
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
243 | (funcall (cli-thunk self) args opts)) |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
244 | |
0f0e5f9b5c55
add emacs/babel.org, finished clap refactor phase 1, test system fixes and more top-level packages
Richard Westhaver <ellis@rwest.io>
parents:
404
diff
changeset
|
245 | (defmethod do-cmd ((self cli-cmd)) |
485 | 246 | "Perform the command, recursively calling child commands and opts if necessary." |
486 | 247 | (loop for o across (active-opts self) |
248 | do (do-opt o)) |
|
249 | (if (solop self) |
|
250 | (call-cmd self (cli-cmd-args self) (active-opts self)) |
|
251 | (loop for c across (active-cmds self) |
|
252 | do (do-cmd c)))) |
|
253 | |