From 457a3c53cf7211f1194ccb0741d414624f6d1253 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 18 Jun 2024 17:02:20 +0200 Subject: [PATCH] Update to Transient v0.7.0-1-g482bc777 (cherry picked from commit dceb28a1cfad276cdf070a9b2ca4d8f3ab3c1a85) --- doc/misc/transient.texi | 37 ++-- lisp/transient.el | 361 +++++++++++++++++++++++----------------- 2 files changed, 231 insertions(+), 167 deletions(-) diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 0aa520237f7..7e8ffcf91bf 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -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? diff --git a/lisp/transient.el b/lisp/transient.el index c9b6e457d00..34458bec688 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; 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 "" b)) (when-let ((b (keymap-lookup map "="))) (keymap-set map "" b)) (when-let ((b (keymap-lookup map "+"))) (keymap-set map "" 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)) "")) - (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 -- 2.39.2