changeset 683: |
c5fe76568de0 |
parent 682: |
5e8b1855f866 |
child 684: |
29fe829a7ac3 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 28 Sep 2024 17:48:06 -0400 |
files: |
lisp/lib/cli/clap/cli.lisp lisp/lib/cli/clap/cmd.lisp lisp/lib/cli/clap/opt.lisp |
description: |
fixed clap objects to support make-load-form method - thunk is symbol only |
1.1--- a/lisp/lib/cli/clap/cli.lisp Sat Sep 28 16:42:55 2024 -0400
1.2+++ b/lisp/lib/cli/clap/cli.lisp Sat Sep 28 17:48:06 2024 -0400
1.3@@ -26,9 +26,9 @@
1.4 `(,*default-cli-def* ,%name (make-cli ,%class :name ,name
1.5 :version ,version
1.6 :description ,description
1.7- :thunk ,thunk
1.8- :opts (make-opts ',opts)
1.9- :cmds (make-cmds ',cmds)))))
1.10+ :thunk ',thunk
1.11+ :opts ,(make-opts opts)
1.12+ :cmds ,(make-cmds cmds)))))
1.13
1.14 (defmacro defmain (name (&key (exit t)) &body body)
1.15 "Define a CLI main function in the current package."
2.1--- a/lisp/lib/cli/clap/cmd.lisp Sat Sep 28 16:42:55 2024 -0400
2.2+++ b/lisp/lib/cli/clap/cmd.lisp Sat Sep 28 17:48:06 2024 -0400
2.3@@ -16,7 +16,7 @@
2.4 :accessor opts :type (vector cli-opt))
2.5 (cmds :initarg :cmds :initform (make-array 0 :element-type 'cli-cmd :adjustable t)
2.6 :accessor cmds :type (vector cli-cmd))
2.7- (thunk :initform #'default-thunk :initarg :thunk :accessor cli-thunk :type function-lambda-expression)
2.8+ (thunk :initform 'default-thunk :initarg :thunk :accessor cli-thunk :type symbol)
2.9 (lock :initform nil :initarg :lock :accessor cli-lock-p :type boolean)
2.10 (description :initarg :description :accessor cli-description :type string)
2.11 (args :initform nil :initarg :args :accessor cli-cmd-args))
2.12@@ -28,9 +28,14 @@
2.13 (unless (stringp name) (setf name (format nil "~(~A~)" name)))
2.14 (unless (vectorp cmds) (setf cmds (make-cmds cmds)))
2.15 (unless (vectorp opts) (setf opts (make-opts opts)))
2.16- (when (symbolp thunk) (setf thunk (symbol-function thunk)))
2.17 self))
2.18
2.19+(defmethod make-load-form ((obj cli-cmd) &optional env)
2.20+ (make-load-form-saving-slots
2.21+ obj
2.22+ :slot-names '(name opts cmds thunk lock description args)
2.23+ :environment env))
2.24+
2.25 (defmethod print-object ((self cli-cmd) stream)
2.26 (print-unreadable-object (self stream :type t)
2.27 (format stream "~A :opts ~A :cmds ~A :args ~A"
3.1--- a/lisp/lib/cli/clap/opt.lisp Sat Sep 28 16:42:55 2024 -0400
3.2+++ b/lisp/lib/cli/clap/opt.lisp Sat Sep 28 17:48:06 2024 -0400
3.3@@ -36,7 +36,7 @@
3.4 ;; note that cli-opts can have a nil or unbound name slot
3.5 (name "" :type string)
3.6 (kind 'boolean :type (or symbol list))
3.7- (thunk #'identity :type (or function symbol))
3.8+ (thunk 'identity :type symbol)
3.9 (val nil)
3.10 (global nil :type boolean)
3.11 (description nil :type (or null string))
3.12@@ -67,10 +67,14 @@
3.13 (defmethod initialize-instance :after ((self cli-opt) &key)
3.14 (with-slots (name thunk) self
3.15 (unless (stringp name) (setf name (format nil "~(~A~)" name)))
3.16- ;; REVIEW 2024-09-16:
3.17- (when (symbolp thunk) (setf thunk (symbol-function thunk)))
3.18 self))
3.19
3.20+(defmethod make-load-form ((obj cli-opt) &optional env)
3.21+ (make-load-form-saving-slots
3.22+ obj
3.23+ :slot-names '(name kind thunk val global description lock)
3.24+ :environment env))
3.25+
3.26 (defmethod install-thunk ((self cli-opt) (lambda function) &optional compile)
3.27 "Install THUNK into the corresponding slot in cli-cmd SELF."
3.28 (let ((%thunk (if compile (compile nil lambda) lambda)))