changeset 339: |
8f1c1d79a96c |
parent 338: |
1d281be30842 |
child 340: |
5ac5e6516f6f |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Mon, 13 May 2024 18:07:07 -0400 |
files: |
lisp/bin/skel.lisp lisp/lib/cli/clap.lisp |
description: |
clap |
1.1--- a/lisp/bin/skel.lisp Mon May 13 17:22:48 2024 -0400
1.2+++ b/lisp/bin/skel.lisp Mon May 13 18:07:07 2024 -0400
1.3@@ -20,8 +20,8 @@
1.4 :info)))
1.5
1.6 ;; TODO 2023-10-13: almost there
1.7-(defopt skc-config
1.8- (init-user-skelrc (when $val (parse-file-opt $val))))
1.9+;; (defopt skc-config
1.10+;; (init-user-skelrc (when $val (parse-file-opt $val))))
1.11
1.12 (defcmd skc-edit
1.13 (let ((file (or (when $args (pop $args)) (find-skelfile #P"."))))
1.14@@ -87,10 +87,8 @@
1.15 (":imports" (sk-imports (find-skelfile #P"." :load t)))
1.16 (":stash" (sk-stash (find-skelfile #P"." :load t)))
1.17 (":store" (sk-store (find-skelfile #P"." :load t)))
1.18- (":config" (if (probe-file *user-skelrc*)
1.19- (describe (load-user-skelrc) t)
1.20- (describe *skel-user-config* nil)))
1.21- (":cache" (sk-cache (find-skelfile #P"." :load t)))))
1.22+ (":config" (describe *skel-user-config* nil))
1.23+ (":cache" (sk-cache *skel-user-config*))))
1.24
1.25 (defcmd skc-show
1.26 (if $args
1.27@@ -160,13 +158,16 @@
1.28
1.29 (defcmd skc-shell
1.30 (sb-ext:enable-debugger)
1.31+ (trace! "starting skel shell")
1.32 (setq *no-exit* t)
1.33 (cli/clap::with-cli-handlers
1.34 (progn
1.35+ (in-package :sk-user)
1.36 (use-package :cl-user)
1.37 (use-package :sb-ext)
1.38 (use-package :std-user)
1.39 (init-skel-vars)
1.40+ (println "Welcome to SKEL")
1.41 (sb-impl::toplevel-repl nil))))
1.42
1.43 (define-cli $cli
1.44@@ -181,8 +182,7 @@
1.45 :thunk skc-version)
1.46 (:name "level" :global t :description "set log level (warn,info,debug,trace)"
1.47 :thunk skc-level)
1.48- (:name "config" :global t :description "set a custom skel user config" :kind file
1.49- :thunk skc-config)
1.50+ (:name "config" :global t :description "set a custom skel user config" :kind file)
1.51 (:name "input" :global t :description "input source" :kind string)
1.52 (:name "output" :global t :description "output target" :kind string))
1.53 :cmds (make-cmds
1.54@@ -248,7 +248,5 @@
1.55 (in-readtable :shell)
1.56 (with-cli (opts cmds) $cli
1.57 (load-skelrc)
1.58- ;; TODO 2024-01-01: need to parse out CMD opts from args slot - they still there
1.59- (do-opt (find-opt $cli "level"))
1.60 (do-cmd $cli)
1.61 (debug-opts $cli))))
2.1--- a/lisp/lib/cli/clap.lisp Mon May 13 17:22:48 2024 -0400
2.2+++ b/lisp/lib/cli/clap.lisp Mon May 13 18:07:07 2024 -0400
2.3@@ -274,7 +274,7 @@
2.4 ;; note that cli-opts can have a nil or unbound name slot
2.5 (name "" :type string)
2.6 (kind 'bool :type symbol)
2.7- (thunk #'default-thunk :type (or function symbol))
2.8+ (thunk nil :type (or null function symbol))
2.9 (val nil)
2.10 (global nil :type boolean)
2.11 (description nil :type (or null string))
2.12@@ -304,11 +304,11 @@
2.13 (cli-opt-val self))))
2.14
2.15 (defmethod print-usage ((self cli-opt) &optional stream)
2.16- (format stream " -~(~{~A~^/--~}~)~A~A"
2.17+ (format stream "-~(~{~A~^/--~}~)~A~A"
2.18 (let ((n (cli-opt-name self)))
2.19 (declare (simple-string n))
2.20 (list (make-shorty n) n))
2.21- (if (cli-opt-global self) "* " " ")
2.22+ (if (cli-opt-global self) "* " " ")
2.23 (if-let ((d (and (slot-boundp self 'description) (cli-opt-description self))))
2.24 (format stream ": ~A" (the simple-string d))
2.25 "")))
2.26@@ -321,7 +321,8 @@
2.27 (equal kind bk)))))
2.28
2.29 (defmethod call-opt ((self cli-opt) arg)
2.30- (setf (cli-opt-val self) (funcall (cli-opt-thunk self) arg)))
2.31+ (when-let ((thunk (cli-opt-thunk self)))
2.32+ (setf (cli-opt-val self) (funcall thunk arg))))
2.33
2.34 (defmethod do-opt ((self cli-opt))
2.35 (call-opt self (cli-opt-val self)))
2.36@@ -357,17 +358,17 @@
2.37
2.38 (defmethod print-usage ((self cli-cmd) &optional stream)
2.39 (with-slots (opts cmds) self
2.40- (format stream "~(~A~) ~A~A~A"
2.41+ (format stream "~(~A~) ~A~A~A"
2.42 (cli-name self)
2.43 (if-let ((d (and (slot-boundp self 'description) (cli-description self))))
2.44- (format nil ": ~A" d)
2.45+ (format nil ": ~A" d)
2.46 "")
2.47 (if (null opts)
2.48 ""
2.49 (format nil "~{~% ~A~^~}" (loop for o across opts collect (print-usage o nil))))
2.50 (if (null cmds)
2.51 ""
2.52- (format nil "~% ~{! ~A~}" (loop for c across cmds collect (print-usage c nil)))))))
2.53+ (format nil "~{!~A~}" (loop for c across cmds collect (print-usage c nil)))))))
2.54
2.55 (defmethod push-cmd ((self cli-cmd) (place cli-cmd))
2.56 (vector-push self (cli-cmds place)))