branch: externals/transient
commit 226db67b3680acbeb74cb0403e1a302917054174
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
All suffix commands now must be accessed through fbound symbols
Even before, all suffix commands had to be associated with a symbol.
Every suffix command is associated with a suffix object, and that
symbol is what allows us to see that association. We often compare
`this-command' with some constant symbols.
For most commands that simply worked because they are ultimately
defined using `defun' or `defalias'. For infix commands, which are
defined inline in the definition of a prefix, we didn't do that,
because we don't want those commands to be offered as completion
candidates by `execute-extended-command'.
We no longer have to do that because, since Emacs 28.2, there is an
alternative mechanism to achieve the same. Previously infix commands
were not installed in the function slot of their symbol, but in its
`transient--infix-command' property. That complicated things a lot,
so we remove it completely, instead of preserving it for older Emacs
releases. If someone is bothered by infix commands being offered for
completion, then they have to update to a recent Emacs release and
customize `read-extended-command-predicate'.
This also fixes how `transient--wrap-command' advises commands.
Previously it used different approaches for commands accessed via a
fboundp symbol and "anonymous" infix commands, and the latter did not
actually work.
As a side-note, we have to advice commands via fboundp symbols.
Advising `this-command' instead, is not feasible, because we heavily
rely on comparing the value of this variable with known symbols.
---
lisp/transient.el | 165 +++++++++++++++++++++---------------------------------
1 file changed, 63 insertions(+), 102 deletions(-)
diff --git a/lisp/transient.el b/lisp/transient.el
index f8933eb1a8..271f780934 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -956,7 +956,7 @@ keyword.
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
(transient--expand-define-args args arglist)))
`(progn
- (defalias ',name ,(transient--default-infix-command))
+ (defalias ',name #'transient--default-infix-command)
(put ',name 'interactive-only t)
(put ',name 'command-modes (list 'not-a-mode))
(put ',name 'function-documentation ,docstr)
@@ -972,6 +972,15 @@ example, sets a variable, use `transient-define-infix'
instead.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
+(defun transient--default-infix-command ()
+ "Most transient infix commands are but an alias for this command."
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj)))
+ (transient--show))
+(put 'transient--default-infix-command 'interactive-only t)
+(put 'transient--default-infix-command 'command-modes (list 'not-a-mode))
+
(defun transient--expand-define-args (args &optional arglist)
(unless (listp arglist)
(error "Mandatory ARGLIST is missing"))
@@ -1074,11 +1083,16 @@ example, sets a variable, use `transient-define-infix'
instead.
(if (and desc (or (stringp desc) (symbolp desc)))
desc
(plist-get args :key)))))))
- (setq args (plist-put args :command
- `(defalias ',sym ,(macroexp-quote cmd))))))
+ (setq args (plist-put
+ args :command
+ `(prog1 ',sym
+ (put ',sym 'interactive-only t)
+ (put ',sym 'command-modes (list 'not-a-mode))
+ (defalias ',sym ,(macroexp-quote cmd)))))))
((or (stringp car)
(and car (listp car)))
- (let ((arg pop))
+ (let ((arg pop)
+ (sym nil))
(cl-typecase arg
(list
(setq args (plist-put args :shortarg (car arg)))
@@ -1088,9 +1102,13 @@ example, sets a variable, use `transient-define-infix'
instead.
(when-let ((shortarg (transient--derive-shortarg arg)))
(setq args (plist-put args :shortarg shortarg)))
(setq args (plist-put args :argument arg))))
- (setq args (plist-put args :command
- (list 'quote (intern (format "transient:%s:%s"
- prefix arg)))))
+ (setq sym (intern (format "transient:%s:%s" prefix arg)))
+ (setq args (plist-put
+ args :command
+ `(prog1 ',sym
+ (put ',sym 'interactive-only t)
+ (put ',sym 'command-modes (list 'not-a-mode))
+ (defalias ',sym #'transient--default-infix-command))))
(cond ((and car (not (keywordp car)))
(setq class 'transient-option)
(setq args (plist-put args :reader (macroexp-quote pop))))
@@ -1119,26 +1137,6 @@ example, sets a variable, use `transient-define-infix'
instead.
(macroexp-quote (or class 'transient-suffix))
(cons 'list args))))
-(defun transient--default-infix-command ()
- (cons 'lambda
- '(()
- (interactive)
- (let ((obj (transient-suffix-object)))
- (transient-infix-set obj (transient-infix-read obj)))
- (transient--show))))
-
-(defun transient--ensure-infix-command (obj)
- (let ((cmd (oref obj command)))
- (unless (or (commandp cmd)
- (get cmd 'transient--infix-command))
- (if (or (cl-typep obj 'transient-switch)
- (cl-typep obj 'transient-option))
- (put cmd 'transient--infix-command
- (transient--default-infix-command))
- ;; This is not an anonymous infix argument.
- (when (transient--use-suffix-p obj)
- (error "Suffix %s is not defined or autoloaded as a command"
cmd))))))
-
(defun transient--derive-shortarg (arg)
(save-match-data
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
@@ -1423,11 +1421,11 @@ Each suffix commands is associated with an object,
which holds
additional information about the suffix, such as its value (in
the case of an infix command, which is a kind of suffix command).
-This function is intended to be called by infix commands, whose
-command definition usually (at least when defined using
-`transient-define-infix') is this:
+This function is intended to be called by infix commands, which
+are usually aliases of `transient--default-infix-command', which
+is defined like this:
- (lambda ()
+ (defun transient--default-infix-command ()
(interactive)
(let ((obj (transient-suffix-object)))
(transient-infix-set obj (transient-infix-read obj)))
@@ -1460,7 +1458,7 @@ probably use this instead:
(let ((suffixes
(cl-remove-if-not
(lambda (obj)
- (eq (transient--suffix-command obj)
+ (eq (oref obj command)
(or command
(if (eq this-command 'transient-set-level)
;; This is how it can look up for which
@@ -1483,38 +1481,6 @@ probably use this instead:
(transient-init-value obj)
obj)))
-(defun transient--suffix-command (object)
- "Return the command represented by OBJECT.
-
-If the value of OBJECT's `command' slot is a command, then return
-that. Otherwise it is a symbol whose `transient--infix-command'
-property holds an anonymous command, which is returned instead."
- (cl-check-type object transient-suffix)
- (let ((sym (oref object command)))
- (if (commandp sym)
- sym
- (get sym 'transient--infix-command))))
-
-(defun transient--suffix-symbol (arg)
- "Return a symbol representing ARG.
-
-ARG must be a command and/or a symbol. If it is a symbol,
-then just return it. Otherwise return the symbol whose
-`transient--infix-command' property's value is ARG."
- (or (cl-typep arg 'command)
- (cl-typep arg 'symbol)
- (signal 'wrong-type-argument `((command symbol) ,arg)))
- (if (symbolp arg)
- arg
- (let* ((obj (transient-suffix-object))
- (sym (oref obj command)))
- (if (eq (get sym 'transient--infix-command) arg)
- sym
- (catch 'found
- (mapatoms (lambda (sym)
- (when (eq (get sym 'transient--infix-command) arg)
- (throw 'found sym)))))))))
-
;;; Keymaps
(defvar-keymap transient-base-map
@@ -1712,7 +1678,7 @@ of the corresponding object."
(funcall transient-substitute-key-function obj)))
(oset obj key key))
(let ((kbd (kbd key))
- (cmd (transient--suffix-command obj)))
+ (cmd (oref obj command)))
(when-let ((conflict (and transient-detect-key-conflicts
(transient--lookup-key map kbd))))
(unless (eq cmd conflict)
@@ -1740,13 +1706,12 @@ of the corresponding object."
(keymap-set map "<handle-switch-frame>" #'transient--do-suspend))
(dolist (obj transient--suffixes)
(let* ((cmd (oref obj command))
- (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t))
- (sym (transient--suffix-symbol cmd)))
+ (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t)))
(cond
((oref obj inapt)
- (define-key map (vector sym) #'transient--do-warn-inapt))
+ (define-key map (vector cmd) #'transient--do-warn-inapt))
((slot-boundp obj 'transient)
- (define-key map (vector sym)
+ (define-key map (vector cmd)
(let ((do (oref obj transient)))
(pcase (list do sub-prefix)
('(t t) #'transient--do-recurse)
@@ -1756,8 +1721,8 @@ of the corresponding object."
('(nil t) #'transient--do-replace)
('(nil nil) #'transient--do-exit)
(_ do)))))
- ((not (lookup-key transient-predicate-map (vector sym)))
- (define-key map (vector sym)
+ ((not (lookup-key transient-predicate-map (vector cmd)))
+ (define-key map (vector cmd)
(if sub-prefix
#'transient--do-replace
(or (oref transient--prefix transient-suffix)
@@ -1907,21 +1872,28 @@ value. Otherwise return CHILDREN as is."
(defun transient--init-suffix (levels spec)
(pcase-let* ((`(,level ,class ,args) spec)
(cmd (plist-get args :command))
- (level (or (alist-get (transient--suffix-symbol cmd) levels)
- level)))
+ (level (or (alist-get cmd levels) level)))
(let ((fn (and (symbolp cmd)
(symbol-function cmd))))
(when (autoloadp fn)
(transient--debug " autoload %s" cmd)
(autoload-do-load fn)))
(when (transient--use-level-p level)
- (let ((obj (if-let ((proto (and cmd
- (symbolp cmd)
- (get cmd 'transient--suffix))))
+ (unless (and cmd (symbolp cmd))
+ (error "BUG: Non-symbolic suffix command: %s" cmd))
+ (let ((obj (if-let ((proto (get cmd 'transient--suffix)))
(apply #'clone proto :level level args)
- (apply class :level level args))))
+ (apply class :command cmd :level level args))))
+ (cond ((commandp cmd))
+ ((or (cl-typep obj 'transient-switch)
+ (cl-typep obj 'transient-option))
+ ;; As a temporary special case, if the package was compiled
+ ;; with an older version of Transient, then we must define
+ ;; "anonymous" switch and option commands here.
+ (defalias cmd #'transient--default-infix-command))
+ ((transient--use-suffix-p obj)
+ (error "Suffix command %s is not defined or autoloaded" cmd)))
(transient--init-suffix-key obj)
- (transient--ensure-infix-command obj)
(when (transient--use-suffix-p obj)
(if (transient--inapt-suffix-p obj)
(oset obj inapt t)
@@ -2077,8 +2049,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--get-predicate-for (cmd &optional suffix-only)
(or (ignore-errors
- (lookup-key transient--predicate-map
- (vector (transient--suffix-symbol cmd))))
+ (lookup-key transient--predicate-map (vector cmd)))
(and (not suffix-only)
(let ((pred (oref transient--prefix transient-non-suffix)))
(pcase pred
@@ -2205,9 +2176,7 @@ value. Otherwise return CHILDREN as is."
(when-let ((unwind (oref prefix unwind-suffix)))
(transient--debug 'unwind-interactive)
(funcall unwind suffix))
- (if (symbolp suffix)
- (advice-remove suffix advice)
- (remove-function suffix advice))
+ (advice-remove suffix advice)
(oset prefix unwind-suffix nil))))))
(advice-body
(lambda (fn &rest args)
@@ -2216,16 +2185,12 @@ value. Otherwise return CHILDREN as is."
(when-let ((unwind (oref prefix unwind-suffix)))
(transient--debug 'unwind-command)
(funcall unwind suffix))
- (if (symbolp suffix)
- (advice-remove suffix advice)
- (remove-function suffix advice))
+ (advice-remove suffix advice)
(oset prefix unwind-suffix nil)))))
(setq advice `(lambda (fn &rest args)
(interactive ,advice-interactive)
(apply ',advice-body fn args)))
- (if (symbolp suffix)
- (advice-add suffix :around advice '((depth . -99)))
- (add-function :around (var suffix) advice '((depth . -99))))))
+ (advice-add suffix :around advice '((depth . -99)))))
(defun transient--premature-post-command ()
(and (equal (this-command-keys-vector) [])
@@ -2346,7 +2311,7 @@ value. Otherwise return CHILDREN as is."
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
- (or (ignore-errors (transient--suffix-symbol this-command))
+ (or (and (symbolp this-command) this-command)
(if (byte-code-function-p this-command)
"#[...]"
this-command))
@@ -2529,12 +2494,9 @@ prefix argument and pivot to `transient-update'."
(propertize "?" 'face 'transient-key)
;; `this-command' is `transient-undefined' or `transient-inapt'.
;; Show the command (`this-original-command') the user actually
- ;; tried to invoke. For an anonymous inapt command that is a
- ;; lambda expression, which cannot be mapped to a symbol, so
- ;; forgo displaying the command.
- (if-let ((cmd (ignore-errors
- (symbol-name (transient--suffix-symbol
- this-original-command)))))
+ ;; tried to invoke.
+ (if-let ((cmd (or (ignore-errors (symbol-name
this-original-command))
+ (ignore-errors (symbol-name this-command)))))
(format " [%s]" (propertize cmd 'face 'font-lock-warning-face))
""))
(unless (and transient--transient-map
@@ -2624,8 +2586,7 @@ transient is active."
(transient-suffix-object command)))
(transient--show)
(transient--read-number-N
- (format "Set level for `%s': "
- (transient--suffix-symbol command))
+ (format "Set level for `%s': " command)
nil nil (not (eq command prefix)))))))))))
(cond
((not command)
@@ -2634,7 +2595,7 @@ transient is active."
(level
(let* ((prefix (oref transient--prefix command))
(alist (alist-get prefix transient-levels))
- (sym (transient--suffix-symbol command)))
+ (sym command))
(if (eq command prefix)
(progn (oset transient--prefix level level)
(setq sym t))
@@ -3466,7 +3427,7 @@ Optional support for popup buttons is also implemented
here."
(if transient-enable-popup-navigation
(make-text-button str nil
'type 'transient
- 'command (transient--suffix-command obj))
+ 'command (oref obj command))
str)))
(cl-defmethod transient-format ((obj transient-infix))
@@ -3666,7 +3627,7 @@ that, else its name.
Intended to be temporarily used as the `:suffix-description' of
a prefix command, while porting a regular keymap to a transient."
- (let ((command (transient--suffix-symbol (oref obj command))))
+ (let ((command (oref obj command)))
(if-let ((doc (documentation command)))
(propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face)
(propertize (symbol-name command) 'face 'font-lock-function-name-face))))
@@ -3694,7 +3655,7 @@ prefix method."
(cond
((eq this-command 'transient-help)
(transient-show-help transient--prefix))
- ((let ((prefix (get (transient--suffix-command obj)
+ ((let ((prefix (get (oref obj command)
'transient--prefix)))
(and prefix (not (eq (oref transient--prefix command) this-command))
(prog1 t (transient-show-help prefix)))))
