procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update to Transient v0.7.0-1-g482bc777

Browse source
This commit is contained in:
Jonas Bernoulli 2024-06-18 17:02:20 +02:00
parent dc308348a9
commit dceb28a1cf
No known key found for this signature in database
GPG key ID: 230C2EFBB326D927
2 changed files with 231 additions and 167 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
doc/misc/transient.texi
View file

@ -31,7 +31,7 @@ General Public License for more details.
@finalout
@titlepage
@title Transient User and Developer Manual
@subtitle for version 0.6.0
@subtitle for version 0.7.0
@author Jonas Bernoulli
@page
@vskip 0pt plus 1filll
@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial,
available at @uref{https://github.com/positron-solutions/transient-showcase}.
@noindent
This manual is for Transient version 0.6.0.
This manual is for Transient version 0.7.0.
@insertcopying
@end ifnottex
@ -1112,7 +1112,8 @@ Transients}) and adds the transient's infix and suffix bindings, as
described below.
Users and third-party packages can add additional bindings using
functions such as @code{transient-insert-suffix} (@pxref{Modifying Existing Transients}). These functions take a ``suffix specification'' as one of
functions such as @code{transient-insert-suffix} (@pxref{Modifying Existing Transients}).
These functions take a ``suffix specification'' as one of
their arguments, which has the same form as the specifications used in
@code{transient-define-prefix}.
@ -1380,16 +1381,12 @@ This macro defines @var{NAME} as a transient infix command.
reserved for future use. @var{DOCSTRING} is the documentation string and
is optional.
The keyword-value pairs are mandatory. All transient infix commands
are @code{equal} to each other (but not @code{eq}), so it is meaningless to define
an infix command without also setting at least @code{:class} and one other
keyword (which it is depends on the used class, usually @code{:argument} or
@code{:variable}).
Each keyword has to be a keyword symbol, either @code{:class} or a keyword
argument supported by the constructor of that class. The
@code{transient-switch} class is used if the class is not specified
explicitly.
At least one key-value pair is required. All transient infix
commands are @code{equal} to each other (but not @code{eq}). It is meaningless
to define an infix command, without providing at least one keyword
argument (usually @code{:argument} or @code{:variable}, depending on the class).
The suffix class defaults to @code{transient-switch} and can be set using
the @code{:class} keyword.
The function definition is always:
@ -2372,6 +2369,20 @@ the transient popup, you will be able to yank it in another buffer.
#'transient--do-stay)
@end lisp
@anchor{How can I autoload prefix and suffix commands?}
@appendixsec How can I autoload prefix and suffix commands?
If your package only supports Emacs 30, just prefix the definition
with @code{;;;###autoload}. If your package supports released versions of
Emacs, you unfortunately have to use a long form autoload comment
as described in @ref{Autoload,,,elisp,}.
@lisp
;;;###autoload (autoload 'magit-dispatch "magit" nil t)
(transient-define-prefix magit-dispatch ()
...)
@end lisp
@anchor{How does Transient compare to prefix keys and universal arguments?}
@appendixsec How does Transient compare to prefix keys and universal arguments?

361
lisp/transient.el
View file

@ -5,7 +5,7 @@
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; URL: https://github.com/magit/transient
;; Keywords: extensions
;; Version: 0.6.0
;; Version: 0.7.0
;; SPDX-License-Identifier: GPL-3.0-or-later
@ -38,7 +38,7 @@
(require 'format-spec)
(eval-and-compile
(when (and (featurep' seq)
(when (and (featurep 'seq)
(not (fboundp 'seq-keep)))
(unload-feature 'seq 'force)))
(require 'seq)
@ -721,24 +721,12 @@ the prototype is stored in the clone's `prototype' slot.")
(if-not-derived
:initarg :if-not-derived
:initform nil
:documentation "Enable if major-mode does not derive from value."))
"Abstract superclass for group and suffix classes.
It is undefined what happens if more than one `if*' predicate
slot is non-nil."
:abstract t)
(defclass transient-suffix (transient-child)
((definition :allocation :class :initform nil)
(key :initarg :key)
(command :initarg :command)
(transient :initarg :transient)
(format :initarg :format :initform " %k %d")
(description :initarg :description :initform nil)
(face :initarg :face :initform nil)
(show-help :initarg :show-help :initform nil)
(inapt-face :initarg :inapt-face :initform 'transient-inapt-suffix)
(inapt :initform nil)
:documentation "Enable if major-mode does not derive from value.")
(inapt
:initform nil)
(inapt-face
:initarg :inapt-face
:initform 'transient-inapt-suffix)
(inapt-if
:initarg :inapt-if
:initform nil
@ -771,13 +759,33 @@ slot is non-nil."
:initarg :inapt-if-not-derived
:initform nil
:documentation "Inapt if major-mode does not derive from value."))
"Abstract superclass for group and suffix classes.
It is undefined what happens if more than one `if*' predicate
slot is non-nil."
:abstract t)
(defclass transient-suffix (transient-child)
((definition :allocation :class :initform nil)
(key :initarg :key)
(command :initarg :command)
(transient :initarg :transient)
(format :initarg :format :initform " %k %d")
(description :initarg :description :initform nil)
(face :initarg :face :initform nil)
(show-help :initarg :show-help :initform nil))
"Superclass for suffix command.")
(defclass transient-information (transient-suffix)
((format :initform " %k %d")
(key :initform " "))
"Display-only information.
A suffix object with no associated command.")
"Display-only information, aligned with suffix keys.
Technically a suffix object with no associated command.")
(defclass transient-information* (transient-information)
((format :initform " %d"))
"Display-only information, aligned with suffix descriptions.
Technically a suffix object with no associated command.")
(defclass transient-infix (transient-suffix)
((transient :initform t)
@ -834,6 +842,7 @@ They become the value of this argument.")
(hide :initarg :hide :initform nil)
(description :initarg :description :initform nil)
(pad-keys :initarg :pad-keys :initform nil)
(info-format :initarg :info-format :initform nil)
(setup-children :initarg :setup-children))
"Abstract superclass of all group classes."
:abstract t)
@ -907,8 +916,9 @@ to the setup function:
[&optional ("interactive" interactive) def-body]))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
(transient--expand-define-args args arglist)))
(pcase-let
((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only)
(transient--expand-define-args args arglist 'transient-define-prefix)))
`(progn
(defalias ',name
,(if body
@ -916,7 +926,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))
@ -940,42 +950,50 @@ The BODY must begin with an `interactive' form that matches
ARGLIST. The infix arguments are usually accessed by using
`transient-args' inside `interactive'.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])"
(declare (debug ( &define name lambda-list
[&optional lambda-doc]
[&rest keywordp sexp]
("interactive" interactive)
def-body))
[&optional ("interactive" interactive) def-body]))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
(transient--expand-define-args args arglist)))
(pcase-let
((`(,class ,slots ,_ ,docstr ,body ,interactive-only)
(transient--expand-define-args args arglist 'transient-define-suffix)))
`(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)))))
(defmacro transient-augment-suffix (name &rest args)
"Augment existing command NAME with a new transient suffix object.
Similar to `transient-define-suffix' but define a suffix object only.
\n\(fn NAME [KEYWORD VALUE]...)"
(declare (debug (&define name [&rest keywordp sexp]))
(indent defun))
(pcase-let
((`(,class ,slots)
(transient--expand-define-args args nil 'transient-augment-suffix t)))
`(put ',name 'transient--suffix
(,(or class 'transient-suffix) :command ',name ,@slots))))
(defmacro transient-define-infix (name arglist &rest args)
"Define NAME as a transient infix command.
ARGLIST is always ignored and reserved for future use.
DOCSTRING is the documentation string and is optional.
The key-value pairs are mandatory. All transient infix commands
are equal to each other (but not eq), so it is meaningless to
define an infix command without also setting at least `:class'
and one other keyword (which it is depends on the used class,
usually `:argument' or `:variable').
Each key has to be a keyword symbol, either `:class' or a keyword
argument supported by the constructor of that class. The
`transient-switch' class is used if the class is not specified
explicitly.
At least one key-value pair is required. All transient infix
commands are equal to each other (but not eq). It is meaning-
less to define an infix command, without providing at least one
keyword argument (usually `:argument' or `:variable', depending
on the class). The suffix class defaults to `transient-switch'
and can be set using the `:class' keyword.
The function definitions is always:
@ -994,17 +1012,19 @@ that case you have to use `transient-define-suffix' to define
the infix command and use t as the value of the `:transient'
keyword.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
\(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)"
(declare (debug ( &define name lambda-list
[&optional lambda-doc]
keywordp sexp
[&rest keywordp sexp]))
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
(transient--expand-define-args args arglist)))
(pcase-let
((`(,class ,slots ,_ ,docstr ,_ ,interactive-only)
(transient--expand-define-args args arglist 'transient-define-infix t)))
`(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
@ -1044,7 +1064,8 @@ falling back to that of the same aliased command."
(put 'transient--default-infix-command 'completion-predicate
#'transient--suffix-only)
(defun transient--find-function-advised-original (fn func)
(define-advice find-function-advised-original
(:around (fn func) transient-default-infix)
"Return nil instead of `transient--default-infix-command'.
When using `find-function' to jump to the definition of a transient
infix command/argument, then we want to actually jump to that, not to
@ -1052,14 +1073,12 @@ the definition of `transient--default-infix-command', which all infix
commands are aliases for."
(let ((val (funcall fn func)))
(and val (not (eq val 'transient--default-infix-command)) val)))
(advice-add 'find-function-advised-original :around
#'transient--find-function-advised-original)
(eval-and-compile
(defun transient--expand-define-args (args &optional arglist)
(eval-and-compile ;transient--expand-define-args
(defun transient--expand-define-args (args arglist form &optional nobody)
(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))
@ -1073,13 +1092,28 @@ 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)))
(cond
((not args))
(nobody
(error "%s: No function body allowed" form))
((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive))
(error "%s: Interactive form missing" form)))
(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
@ -1150,9 +1184,9 @@ commands are aliases for."
(commandp (cadr spec)))
(setq args (plist-put args :description (macroexp-quote pop)))))
(cond
((eq car :info))
((memq car '(:info :info*)))
((keywordp car)
(error "Need command or `:info', got `%s'" car))
(error "Need command, `:info' or `:info*', got `%s'" car))
((symbolp car)
(setq args (plist-put args :command (macroexp-quote pop))))
((and (commandp car)
@ -1212,6 +1246,9 @@ commands are aliases for."
((eq key :info)
(setq class 'transient-information)
(setq args (plist-put args :description val)))
((eq key :info*)
(setq class 'transient-information*)
(setq args (plist-put args :description val)))
((eq (car-safe val) '\,)
(setq args (plist-put args key (cadr val))))
((or (symbolp val)
@ -1479,6 +1516,10 @@ variable instead.")
(defvar transient-exit-hook nil
"Hook run after exiting a transient.")
(defvar transient-setup-buffer-hook nil
"Hook run when setting up the transient buffer.
That buffer is current and empty when this hook runs.")
(defvar transient--prefix nil)
(defvar transient--layout nil)
(defvar transient--suffixes nil)
@ -1506,6 +1547,9 @@ variable instead.")
(defvar transient--buffer-name " *transient*"
"Name of the transient buffer.")
(defvar transient--buffer nil
"The transient menu buffer.")
(defvar transient--window nil
"The window used to display the transient popup buffer.")
@ -1859,15 +1903,20 @@ of the corresponding object."
(setq key (save-match-data
(funcall transient-substitute-key-function obj)))
(oset obj key key))
(let ((kbd (kbd key))
(cmd (oref obj command)))
(when-let ((conflict (and transient-detect-key-conflicts
(transient--lookup-key map kbd))))
(unless (eq cmd conflict)
(error "Cannot bind %S to %s and also %s"
(string-trim key)
cmd conflict)))
(define-key map kbd cmd))))
(let* ((kbd (kbd key))
(cmd (oref obj command))
(alt (transient--lookup-key map kbd)))
(cond ((not alt)
(define-key map kbd cmd))
((eq alt cmd))
((transient--inapt-suffix-p obj))
((and-let* ((obj (transient-suffix-object alt)))
(transient--inapt-suffix-p obj))
(define-key map kbd cmd))
(transient-detect-key-conflicts
(error "Cannot bind %S to %s and also %s"
(string-trim key) cmd alt))
((define-key map kbd cmd))))))
(when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b))
(when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b))
(when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b))
@ -2039,7 +2088,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--init-suffixes (name)
(let ((levels (alist-get name transient-levels)))
(cl-mapcan (lambda (c) (transient--init-child levels c))
(cl-mapcan (lambda (c) (transient--init-child levels c nil))
(append (get name 'transient--layout)
(and (not transient--editp)
(get 'transient-common-commands
@ -2057,24 +2106,29 @@ value. Otherwise return CHILDREN as is."
(list def)))))
(cl-mapcan #'s layout)))
(defun transient--init-child (levels spec)
(defun transient--init-child (levels spec parent)
(cl-etypecase spec
(vector (transient--init-group levels spec))
(list (transient--init-suffix levels spec))
(vector (transient--init-group levels spec parent))
(list (transient--init-suffix levels spec parent))
(string (list spec))))
(defun transient--init-group (levels spec)
(defun transient--init-group (levels spec parent)
(pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
(and-let* ((- (transient--use-level-p level))
(and-let* (((transient--use-level-p level))
(obj (apply class :level level args))
(- (transient--use-suffix-p obj))
(suffixes (cl-mapcan (lambda (c) (transient--init-child levels c))
(transient-setup-children obj children))))
((transient--use-suffix-p obj))
((prog1 t
(when (or (and parent (oref parent inapt))
(transient--inapt-suffix-p obj))
(oset obj inapt t))))
(suffixes (cl-mapcan
(lambda (c) (transient--init-child levels c obj))
(transient-setup-children obj children))))
(progn ; work around debbugs#31840
(oset obj suffixes suffixes)
(list obj)))))
(defun transient--init-suffix (levels spec)
(defun transient--init-suffix (levels spec parent)
(pcase-let* ((`(,level ,class ,args) spec)
(cmd (plist-get args :command))
(key (transient--kbd (plist-get args :key)))
@ -2107,7 +2161,8 @@ value. Otherwise return CHILDREN as is."
(unless (cl-typep obj 'transient-information)
(transient--init-suffix-key obj))
(when (transient--use-suffix-p obj)
(if (transient--inapt-suffix-p obj)
(if (or (and parent (oref parent inapt))
(transient--inapt-suffix-p obj))
(oset obj inapt t)
(transient-init-scope obj)
(transient-init-value obj))
@ -2296,8 +2351,9 @@ value. Otherwise return CHILDREN as is."
'other)
(with-demoted-errors "Error while exiting transient: %S"
(delete-window transient--window)))
(when-let ((buffer (get-buffer transient--buffer-name)))
(kill-buffer buffer))
(when (buffer-live-p transient--buffer)
(kill-buffer transient--buffer))
(setq transient--buffer nil)
(when remain-in-minibuffer-window
(select-window remain-in-minibuffer-window)))))
@ -2468,7 +2524,7 @@ value. Otherwise return CHILDREN as is."
;; We cannot use `current-prefix-arg' because it is set
;; too late (in `command-execute'), and if it were set
;; earlier, then we likely still would not be able to
;; rely on it and `prefix-command-preserve-state-hook'
;; rely on it, and `prefix-command-preserve-state-hook'
;; would have to be used to record that a universal
;; argument is in effect.
(not prefix-arg)))
@ -2546,8 +2602,7 @@ value. Otherwise return CHILDREN as is."
mouse-set-region))
(equal (key-description (this-command-keys-vector))
"<mouse-movement>"))
(and (eq (current-buffer)
(get-buffer transient--buffer-name)))))
(and (eq (current-buffer) transient--buffer))))
(transient--show))
(when (and (numberp transient-show-popup)
(not (zerop transient-show-popup))
@ -2575,11 +2630,12 @@ value. Otherwise return CHILDREN as is."
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
(if (fboundp 'help-fns-function-name)
(help-fns-function-name this-command)
(if (byte-code-function-p this-command)
"#[...]"
this-command))
(cond ((and (symbolp this-command) this-command))
((fboundp 'help-fns-function-name)
(help-fns-function-name this-command))
((byte-code-function-p this-command)
"#[...]")
(this-command))
(key-description (this-command-keys-vector))
transient--exitp
(cond ((keywordp (car args))
@ -3357,7 +3413,7 @@ prompt."
(cl-defmethod transient-infix-set :after ((obj transient-argument) value)
"Unset incompatible infix arguments."
(when-let* ((--- value)
(when-let* ((value)
(val (transient-infix-value obj))
(arg (if (slot-boundp obj 'argument)
(oref obj argument)
@ -3371,15 +3427,15 @@ prompt."
(and (not (equal val arg))
(cl-mapcan (apply-partially filter val) spec)))))
(dolist (obj transient--suffixes)
(when-let* ((--- (cl-typep obj 'transient-argument))
(when-let* (((cl-typep obj 'transient-argument))
(val (transient-infix-value obj))
(arg (if (slot-boundp obj 'argument)
(oref obj argument)
(oref obj argument-format)))
(--- (if (equal val arg)
(member arg incomp)
(or (member val incomp)
(member arg incomp)))))
((if (equal val arg)
(member arg incomp)
(or (member val incomp)
(member arg incomp)))))
(transient-infix-set obj nil)))))
(cl-defgeneric transient-set-value (obj)
@ -3515,6 +3571,10 @@ the option does not appear in ARGS."
(or (match-string 1 match) "")))
(and (member arg args) t)))
(defun transient-scope ()
"Return the value of the `scope' slot of the current prefix."
(oref (transient-prefix-object) scope))
;;; History
(cl-defgeneric transient--history-key (obj)
@ -3580,15 +3640,18 @@ have a history of their own.")
(transient--timer-cancel)
(setq transient--showp t)
(let ((transient--shadowed-buffer (current-buffer))
(buf (get-buffer-create transient--buffer-name))
(focus nil))
(with-current-buffer buf
(setq transient--buffer (get-buffer-create transient--buffer-name))
(with-current-buffer transient--buffer
(when transient-enable-popup-navigation
(setq focus (or (button-get (point) 'command)
(and (not (bobp))
(button-get (1- (point)) 'command))
(transient--heading-at-point))))
(erase-buffer)
(run-hooks 'transient-setup-buffer-hook)
(when transient-force-fixed-pitch
(transient--force-fixed-pitch))
(setq window-size-fixed t)
(when (bound-and-true-p tab-line-format)
(setq tab-line-format nil))
@ -3609,12 +3672,11 @@ have a history of their own.")
(when (or transient--helpp transient--editp)
(transient--insert-help))
(when-let ((line (transient--separator-line)))
(insert line))
(when transient-force-fixed-pitch
(transient--force-fixed-pitch)))
(insert line)))
(unless (window-live-p transient--window)
(setq transient--window
(display-buffer buf transient-display-buffer-action)))
(display-buffer transient--buffer
transient-display-buffer-action)))
(when (window-live-p transient--window)
(with-selected-window transient--window
(goto-char (point-min))
@ -3657,9 +3719,8 @@ have a history of their own.")
(transient-with-shadowed-buffer
(funcall hide))))
(list group))))
transient--layout))
group)
(while (setq group (pop groups))
transient--layout)))
(while-let ((group (pop groups)))
(transient--insert-group group)
(when groups
(insert ?\n)))))
@ -3702,9 +3763,9 @@ have a history of their own.")
(transient-with-shadowed-buffer
(let* ((transient--pending-group column)
(rows (mapcar #'transient-format (oref column suffixes))))
(when-let ((desc (transient-format-description column)))
(push desc rows))
(flatten-tree rows))))
(if-let ((desc (transient-format-description column)))
(cons desc rows)
rows))))
(oref group suffixes)))
(vp (or (oref transient--prefix variable-pitch)
transient-align-variable-pitch))
@ -3721,7 +3782,7 @@ have a history of their own.")
col))))
columns))
(cc (transient--seq-reductions-from
(apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1)))
(apply-partially #'+ (* 2 (if vp (transient--pixel-width " ") 1)))
cw 0)))
(if transient-force-single-column
(dotimes (c cs)
@ -3750,14 +3811,12 @@ have a history of their own.")
(insert ?\n))))))))
(cl-defmethod transient--insert-group ((group transient-subgroups))
(let* ((subgroups (oref group suffixes))
(n (length subgroups)))
(dotimes (s n)
(let ((subgroup (nth s subgroups)))
(transient--maybe-pad-keys subgroup group)
(transient--insert-group subgroup)
(when (< s (1- n))
(insert ?\n))))))
(let ((subgroups (oref group suffixes)))
(while-let ((subgroup (pop subgroups)))
(transient--maybe-pad-keys subgroup group)
(transient--insert-group subgroup)
(when subgroups
(insert ?\n)))))
(cl-defgeneric transient-format (obj)
"Format and return OBJ for display.
@ -3889,28 +3948,22 @@ as a button."
(cl-defgeneric transient-format-description (obj)
"Format OBJ's `description' for display and return the result.")
(cl-defmethod transient-format-description ((obj transient-child))
(cl-defmethod transient-format-description ((obj transient-suffix))
"The `description' slot may be a function, in which case that is
called inside the correct buffer (see `transient--insert-group')
and its value is returned to the caller."
(and-let* ((desc (oref obj description))
(desc (if (functionp desc)
(if (= (car (func-arity desc)) 1)
(funcall desc obj)
(funcall desc))
desc)))
(if-let* ((face (transient--get-face obj 'face)))
(transient--add-face desc face t)
desc)))
(transient--get-description obj))
(cl-defmethod transient-format-description ((obj transient-group))
"Format the description by calling the next method. If the result
doesn't use the `face' property at all, then apply the face
`transient-heading' to the complete string."
(and-let* ((desc (cl-call-next-method obj)))
(if (text-property-not-all 0 (length desc) 'face nil desc)
desc
(propertize desc 'face 'transient-heading))))
(and-let* ((desc (transient--get-description obj)))
(cond ((oref obj inapt)
(propertize desc 'face 'transient-inapt-suffix))
((text-property-not-all 0 (length desc) 'face nil desc)
desc)
((propertize desc 'face 'transient-heading)))))
(cl-defmethod transient-format-description :around ((obj transient-suffix))
"Format the description by calling the next method. If the result
@ -3920,8 +3973,11 @@ If the OBJ's `key' is currently unreachable, then apply the face
(let ((desc (or (cl-call-next-method obj)
(and (slot-boundp transient--prefix 'suffix-description)
(funcall (oref transient--prefix suffix-description)
obj))
(propertize "(BUG: no description)" 'face 'error))))
obj)))))
(if desc
(when-let ((face (transient--get-face obj 'face)))
(setq desc (transient--add-face desc face t)))
(setq desc (propertize "(BUG: no description)" 'face 'error)))
(when (if transient--all-levels-p
(> (oref obj level) transient--default-prefix-level)
(and transient-highlight-higher-levels
@ -3983,23 +4039,30 @@ If the OBJ's `key' is currently unreachable, then apply the face
choices
(propertize "|" 'face 'transient-delimiter))))))
(defun transient--add-face (string face &optional append beg end)
(let ((str (copy-sequence string)))
(add-face-text-property (or beg 0) (or end (length str)) face append str)
str))
(cl-defmethod transient--get-description ((obj transient-child))
(and-let* ((desc (oref obj description)))
(if (functionp desc)
(if (= (car (transient--func-arity desc)) 1)
(funcall desc obj)
(funcall desc))
desc)))
(defun transient--get-face (obj slot)
(and-let* ((! (slot-exists-p obj slot))
(! (slot-boundp obj slot))
(cl-defmethod transient--get-face ((obj transient-suffix) slot)
(and-let* (((slot-boundp obj slot))
(face (slot-value obj slot)))
(if (and (not (facep face))
(functionp face))
(let ((transient--pending-suffix obj))
(if (= (car (func-arity face)) 1)
(if (= (car (transient--func-arity face)) 1)
(funcall face obj)
(funcall face)))
face)))
(defun transient--add-face (string face &optional append beg end)
(let ((str (copy-sequence string)))
(add-face-text-property (or beg 0) (or end (length str)) face append str)
str))
(defun transient--key-face (&optional cmd enforce-type)
(or (and transient-semantic-coloring
(not transient--helpp)
@ -4025,12 +4088,13 @@ If the OBJ's `key' is currently unreachable, then apply the face
(when-let ((pad (or (oref group pad-keys)
(and parent (oref parent pad-keys)))))
(oset group pad-keys
(apply #'max (cons (if (integerp pad) pad 0)
(seq-keep (lambda (suffix)
(and (eieio-object-p suffix)
(slot-boundp suffix 'key)
(length (oref suffix key))))
(oref group suffixes)))))))
(apply #'max
(if (integerp pad) pad 0)
(seq-keep (lambda (suffix)
(and (eieio-object-p suffix)
(slot-boundp suffix 'key)
(length (oref suffix key))))
(oref group suffixes))))))
(defun transient--pixel-width (string)
(save-window-excursion
@ -4386,7 +4450,8 @@ we stop there."
(face-remap-reset-base 'default)
(face-remap-add-relative 'default 'fixed-pitch))
;;;; Missing from Emacs
(defun transient--func-arity (fn)
(func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn))))
(defun transient--seq-reductions-from (function sequence initial-value)
(let ((acc (list initial-value)))
@ -4394,18 +4459,6 @@ we stop there."
(push (funcall function (car acc) elt) acc))
(nreverse acc)))
(defun transient-plist-to-alist (plist)
(let (alist)
(while plist
(push (cons (let* ((symbol (pop plist))
(name (symbol-name symbol)))
(if (eq (aref name 0) ?:)
(intern (substring name 1))
symbol))
(pop plist))
alist))
(nreverse alist)))
;;; Font-Lock
(defconst transient-font-lock-keywords