1.1--- a/emacs.sk Fri Jul 26 19:28:10 2024 -0400
1.2+++ b/emacs.sk Fri Jul 26 23:12:33 2024 -0400
1.3@@ -1,4 +1,5 @@
1.4 ;;; core/lisp skel system
1.5 :name "core/emacs"
1.6 :path "emacs"
1.7+;; :components ((:org "babel"))
1.8 :rules ()
1.9\ No newline at end of file
2.1--- a/lisp/bin/rdb.lisp Fri Jul 26 19:28:10 2024 -0400
2.2+++ b/lisp/bin/rdb.lisp Fri Jul 26 23:12:33 2024 -0400
2.3@@ -89,7 +89,7 @@
2.4
2.5 (defmain ()
2.6 (let ((*log-level* :info))
2.7- (with-cli (opts cmds args) $cli
2.8+ (with-slots (opts cmds args) *cli*
2.9 ;; FIXME 2024-05-07: needs to be triggered explicitly - need to support
2.10 ;; running global opt thunks even when no arg present - macro key
2.11 (if (active-cmds $cli)
3.1--- a/lisp/lib/cli/clap/ast.lisp Fri Jul 26 19:28:10 2024 -0400
3.2+++ b/lisp/lib/cli/clap/ast.lisp Fri Jul 26 23:12:33 2024 -0400
3.3@@ -17,9 +17,8 @@
3.4
3.5 (defstruct (cli-ast (:constructor make-cli-ast (ast))) ast)
3.6
3.7-(defgeneric cli-ast (self)
3.8- (:method ((self cli-ast))
3.9- (cli-ast-ast self)))
3.10+(defmethod ast ((self cli-ast))
3.11+ (cli-ast-ast self))
3.12
3.13 (defgeneric proc-args (self args))
3.14
4.1--- a/lisp/lib/cli/clap/cli.lisp Fri Jul 26 19:28:10 2024 -0400
4.2+++ b/lisp/lib/cli/clap/cli.lisp Fri Jul 26 23:12:33 2024 -0400
4.3@@ -24,17 +24,16 @@
4.4 %class (cdr name)))
4.5 `(,*default-cli-def* ,%name (apply #'make-cli ,%class (walk-cli-slots ',body)))))
4.6
4.7-(defmacro defmain ((&key return (exit t) (export t)) &body body)
4.8+(defmacro defmain ((&key (exit t) (export t)) &body body)
4.9 "Define a CLI main function in the current package."
4.10- (with-gensyms (retval)
4.11- (let ((main (symbolicate "MAIN")))
4.12- (when return (setf retval return))
4.13- `(let ((*no-exit* ,(not exit)))
4.14- (defun ,main ()
4.15- "Run the top-level function and print to *STDOUT*."
4.16- (with-cli-handlers
4.17- (progn ,@body ,@(unless (not (boundp 'retval)) (list retval)))))
4.18- ,@(when export `((export ',main)))))))
4.19+ (let ((main (symbolicate "MAIN")))
4.20+ `(let ((*no-exit* ,(not exit)))
4.21+ (defun ,main ()
4.22+ "Run the top-level function and print to *STDOUT*."
4.23+ (with-cli-handlers
4.24+ (progn
4.25+ ,@body (values))))
4.26+ ,@(when export `((export ',main))))))
4.27
4.28 ;; RESEARCH 2023-09-12: closed over hash-table with short/long flags
4.29 ;; to avoid conflicts. if not, need something like a flag-function
4.30@@ -106,8 +105,14 @@
4.31 (log:debug! (cli-cd cli) o a c)))
4.32
4.33 (defmacro with-cli (slots cli &body body)
4.34- "Like with-slots with some extra bindings."
4.35+ "Like with-slots with some extra bindings.
4.36+
4.37+SLOTS is a list passed to WITH-SLOTS.
4.38+
4.39+CLI is updated based on the current environment and dynamically bound to
4.40+*CLI*."
4.41 `(progn
4.42+ (setq *cli* ,cli)
4.43 (setf (cli-cd ,cli) (sb-posix:getcwd))
4.44 (with-slots ,slots (parse-args ,cli (args) :compile t)
4.45 ,@body)))
5.1--- a/lisp/lib/cli/clap/cmd.lisp Fri Jul 26 19:28:10 2024 -0400
5.2+++ b/lisp/lib/cli/clap/cmd.lisp Fri Jul 26 23:12:33 2024 -0400
5.3@@ -2,6 +2,10 @@
5.4
5.5 ;; Command Objects used to build CLI Applications.
5.6
5.7+;;; Commentary:
5.8+
5.9+;;
5.10+
5.11 ;;; Code:
5.12 (in-package :cli/clap/obj)
5.13
5.14@@ -174,7 +178,7 @@
5.15 ;; locked for the full runtime duration.
5.16 (setf (cli-lock-p self) t)
5.17 (loop named install
5.18- for (node . tail) on (debug! (cli-ast ast))
5.19+ for (node . tail) on (debug! (ast ast))
5.20 until (null node)
5.21 do
5.22 (let ((kind (cli-node-kind node)) (form (cli-node-form node)))
6.1--- a/lisp/lib/cli/clap/macs.lisp Fri Jul 26 19:28:10 2024 -0400
6.2+++ b/lisp/lib/cli/clap/macs.lisp Fri Jul 26 23:12:33 2024 -0400
6.3@@ -31,16 +31,16 @@
6.4
6.5 ;; TODO fix these macros
6.6 (defmacro defcmd (name &body body)
6.7- `(defun ,name ($args $opts)
6.8- (declare (ignorable $args $opts))
6.9- (let (($argc (length $args))
6.10- ($optc (length $opts)))
6.11- (declare (ignorable $argc $optc))
6.12+ `(defun ,name (*args* *opts*)
6.13+ (declare (ignorable *args* *opts*))
6.14+ (let ((*argc* (length *args*))
6.15+ (*optc* (length *opts*)))
6.16+ (declare (ignorable *argc* *optc*))
6.17 ,@body)))
6.18
6.19 (defmacro defopt (name &body body)
6.20- `(defun ,name (&optional $val)
6.21- (declare (ignorable $val))
6.22+ `(defun ,name (&optional *arg*)
6.23+ (declare (ignorable *arg*))
6.24 ,@body))
6.25
6.26 (declaim (inline walk-cli-slots))
6.27@@ -67,7 +67,8 @@
6.28 (fn-name (symbolicate 'parse- kind '-opt)))
6.29 ;; thread em
6.30 (let ((fn1 (unless (null super) (symbolicate "PARSE-" super "-OPT"))))
6.31- `(defun ,fn-name ($val)
6.32- "Parse the cli-opt-val $VAL."
6.33- ,@(when fn1 `((setq $val (funcall #',fn1 $val))))
6.34+ `(defun ,fn-name (&optional arg)
6.35+ "Parse the cli-opt-val *ARG*."
6.36+ (declare (ignorable arg))
6.37+ ,@(when fn1 `((setf *arg* (funcall #',fn1 arg))))
6.38 ,@body)))))
7.1--- a/lisp/lib/cli/clap/pkg.lisp Fri Jul 26 19:28:10 2024 -0400
7.2+++ b/lisp/lib/cli/clap/pkg.lisp Fri Jul 26 23:12:33 2024 -0400
7.3@@ -5,7 +5,9 @@
7.4 ;;; Code:
7.5 (defpackage :cli/clap/vars
7.6 (:use :cl)
7.7- (:export :*cli-group-separator* :*no-exit* :*default-cli-def* :*default-cli-class* :*cli-opt-kinds*))
7.8+ (:export :*cli-group-separator* :*no-exit* :*default-cli-def*
7.9+ :*default-cli-class* :*cli-opt-kinds* :*cli* :*opts*
7.10+ :*args* :*argc* :*arg*))
7.11
7.12 (defpackage :cli/clap/util
7.13 (:use :cl :std :log :sb-ext :cli/clap/vars)
7.14@@ -29,14 +31,15 @@
7.15 :push-cmd :push-opt :cli-equal))
7.16
7.17 (defpackage :cli/clap/ast
7.18- (:use :cl :std :log)
7.19- (:export :cli-node :cli-ast :make-cli-node
7.20+ (:use :cl :std :log :dat/sxp)
7.21+ (:export :cli-node :make-cli-node :cli-ast
7.22 :make-cli-ast :cli-node-kind :cli-node-form))
7.23
7.24 (defpackage :cli/clap/obj
7.25 (:use :cl :std :log
7.26 :sb-ext :cli/clap/proto :cli/clap/macs :cli/clap/util
7.27 :cli/clap/vars :cli/clap/ast :cli/clap/util)
7.28+ (:import-from :dat/sxp :ast)
7.29 (:export :make-cli :define-cli :defmain
7.30 :make-opts :make-cmds :parse-bool-opt :parse-string-opt
7.31 :parse-form-opt :parse-list-op :parse-sym-op :parse-key-op
8.1--- a/lisp/lib/cli/clap/vars.lisp Fri Jul 26 19:28:10 2024 -0400
8.2+++ b/lisp/lib/cli/clap/vars.lisp Fri Jul 26 23:12:33 2024 -0400
8.3@@ -23,3 +23,26 @@
8.4 (defvar *cli-opt-kinds* ;; make sure to keep this in sync with the list of parsers above
8.5 (let ((kinds '(boolean string form list symbol keyword number file directory pathname)))
8.6 (make-array (length kinds) :element-type 'symbol :initial-contents kinds)))
8.7+
8.8+(defvar *cli* nil
8.9+ "Most recently used CLI object.
8.10+This symbol is bound in the body of the WITH-CLI macro.")
8.11+
8.12+(defvar *args* nil
8.13+ "Current command arguments.
8.14+Bound for the lifetime of a DEFCMD function.")
8.15+
8.16+(defvar *opts* nil
8.17+ "Current command options.
8.18+Bound for the lifetime of a DEFOPT function.")
8.19+
8.20+(declaim (integer *argc* *optc*))
8.21+(defvar *argc* 0
8.22+ "Current count of command arguments.
8.23+This value may be updated throughout the lifetime of a function defined with
8.24+DEFCMD.")
8.25+
8.26+(defvar *optc* 0
8.27+ "Current count of command options.
8.28+This value may be updated throughout the lifetime of a function defined with
8.29+DEFOPT.")
9.1--- a/lisp/lib/cli/cli.asd Fri Jul 26 19:28:10 2024 -0400
9.2+++ b/lisp/lib/cli/cli.asd Fri Jul 26 23:12:33 2024 -0400
9.3@@ -1,6 +1,6 @@
9.4 ;;; cli.asd --- CLI library
9.5 (defsystem :cli
9.6- :depends-on (:std :log)
9.7+ :depends-on (:std :log :dat)
9.8 :components ((:file "pkg")
9.9 (:file "ansi" :depends-on ("pkg"))
9.10 (:file "env" :depends-on ("pkg"))
10.1--- a/lisp/lib/cli/tests.lisp Fri Jul 26 19:28:10 2024 -0400
10.2+++ b/lisp/lib/cli/tests.lisp Fri Jul 26 23:12:33 2024 -0400
10.3@@ -239,7 +239,7 @@
10.4 (print-help cli s))))
10.5 (is (string= "foobar" (cli/clap::parse-string-opt "foobar")))))
10.6
10.7-(make-opt-parser thing $val)
10.8+(make-opt-parser thing *arg*)
10.9
10.10 (deftest clap-opts ()
10.11 "CLAP opt tests."
10.12@@ -672,12 +672,10 @@
10.13 (deftest clap-ast ())
10.14
10.15 (deftest main-output ()
10.16- (let ((*test-target* nil))
10.17- (compile (defmain (:return *test-target* :exit nil :export nil)
10.18- (let ((*test-target* t))
10.19- *test-target*)))
10.20- (is (funcall #'main))
10.21- (is (null *test-target*))))
10.22+ (compile (defmain (:exit nil :export nil)
10.23+ (let ((test-target t))
10.24+ test-target)))
10.25+ (is (not (funcall #'main))))
10.26
10.27 (deftest sbcl-tools ()
10.28 (with-sbcl (:noinform t :quit t)
11.1--- a/lisp/lib/obj/obj.asd Fri Jul 26 19:28:10 2024 -0400
11.2+++ b/lisp/lib/obj/obj.asd Fri Jul 26 23:12:33 2024 -0400
11.3@@ -1,6 +1,6 @@
11.4 (defsystem :obj
11.5 :description "Lisp object library"
11.6- :depends-on (:std :cli :quri)
11.7+ :depends-on (:std :quri)
11.8 :serial t
11.9 :components ((:file "pkg")
11.10 (:module "meta"
