branch: externals/transient
commit fcc60e272da53a3962e082727784fd7b906a4c83
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
transient-define-*: Allow overwriting interactive-only
---
lisp/transient.el | 25 +++++++++++++++++--------
1 file changed, 17 insertions(+), 8 deletions(-)
diff --git a/lisp/transient.el b/lisp/transient.el
index 586aeda239..5746f242c6 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -916,7 +916,7 @@ to the setup function:
[&optional ("interactive" interactive) def-body]))
(indent defun)
(doc-string 3))
- (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
+ (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only)
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name
@@ -925,7 +925,7 @@ to the setup function:
`(lambda ()
(interactive)
(transient-setup ',name))))
- (put ',name 'interactive-only t)
+ (put ',name 'interactive-only ,interactive-only)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--prefix
(,(or class 'transient-prefix) :command ',name ,@slots))
@@ -957,14 +957,14 @@ ARGLIST. The infix arguments are usually accessed by
using
def-body))
(indent defun)
(doc-string 3))
- (pcase-let ((`(,class ,slots ,_ ,docstr ,body)
+ (pcase-let ((`(,class ,slots ,_ ,docstr ,body ,interactive-only)
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name
,(if (and (not body) class (oref-default class definition))
`(oref-default ',class definition)
`(lambda ,arglist ,@body)))
- (put ',name 'interactive-only t)
+ (put ',name 'interactive-only ,interactive-only)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
(,(or class 'transient-suffix) :command ',name ,@slots)))))
@@ -1009,11 +1009,11 @@ keyword.
[&rest keywordp sexp]))
(indent defun)
(doc-string 3))
- (pcase-let ((`(,class ,slots ,_ ,docstr ,_)
+ (pcase-let ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only)
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name #'transient--default-infix-command)
- (put ',name 'interactive-only t)
+ (put ',name 'interactive-only ,interactive-only)
(put ',name 'completion-predicate #'transient--suffix-only)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
@@ -1068,7 +1068,7 @@ commands are aliases for."
(defun transient--expand-define-args (args &optional arglist)
(unless (listp arglist)
(error "Mandatory ARGLIST is missing"))
- (let (class keys suffixes docstr)
+ (let (class keys suffixes docstr declare (interactive-only t))
(when (stringp (car args))
(setq docstr (pop args)))
(while (keywordp (car args))
@@ -1082,13 +1082,22 @@ commands are aliases for."
(or (vectorp arg)
(and arg (symbolp arg))))
(push (pop args) suffixes))
+ (when (eq (car-safe (car args)) 'declare)
+ (setq declare (car args))
+ (setq args (cdr args))
+ (when-let ((int (assq 'interactive-only declare)))
+ (setq interactive-only (cadr int))
+ (delq int declare))
+ (unless (cdr declare)
+ (setq declare nil)))
(list (if (eq (car-safe class) 'quote)
(cadr class)
class)
(nreverse keys)
(nreverse suffixes)
docstr
- args))))
+ (if declare (cons declare args) args)
+ interactive-only))))
(defun transient--parse-child (prefix spec)
(cl-typecase spec
