changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: fixed clap objects to support make-load-form method - thunk is symbol only

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