changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: clap

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)))