# HG changeset patch
# User Richard Westhaver <ellis@rwest.io>
# Date 1727560086 14400
# Node ID c5fe76568de0d1ee6a94d79a70d08e89dc6af1c0
# Parent  5e8b1855f866e56d49bad383b7ee341e1d2cdf03
fixed clap objects to support make-load-form method - thunk is symbol only

diff -r 5e8b1855f866 -r c5fe76568de0 lisp/lib/cli/clap/cli.lisp
--- a/lisp/lib/cli/clap/cli.lisp	Sat Sep 28 16:42:55 2024 -0400
+++ b/lisp/lib/cli/clap/cli.lisp	Sat Sep 28 17:48:06 2024 -0400
@@ -26,9 +26,9 @@
     `(,*default-cli-def* ,%name (make-cli ,%class :name ,name
                                                   :version ,version
                                                   :description ,description
-                                                  :thunk ,thunk
-                                                  :opts (make-opts ',opts)
-                                                  :cmds (make-cmds ',cmds)))))
+                                                  :thunk ',thunk
+                                                  :opts ,(make-opts opts)
+                                                  :cmds ,(make-cmds cmds)))))
 
 (defmacro defmain (name (&key (exit t)) &body body)
   "Define a CLI main function in the current package."
diff -r 5e8b1855f866 -r c5fe76568de0 lisp/lib/cli/clap/cmd.lisp
--- a/lisp/lib/cli/clap/cmd.lisp	Sat Sep 28 16:42:55 2024 -0400
+++ b/lisp/lib/cli/clap/cmd.lisp	Sat Sep 28 17:48:06 2024 -0400
@@ -16,7 +16,7 @@
          :accessor opts :type (vector cli-opt))
    (cmds :initarg :cmds :initform (make-array 0 :element-type 'cli-cmd :adjustable t)
          :accessor cmds :type (vector cli-cmd))
-   (thunk :initform #'default-thunk :initarg :thunk :accessor cli-thunk :type function-lambda-expression)
+   (thunk :initform 'default-thunk :initarg :thunk :accessor cli-thunk :type symbol)
    (lock :initform nil :initarg :lock :accessor cli-lock-p :type boolean)
    (description :initarg :description :accessor cli-description :type string)
    (args :initform nil :initarg :args :accessor cli-cmd-args))
@@ -28,9 +28,14 @@
     (unless (stringp name) (setf name (format nil "~(~A~)" name)))
     (unless (vectorp cmds) (setf cmds (make-cmds cmds)))
     (unless (vectorp opts) (setf opts (make-opts opts)))
-    (when (symbolp thunk) (setf thunk (symbol-function thunk)))
     self))
 
+(defmethod make-load-form ((obj cli-cmd) &optional env)
+  (make-load-form-saving-slots 
+   obj 
+   :slot-names '(name opts cmds thunk lock description args)
+   :environment env))
+                               
 (defmethod print-object ((self cli-cmd) stream)
   (print-unreadable-object (self stream :type t)
     (format stream "~A :opts ~A :cmds ~A :args ~A"
diff -r 5e8b1855f866 -r c5fe76568de0 lisp/lib/cli/clap/opt.lisp
--- a/lisp/lib/cli/clap/opt.lisp	Sat Sep 28 16:42:55 2024 -0400
+++ b/lisp/lib/cli/clap/opt.lisp	Sat Sep 28 17:48:06 2024 -0400
@@ -36,7 +36,7 @@
   ;; note that cli-opts can have a nil or unbound name slot
   (name "" :type string)
   (kind 'boolean :type (or symbol list))
-  (thunk #'identity :type (or function symbol))
+  (thunk 'identity :type symbol)
   (val nil)
   (global nil :type boolean)
   (description nil :type (or null string))
@@ -67,10 +67,14 @@
 (defmethod initialize-instance :after ((self cli-opt) &key)
   (with-slots (name thunk) self
     (unless (stringp name) (setf name (format nil "~(~A~)" name)))
-    ;; REVIEW 2024-09-16: 
-    (when (symbolp thunk) (setf thunk (symbol-function thunk)))
     self))
 
+(defmethod make-load-form ((obj cli-opt) &optional env)
+  (make-load-form-saving-slots
+   obj
+   :slot-names '(name kind thunk val global description lock)
+   :environment env))
+
 (defmethod install-thunk ((self cli-opt) (lambda function) &optional compile)
   "Install THUNK into the corresponding slot in cli-cmd SELF."
   (let ((%thunk (if compile (compile nil lambda) lambda)))