changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/lib/cli/clap/opt.lisp

revision 655: 65102f74d1ae
parent 654: 3dd1924ad5ea
child 683: c5fe76568de0
     1.1--- a/lisp/lib/cli/clap/opt.lisp	Sun Sep 15 22:23:16 2024 -0400
     1.2+++ b/lisp/lib/cli/clap/opt.lisp	Mon Sep 16 21:28:33 2024 -0400
     1.3@@ -36,14 +36,17 @@
     1.4   ;; note that cli-opts can have a nil or unbound name slot
     1.5   (name "" :type string)
     1.6   (kind 'boolean :type (or symbol list))
     1.7-  (thunk nil :type (or null function symbol))
     1.8+  (thunk #'identity :type (or function symbol))
     1.9   (val nil)
    1.10   (global nil :type boolean)
    1.11   (description nil :type (or null string))
    1.12   (lock nil :type boolean))
    1.13 
    1.14+(defmethod cli-name ((self cli-opt))
    1.15+  (cli-opt-name self))
    1.16+
    1.17 (defmethod activate-opt ((self cli-opt))
    1.18-  (setf (cli-lock-p self) t))
    1.19+  (setf (cli-opt-lock self) t))
    1.20 
    1.21 (defun %compose-short-opt (o)
    1.22   (setf (cli-opt-val o) t)
    1.23@@ -64,7 +67,8 @@
    1.24 (defmethod initialize-instance :after ((self cli-opt) &key)
    1.25   (with-slots (name thunk) self
    1.26     (unless (stringp name) (setf name (format nil "~(~A~)" name)))
    1.27-    (when (symbolp thunk) (setf thunk (funcall (compile nil `(lambda () ,(symbol-function thunk))))))
    1.28+    ;; REVIEW 2024-09-16: 
    1.29+    (when (symbolp thunk) (setf thunk (symbol-function thunk)))
    1.30     self))
    1.31 
    1.32 (defmethod install-thunk ((self cli-opt) (lambda function) &optional compile)
    1.33@@ -98,11 +102,10 @@
    1.34            (equal kind bk)))))
    1.35 
    1.36 (defmethod call-opt ((self cli-opt) arg)
    1.37-  (when-let ((thunk (cli-opt-thunk self)))
    1.38-    (setf (cli-opt-val self) (funcall thunk arg))))
    1.39+  (funcall (cli-opt-thunk self) arg))
    1.40 
    1.41 (defmethod do-opt ((self cli-opt))
    1.42-  (call-opt self (cli-opt-val self)))
    1.43+  (setf (cli-opt-val self) (call-opt self (cli-opt-val self))))
    1.44 
    1.45 (defmethod do-opts ((self vector) &optional global)
    1.46   (loop for opt across self