config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

transient.el (184770B)


      1 ;;; transient.el --- Transient commands  -*- lexical-binding:t -*-
      2 
      3 ;; Copyright (C) 2018-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Jonas Bernoulli <emacs.transient@jonas.bernoulli.dev>
      6 ;; Homepage: https://github.com/magit/transient
      7 ;; Keywords: extensions
      8 
      9 ;; Package-Version: 20240929.1847
     10 ;; Package-Revision: 5fcd71387300
     11 ;; Package-Requires: ((emacs "26.1") (compat "30.0.0.0") (seq "2.24"))
     12 
     13 ;; SPDX-License-Identifier: GPL-3.0-or-later
     14 
     15 ;; This file is part of GNU Emacs.
     16 
     17 ;; GNU Emacs is free software: you can redistribute it and/or modify
     18 ;; it under the terms of the GNU General Public License as published
     19 ;; by the Free Software Foundation, either version 3 of the License,
     20 ;; or (at your option) any later version.
     21 ;;
     22 ;; GNU Emacs is distributed in the hope that it will be useful,
     23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     25 ;; GNU General Public License for more details.
     26 ;;
     27 ;; You should have received a copy of the GNU General Public License
     28 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     29 
     30 ;;; Commentary:
     31 
     32 ;; Transient is the library used to implement the keyboard-driven menus
     33 ;; in Magit.  It is distributed as a separate package, so that it can be
     34 ;; used to implement similar menus in other packages.
     35 
     36 ;;; Code:
     37 
     38 (require 'cl-lib)
     39 (require 'compat)
     40 (require 'eieio)
     41 (require 'edmacro)
     42 (require 'format-spec)
     43 
     44 (eval-and-compile
     45   (when (and (featurep 'seq)
     46              (not (fboundp 'seq-keep)))
     47     (unload-feature 'seq 'force)))
     48 (require 'seq)
     49 (unless (fboundp 'seq-keep)
     50   (display-warning 'transient (substitute-command-keys "\
     51 Transient requires `seq' >= 2.24,
     52 but due to bad defaults, Emacs's package manager, refuses to
     53 upgrade this and other built-in packages to higher releases
     54 from GNU Elpa, when a package specifies that this is needed.
     55 
     56 To fix this, you have to add this to your init file:
     57 
     58   (setq package-install-upgrade-built-in t)
     59 
     60 Then evaluate that expression by placing the cursor after it
     61 and typing \\[eval-last-sexp].
     62 
     63 Once you have done that, you have to explicitly upgrade `seq':
     64 
     65   \\[package-upgrade] seq \\`RET'
     66 
     67 Then you also must make sure the updated version is loaded,
     68 by evaluating this form:
     69 
     70   (progn (unload-feature 'seq t) (require 'seq))
     71 
     72 Until you do this, you will get random errors about `seq-keep'
     73 being undefined while using Transient.
     74 
     75 If you don't use the `package' package manager but still get
     76 this warning, then your chosen package manager likely has a
     77 similar defect.") :emergency))
     78 
     79 (eval-when-compile (require 'subr-x))
     80 
     81 (declare-function info "info" (&optional file-or-node buffer))
     82 (declare-function Man-find-section "man" (section))
     83 (declare-function Man-next-section "man" (n))
     84 (declare-function Man-getpage-in-background "man" (topic))
     85 
     86 (defvar Man-notify-method)
     87 (defvar pp-default-function) ; since Emacs 29.1
     88 
     89 (defmacro transient--with-emergency-exit (id &rest body)
     90   (declare (indent defun))
     91   (unless (keywordp id)
     92     (setq body (cons id body))
     93     (setq id nil))
     94   `(condition-case err
     95        (let ((debugger #'transient--exit-and-debug))
     96          ,(macroexp-progn body))
     97      ((debug error)
     98       (transient--emergency-exit ,id)
     99       (signal (car err) (cdr err)))))
    100 
    101 (defun transient--exit-and-debug (&rest args)
    102   (transient--emergency-exit :debugger)
    103   (apply #'debug args))
    104 
    105 ;;; Options
    106 
    107 (defgroup transient nil
    108   "Transient commands."
    109   :group 'extensions)
    110 
    111 (defcustom transient-show-popup t
    112   "Whether to show the current transient in a popup buffer.
    113 \\<transient-map>
    114 - If t, then show the popup as soon as a transient prefix command
    115   is invoked.
    116 
    117 - If nil, then do not show the popup unless the user explicitly
    118   requests it, by pressing \\[transient-show] or a prefix key.
    119 
    120 - If a number, then delay displaying the popup and instead show
    121   a brief one-line summary.  If zero or negative, then suppress
    122   even showing that summary and display the pressed key only.
    123 
    124   Show the popup when the user explicitly requests it by pressing
    125   \\[transient-show] or a prefix key.  Unless zero, then also show the popup
    126   after that many seconds of inactivity (using the absolute value)."
    127   :package-version '(transient . "0.1.0")
    128   :group 'transient
    129   :type '(choice (const  :tag "instantly" t)
    130                  (const  :tag "on demand" nil)
    131                  (const  :tag "on demand (no summary)" 0)
    132                  (number :tag "after delay" 1)))
    133 
    134 (defcustom transient-enable-popup-navigation t
    135   "Whether navigation commands are enabled in the transient popup.
    136 
    137 While a transient is active the transient popup buffer is not the
    138 current buffer, making it necessary to use dedicated commands to
    139 act on that buffer itself.  If this is non-nil, then the following
    140 bindings are available:
    141 
    142 \\<transient-popup-navigation-map>\
    143 - \\[transient-backward-button] moves the cursor to the previous suffix.
    144 - \\[transient-forward-button] moves the cursor to the next suffix.
    145 - \\[transient-push-button] invokes the suffix the cursor is on.
    146 \\<transient-button-map>\
    147 - \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix.
    148 \\<transient-popup-navigation-map>\
    149 - \\[transient-isearch-backward]\
    150  and \\[transient-isearch-forward] start isearch in the popup buffer.
    151 
    152 \\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'.
    153 All other bindings are in `transient-popup-navigation-map'.
    154 
    155 By default \\`M-RET' is bound to `transient-push-button', instead of
    156 \\`RET', because if a transient allows the invocation of non-suffixes
    157 then it is likely that you would want \\`RET' to do what it would do
    158 if no transient were active."
    159   :package-version '(transient . "0.4.0")
    160   :group 'transient
    161   :type 'boolean)
    162 
    163 (defcustom transient-display-buffer-action
    164   '(display-buffer-in-side-window
    165     (side . bottom)
    166     (dedicated . t)
    167     (inhibit-same-window . t))
    168   "The action used to display the transient popup buffer.
    169 
    170 The transient popup buffer is displayed in a window using
    171 
    172   (display-buffer BUFFER transient-display-buffer-action)
    173 
    174 The value of this option has the form (FUNCTION . ALIST),
    175 where FUNCTION is a function or a list of functions.  Each such
    176 function should accept two arguments: a buffer to display and an
    177 alist of the same form as ALIST.  See info node `(elisp)Choosing
    178 Window' for details.
    179 
    180 The default is:
    181 
    182   (display-buffer-in-side-window
    183     (side . bottom)
    184     (dedicated . t)
    185     (inhibit-same-window . t))
    186 
    187 This displays the window at the bottom of the selected frame.
    188 Another useful FUNCTION is `display-buffer-below-selected', which
    189 is what `magit-popup' used by default.  For more alternatives see
    190 info node `(elisp)Display Action Functions' and info node
    191 `(elisp)Buffer Display Action Alists'.
    192 
    193 Note that the buffer that was current before the transient buffer
    194 is shown should remain the current buffer.  Many suffix commands
    195 act on the thing at point, if appropriate, and if the transient
    196 buffer became the current buffer, then that would change what is
    197 at point.  To that effect `inhibit-same-window' ensures that the
    198 selected window is not used to show the transient buffer.
    199 
    200 It may be possible to display the window in another frame, but
    201 whether that works in practice depends on the window-manager.
    202 If the window manager selects the new window (Emacs frame),
    203 then that unfortunately changes which buffer is current.
    204 
    205 If you change the value of this option, then you might also
    206 want to change the value of `transient-mode-line-format'."
    207   :package-version '(transient . "0.7.5")
    208   :group 'transient
    209   :type '(cons (choice function (repeat :tag "Functions" function))
    210                alist))
    211 
    212 (defcustom transient-mode-line-format 'line
    213   "The mode-line format for the transient popup buffer.
    214 
    215 If nil, then the buffer has no mode-line.  If the buffer is not
    216 displayed right above the echo area, then this probably is not
    217 a good value.
    218 
    219 If `line' (the default) or a natural number, then the buffer
    220 has no mode-line, but a line is drawn is drawn in its place.
    221 If a number is used, that specifies the thickness of the line.
    222 On termcap frames we cannot draw lines, so there `line' and
    223 numbers are synonyms for nil.
    224 
    225 The color of the line is used to indicate if non-suffixes are
    226 allowed and whether they exit the transient.  The foreground
    227 color of `transient-key-noop' (if non-suffix are disallowed),
    228 `transient-key-stay' (if allowed and transient stays active), or
    229 `transient-key-exit' (if allowed and they exit the transient) is
    230 used to draw the line.
    231 
    232 Otherwise this can be any mode-line format.
    233 See `mode-line-format' for details."
    234   :package-version '(transient . "0.2.0")
    235   :group 'transient
    236   :type '(choice (const  :tag "hide mode-line" nil)
    237                  (const  :tag "substitute thin line" line)
    238                  (number :tag "substitute line with thickness")
    239                  (const  :tag "name of prefix command"
    240                          ("%e" mode-line-front-space
    241                           mode-line-buffer-identification))
    242                  (sexp   :tag "custom mode-line format")))
    243 
    244 (defcustom transient-show-common-commands nil
    245   "Whether to show common transient suffixes in the popup buffer.
    246 
    247 These commands are always shown after typing the prefix key
    248 \"C-x\" when a transient command is active.  To toggle the value
    249 of this variable use \"C-x t\" when a transient is active."
    250   :package-version '(transient . "0.1.0")
    251   :group 'transient
    252   :type 'boolean)
    253 
    254 (defcustom transient-read-with-initial-input nil
    255   "Whether to use the last history element as initial minibuffer input."
    256   :package-version '(transient . "0.2.0")
    257   :group 'transient
    258   :type 'boolean)
    259 
    260 (defcustom transient-highlight-mismatched-keys nil
    261   "Whether to highlight keys that do not match their argument.
    262 
    263 This only affects infix arguments that represent command-line
    264 arguments.  When this option is non-nil, then the key binding
    265 for infix argument are highlighted when only a long argument
    266 \(e.g., \"--verbose\") is specified but no shorthand (e.g., \"-v\").
    267 In the rare case that a short-hand is specified but does not
    268 match the key binding, then it is highlighted differently.
    269 
    270 The highlighting is done using `transient-mismatched-key'
    271 and `transient-nonstandard-key'."
    272   :package-version '(transient . "0.1.0")
    273   :group 'transient
    274   :type 'boolean)
    275 
    276 (defcustom transient-highlight-higher-levels nil
    277   "Whether to highlight suffixes on higher levels.
    278 
    279 This is primarily intended for package authors.
    280 
    281 When non-nil then highlight the description of suffixes whose
    282 level is above 4, the default of `transient-default-level'.
    283 Assuming you have set that variable to 7, this highlights all
    284 suffixes that won't be available to users without them making
    285 the same customization."
    286   :package-version '(transient . "0.3.6")
    287   :group 'transient
    288   :type 'boolean)
    289 
    290 (defcustom transient-substitute-key-function nil
    291   "Function used to modify key bindings.
    292 
    293 This function is called with one argument, the prefix object,
    294 and must return a key binding description, either the existing
    295 key description it finds in the `key' slot, or a substitution.
    296 
    297 This is intended to let users replace certain prefix keys.  It
    298 could also be used to make other substitutions, but that is
    299 discouraged.
    300 
    301 For example, \"=\" is hard to reach using my custom keyboard
    302 layout, so I substitute \"(\" for that, which is easy to reach
    303 using a layout optimized for Lisp.
    304 
    305   (setq transient-substitute-key-function
    306         (lambda (obj)
    307           (let ((key (oref obj key)))
    308             (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key)
    309                 (replace-match \"(\" t t key 1)
    310               key)))))"
    311   :package-version '(transient . "0.1.0")
    312   :group 'transient
    313   :type '(choice (const :tag "Transform no keys (nil)" nil) function))
    314 
    315 (defcustom transient-semantic-coloring t
    316   "Whether to use colors to indicate transient behavior.
    317 
    318 If non-nil, then the key binding of each suffix is colorized to
    319 indicate whether it exits the transient state or not, and the
    320 line that is drawn below the transient popup buffer is used to
    321 indicate the behavior of non-suffix commands."
    322   :package-version '(transient . "0.5.0")
    323   :group 'transient
    324   :type 'boolean)
    325 
    326 (defcustom transient-detect-key-conflicts nil
    327   "Whether to detect key binding conflicts.
    328 
    329 Conflicts are detected when a transient prefix command is invoked
    330 and results in an error, which prevents the transient from being
    331 used."
    332   :package-version '(transient . "0.1.0")
    333   :group 'transient
    334   :type 'boolean)
    335 
    336 (defcustom transient-align-variable-pitch nil
    337   "Whether to align columns pixel-wise in the popup buffer.
    338 
    339 If this is non-nil, then columns are aligned pixel-wise to
    340 support variable-pitch fonts.  Keys are not aligned, so you
    341 should use a fixed-pitch font for the `transient-key' face.
    342 Other key faces inherit from that face unless a theme is
    343 used that breaks that relationship.
    344 
    345 This option is intended for users who use a variable-pitch
    346 font for the `default' face.
    347 
    348 Also see `transient-force-fixed-pitch'."
    349   :package-version '(transient . "0.4.0")
    350   :group 'transient
    351   :type 'boolean)
    352 
    353 (defcustom transient-force-fixed-pitch nil
    354   "Whether to force use of monospaced font in the popup buffer.
    355 
    356 Even if you use a proportional font for the `default' face,
    357 you might still want to use a monospaced font in transient's
    358 popup buffer.  Setting this option to t causes `default' to
    359 be remapped to `fixed-pitch' in that buffer.
    360 
    361 Also see `transient-align-variable-pitch'."
    362   :package-version '(transient . "0.2.0")
    363   :group 'transient
    364   :type 'boolean)
    365 
    366 (defcustom transient-force-single-column nil
    367   "Whether to force use of a single column to display suffixes.
    368 
    369 This might be useful for users with low vision who use large
    370 text and might otherwise have to scroll in two dimensions."
    371   :package-version '(transient . "0.3.6")
    372   :group 'transient
    373   :type 'boolean)
    374 
    375 (defcustom transient-hide-during-minibuffer-read nil
    376   "Whether to hide the transient buffer while reading in the minibuffer."
    377   :package-version '(transient . "0.4.0")
    378   :group 'transient
    379   :type 'boolean)
    380 
    381 (defconst transient--max-level 7)
    382 (defconst transient--default-child-level 1)
    383 (defconst transient--default-prefix-level 4)
    384 
    385 (defcustom transient-default-level transient--default-prefix-level
    386   "Control what suffix levels are made available by default.
    387 
    388 Each suffix command is placed on a level and each prefix command
    389 has a level, which controls which suffix commands are available.
    390 Integers between 1 and 7 (inclusive) are valid levels.
    391 
    392 The levels of individual transients and/or their individual
    393 suffixes can be changed individually, by invoking the prefix and
    394 then pressing \"C-x l\".
    395 
    396 The default level for both transients and their suffixes is 4.
    397 This option only controls the default for transients.  The default
    398 suffix level is always 4.  The author of a transient should place
    399 certain suffixes on a higher level if they expect that it won't be
    400 of use to most users, and they should place very important suffixes
    401 on a lower level so that they remain available even if the user
    402 lowers the transient level.
    403 
    404 \(Magit currently places nearly all suffixes on level 4 and lower
    405 levels are not used at all yet.  So for the time being you should
    406 not set a lower level here and using a higher level might not
    407 give you as many additional suffixes as you hoped.)"
    408   :package-version '(transient . "0.1.0")
    409   :group 'transient
    410   :type '(choice (const :tag "1 - fewest suffixes" 1)
    411                  (const 2)
    412                  (const 3)
    413                  (const :tag "4 - default" 4)
    414                  (const 5)
    415                  (const 6)
    416                  (const :tag "7 - most suffixes" 7)))
    417 
    418 (defcustom transient-levels-file
    419   (locate-user-emacs-file "transient/levels.el")
    420   "File used to save levels of transients and their suffixes."
    421   :package-version '(transient . "0.1.0")
    422   :group 'transient
    423   :type 'file)
    424 
    425 (defcustom transient-values-file
    426   (locate-user-emacs-file "transient/values.el")
    427   "File used to save values of transients."
    428   :package-version '(transient . "0.1.0")
    429   :group 'transient
    430   :type 'file)
    431 
    432 (defcustom transient-history-file
    433   (locate-user-emacs-file "transient/history.el")
    434   "File used to save history of transients and their infixes."
    435   :package-version '(transient . "0.1.0")
    436   :group 'transient
    437   :type 'file)
    438 
    439 (defcustom transient-history-limit 10
    440   "Number of history elements to keep when saving to file."
    441   :package-version '(transient . "0.1.0")
    442   :group 'transient
    443   :type 'integer)
    444 
    445 (defcustom transient-save-history t
    446   "Whether to save history of transient commands when exiting Emacs."
    447   :package-version '(transient . "0.1.0")
    448   :group 'transient
    449   :type 'boolean)
    450 
    451 ;;; Faces
    452 
    453 (defgroup transient-faces nil
    454   "Faces used by Transient."
    455   :group 'transient)
    456 
    457 (defface transient-heading '((t :inherit font-lock-keyword-face))
    458   "Face used for headings."
    459   :group 'transient-faces)
    460 
    461 (defface transient-argument '((t :inherit font-lock-string-face :weight bold))
    462   "Face used for enabled arguments."
    463   :group 'transient-faces)
    464 
    465 (defface transient-inactive-argument '((t :inherit shadow))
    466   "Face used for inactive arguments."
    467   :group 'transient-faces)
    468 
    469 (defface transient-value '((t :inherit font-lock-string-face :weight bold))
    470   "Face used for values."
    471   :group 'transient-faces)
    472 
    473 (defface transient-inactive-value '((t :inherit shadow))
    474   "Face used for inactive values."
    475   :group 'transient-faces)
    476 
    477 (defface transient-unreachable '((t :inherit shadow))
    478   "Face used for suffixes unreachable from the current prefix sequence."
    479   :group 'transient-faces)
    480 
    481 (defface transient-inapt-suffix '((t :inherit shadow :italic t))
    482   "Face used for suffixes that are inapt at this time."
    483   :group 'transient-faces)
    484 
    485 (defface transient-active-infix '((t :inherit highlight))
    486   "Face used for the infix for which the value is being read."
    487   :group 'transient-faces)
    488 
    489 (defface transient-enabled-suffix
    490   '((t :background "green" :foreground "black" :weight bold))
    491   "Face used for enabled levels while editing suffix levels.
    492 See info node `(transient)Enabling and Disabling Suffixes'."
    493   :group 'transient-faces)
    494 
    495 (defface transient-disabled-suffix
    496   '((t :background "red" :foreground "black" :weight bold))
    497   "Face used for disabled levels while editing suffix levels.
    498 See info node `(transient)Enabling and Disabling Suffixes'."
    499   :group 'transient-faces)
    500 
    501 (defface transient-higher-level
    502   `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
    503               :color ,(let ((color (face-attribute 'shadow :foreground nil t)))
    504                         (or (and (not (eq color 'unspecified)) color)
    505                             "grey60")))))
    506   "Face optionally used to highlight suffixes on higher levels.
    507 Also see option `transient-highlight-higher-levels'."
    508   :group 'transient-faces)
    509 
    510 (defface transient-delimiter '((t :inherit shadow))
    511   "Face used for delimiters and separators.
    512 This includes the parentheses around values and the pipe
    513 character used to separate possible values from each other."
    514   :group 'transient-faces)
    515 
    516 (defface transient-key '((t :inherit font-lock-builtin-face))
    517   "Face used for keys."
    518   :group 'transient-faces)
    519 
    520 (defface transient-key-stay
    521   `((((class color) (background light))
    522      :inherit transient-key
    523      :foreground "#22aa22")
    524     (((class color) (background dark))
    525      :inherit transient-key
    526      :foreground "#ddffdd"))
    527   "Face used for keys of suffixes that don't exit transient state."
    528   :group 'transient-faces)
    529 
    530 (defface transient-key-noop
    531   `((((class color) (background light))
    532      :inherit transient-key
    533      :foreground "grey80")
    534     (((class color) (background dark))
    535      :inherit transient-key
    536      :foreground "grey30"))
    537   "Face used for keys of suffixes that currently cannot be invoked."
    538   :group 'transient-faces)
    539 
    540 (defface transient-key-return
    541   `((((class color) (background light))
    542      :inherit transient-key
    543      :foreground "#aaaa11")
    544     (((class color) (background dark))
    545      :inherit transient-key
    546      :foreground "#ffffcc"))
    547   "Face used for keys of suffixes that return to the parent transient."
    548   :group 'transient-faces)
    549 
    550 (defface transient-key-exit
    551   `((((class color) (background light))
    552      :inherit transient-key
    553      :foreground "#aa2222")
    554     (((class color) (background dark))
    555      :inherit transient-key
    556      :foreground "#ffdddd"))
    557   "Face used for keys of suffixes that exit transient state."
    558   :group 'transient-faces)
    559 
    560 (defface transient-unreachable-key
    561   '((t :inherit (shadow transient-key) :weight normal))
    562   "Face used for keys unreachable from the current prefix sequence."
    563   :group 'transient-faces)
    564 
    565 (defface transient-nonstandard-key
    566   `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
    567               :color "cyan")))
    568   "Face optionally used to highlight keys conflicting with short-argument.
    569 Also see option `transient-highlight-mismatched-keys'."
    570   :group 'transient-faces)
    571 
    572 (defface transient-mismatched-key
    573   `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
    574               :color "magenta")))
    575   "Face optionally used to highlight keys without a short-argument.
    576 Also see option `transient-highlight-mismatched-keys'."
    577   :group 'transient-faces)
    578 
    579 ;;; Persistence
    580 
    581 (defun transient--read-file-contents (file)
    582   (with-demoted-errors "Transient error: %S"
    583     (and (file-exists-p file)
    584          (with-temp-buffer
    585            (insert-file-contents file)
    586            (read (current-buffer))))))
    587 
    588 (defun transient--pp-to-file (list file)
    589   (make-directory (file-name-directory file) t)
    590   (setq list (cl-sort (copy-sequence list) #'string< :key #'car))
    591   (with-temp-file file
    592     (let ((print-level nil)
    593           (print-length nil)
    594           (pp-default-function 'pp-28)
    595           (fill-column 999))
    596       (pp list (current-buffer)))))
    597 
    598 (defvar transient-values
    599   (transient--read-file-contents transient-values-file)
    600   "Values of transient commands.
    601 The value of this variable persists between Emacs sessions
    602 and you usually should not change it manually.")
    603 
    604 (defun transient-save-values ()
    605   (transient--pp-to-file transient-values transient-values-file))
    606 
    607 (defvar transient-levels
    608   (transient--read-file-contents transient-levels-file)
    609   "Levels of transient commands.
    610 The value of this variable persists between Emacs sessions
    611 and you usually should not change it manually.")
    612 
    613 (defun transient-save-levels ()
    614   (transient--pp-to-file transient-levels transient-levels-file))
    615 
    616 (defvar transient-history
    617   (transient--read-file-contents transient-history-file)
    618   "History of transient commands and infix arguments.
    619 The value of this variable persists between Emacs sessions
    620 \(unless `transient-save-history' is nil) and you usually
    621 should not change it manually.")
    622 
    623 (defun transient-save-history ()
    624   (setq transient-history
    625         (cl-sort (mapcar (pcase-lambda (`(,key . ,val))
    626                            (cons key (seq-take (delete-dups val)
    627                                                transient-history-limit)))
    628                          transient-history)
    629                  #'string< :key #'car))
    630   (transient--pp-to-file transient-history transient-history-file))
    631 
    632 (defun transient-maybe-save-history ()
    633   "Save the value of `transient-history'.
    634 If `transient-save-history' is nil, then do nothing."
    635   (when transient-save-history
    636     (transient-save-history)))
    637 
    638 (unless noninteractive
    639   (add-hook 'kill-emacs-hook #'transient-maybe-save-history))
    640 
    641 ;;; Classes
    642 ;;;; Prefix
    643 
    644 (defclass transient-prefix ()
    645   ((prototype   :initarg :prototype)
    646    (command     :initarg :command)
    647    (level       :initarg :level)
    648    (variable    :initarg :variable    :initform nil)
    649    (init-value  :initarg :init-value)
    650    (value) (default-value :initarg :value)
    651    (scope       :initarg :scope       :initform nil)
    652    (history     :initarg :history     :initform nil)
    653    (history-pos :initarg :history-pos :initform 0)
    654    (history-key :initarg :history-key :initform nil)
    655    (show-help   :initarg :show-help   :initform nil)
    656    (info-manual :initarg :info-manual :initform nil)
    657    (man-page    :initarg :man-page    :initform nil)
    658    (transient-suffix     :initarg :transient-suffix     :initform nil)
    659    (transient-non-suffix :initarg :transient-non-suffix :initform nil)
    660    (transient-switch-frame :initarg :transient-switch-frame)
    661    (refresh-suffixes     :initarg :refresh-suffixes     :initform nil)
    662    (incompatible         :initarg :incompatible         :initform nil)
    663    (suffix-description   :initarg :suffix-description)
    664    (variable-pitch       :initarg :variable-pitch       :initform nil)
    665    (column-widths        :initarg :column-widths        :initform nil)
    666    (unwind-suffix        :documentation "Internal use." :initform nil))
    667   "Transient prefix command.
    668 
    669 Each transient prefix command consists of a command, which is
    670 stored in a symbol's function slot and an object, which is
    671 stored in the `transient--prefix' property of the same symbol.
    672 
    673 When a transient prefix command is invoked, then a clone of that
    674 object is stored in the global variable `transient--prefix' and
    675 the prototype is stored in the clone's `prototype' slot.")
    676 
    677 ;;;; Suffix
    678 
    679 (defclass transient-child ()
    680   ((level
    681     :initarg :level
    682     :initform (symbol-value 'transient--default-child-level)
    683     :documentation "Enable if level of prefix is equal or greater.")
    684    (if
    685     :initarg :if
    686     :initform nil
    687     :documentation "Enable if predicate returns non-nil.")
    688    (if-not
    689     :initarg :if-not
    690     :initform nil
    691     :documentation "Enable if predicate returns nil.")
    692    (if-non-nil
    693     :initarg :if-non-nil
    694     :initform nil
    695     :documentation "Enable if variable's value is non-nil.")
    696    (if-nil
    697     :initarg :if-nil
    698     :initform nil
    699     :documentation "Enable if variable's value is nil.")
    700    (if-mode
    701     :initarg :if-mode
    702     :initform nil
    703     :documentation "Enable if major-mode matches value.")
    704    (if-not-mode
    705     :initarg :if-not-mode
    706     :initform nil
    707     :documentation "Enable if major-mode does not match value.")
    708    (if-derived
    709     :initarg :if-derived
    710     :initform nil
    711     :documentation "Enable if major-mode derives from value.")
    712    (if-not-derived
    713     :initarg :if-not-derived
    714     :initform nil
    715     :documentation "Enable if major-mode does not derive from value.")
    716    (inapt
    717     :initform nil)
    718    (inapt-face
    719     :initarg :inapt-face
    720     :initform 'transient-inapt-suffix)
    721    (inapt-if
    722     :initarg :inapt-if
    723     :initform nil
    724     :documentation "Inapt if predicate returns non-nil.")
    725    (inapt-if-not
    726     :initarg :inapt-if-not
    727     :initform nil
    728     :documentation "Inapt if predicate returns nil.")
    729    (inapt-if-non-nil
    730     :initarg :inapt-if-non-nil
    731     :initform nil
    732     :documentation "Inapt if variable's value is non-nil.")
    733    (inapt-if-nil
    734     :initarg :inapt-if-nil
    735     :initform nil
    736     :documentation "Inapt if variable's value is nil.")
    737    (inapt-if-mode
    738     :initarg :inapt-if-mode
    739     :initform nil
    740     :documentation "Inapt if major-mode matches value.")
    741    (inapt-if-not-mode
    742     :initarg :inapt-if-not-mode
    743     :initform nil
    744     :documentation "Inapt if major-mode does not match value.")
    745    (inapt-if-derived
    746     :initarg :inapt-if-derived
    747     :initform nil
    748     :documentation "Inapt if major-mode derives from value.")
    749    (inapt-if-not-derived
    750     :initarg :inapt-if-not-derived
    751     :initform nil
    752     :documentation "Inapt if major-mode does not derive from value."))
    753   "Abstract superclass for group and suffix classes.
    754 
    755 It is undefined what happens if more than one `if*' predicate
    756 slot is non-nil."
    757   :abstract t)
    758 
    759 (defclass transient-suffix (transient-child)
    760   ((definition  :allocation :class    :initform nil)
    761    (key         :initarg :key)
    762    (command     :initarg :command)
    763    (transient   :initarg :transient)
    764    (format      :initarg :format      :initform " %k %d")
    765    (description :initarg :description :initform nil)
    766    (face        :initarg :face        :initform nil)
    767    (show-help   :initarg :show-help   :initform nil))
    768   "Superclass for suffix command.")
    769 
    770 (defclass transient-information (transient-suffix)
    771   ((format :initform " %k %d")
    772    (key    :initform " "))
    773   "Display-only information, aligned with suffix keys.
    774 Technically a suffix object with no associated command.")
    775 
    776 (defclass transient-information* (transient-information)
    777   ((format :initform " %d"))
    778   "Display-only information, aligned with suffix descriptions.
    779 Technically a suffix object with no associated command.")
    780 
    781 (defclass transient-infix (transient-suffix)
    782   ((transient                         :initform t)
    783    (argument    :initarg :argument)
    784    (shortarg    :initarg :shortarg)
    785    (value                             :initform nil)
    786    (init-value  :initarg :init-value)
    787    (unsavable   :initarg :unsavable   :initform nil)
    788    (multi-value :initarg :multi-value :initform nil)
    789    (always-read :initarg :always-read :initform nil)
    790    (allow-empty :initarg :allow-empty :initform nil)
    791    (history-key :initarg :history-key :initform nil)
    792    (reader      :initarg :reader      :initform nil)
    793    (prompt      :initarg :prompt      :initform nil)
    794    (choices     :initarg :choices     :initform nil)
    795    (format                            :initform " %k %d (%v)"))
    796   "Transient infix command."
    797   :abstract t)
    798 
    799 (defclass transient-argument (transient-infix) ()
    800   "Abstract superclass for infix arguments."
    801   :abstract t)
    802 
    803 (defclass transient-switch (transient-argument) ()
    804   "Class used for command-line argument that can be turned on and off.")
    805 
    806 (defclass transient-option (transient-argument) ()
    807   "Class used for command-line argument that can take a value.")
    808 
    809 (defclass transient-variable (transient-infix)
    810   ((variable    :initarg :variable)
    811    (format                            :initform " %k %d %v"))
    812   "Abstract superclass for infix commands that set a variable."
    813   :abstract t)
    814 
    815 (defclass transient-switches (transient-argument)
    816   ((argument-format  :initarg :argument-format)
    817    (argument-regexp  :initarg :argument-regexp))
    818   "Class used for sets of mutually exclusive command-line switches.")
    819 
    820 (defclass transient-files (transient-option) ()
    821   ((key         :initform "--")
    822    (argument    :initform "--")
    823    (multi-value :initform rest)
    824    (reader      :initform transient-read-files))
    825   "Class used for the \"--\" argument or similar.
    826 All remaining arguments are treated as files.
    827 They become the value of this argument.")
    828 
    829 (defclass transient-value-preset (transient-suffix)
    830   ((transient :initform t)
    831    (set :initarg := :initform nil))
    832   "Class used by the `transient-preset' suffix command.")
    833 
    834 ;;;; Group
    835 
    836 (defclass transient-group (transient-child)
    837   ((suffixes       :initarg :suffixes       :initform nil)
    838    (hide           :initarg :hide           :initform nil)
    839    (description    :initarg :description    :initform nil)
    840    (pad-keys       :initarg :pad-keys       :initform nil)
    841    (info-format    :initarg :info-format    :initform nil)
    842    (setup-children :initarg :setup-children))
    843   "Abstract superclass of all group classes."
    844   :abstract t)
    845 
    846 (defclass transient-column (transient-group) ()
    847   "Group class that displays each element on a separate line.")
    848 
    849 (defclass transient-row (transient-group) ()
    850   "Group class that displays all elements on a single line.")
    851 
    852 (defclass transient-columns (transient-group) ()
    853   "Group class that displays elements organized in columns.
    854 Direct elements have to be groups whose elements have to be
    855 commands or strings.  Each subgroup represents a column.
    856 This class takes care of inserting the subgroups' elements.")
    857 
    858 (defclass transient-subgroups (transient-group) ()
    859   "Group class that wraps other groups.
    860 
    861 Direct elements have to be groups whose elements have to be
    862 commands or strings.  This group inserts an empty line between
    863 subgroups.  The subgroups are responsible for displaying their
    864 elements themselves.")
    865 
    866 ;;; Define
    867 
    868 (defmacro transient-define-prefix (name arglist &rest args)
    869   "Define NAME as a transient prefix command.
    870 
    871 ARGLIST are the arguments that command takes.
    872 DOCSTRING is the documentation string and is optional.
    873 
    874 These arguments can optionally be followed by key-value pairs.
    875 Each key has to be a keyword symbol, either `:class' or a keyword
    876 argument supported by the constructor of that class.  The
    877 `transient-prefix' class is used if the class is not specified
    878 explicitly.
    879 
    880 GROUPs add key bindings for infix and suffix commands and specify
    881 how these bindings are presented in the popup buffer.  At least
    882 one GROUP has to be specified.  See info node `(transient)Binding
    883 Suffix and Infix Commands'.
    884 
    885 The BODY is optional.  If it is omitted, then ARGLIST is also
    886 ignored and the function definition becomes:
    887 
    888   (lambda ()
    889     (interactive)
    890     (transient-setup \\='NAME))
    891 
    892 If BODY is specified, then it must begin with an `interactive'
    893 form that matches ARGLIST, and it must call `transient-setup'.
    894 It may however call that function only when some condition is
    895 satisfied; that is one of the reason why you might want to use
    896 an explicit BODY.
    897 
    898 All transients have a (possibly nil) value, which is exported
    899 when suffix commands are called, so that they can consume that
    900 value.  For some transients it might be necessary to have a sort
    901 of secondary value, called a scope.  Such a scope would usually
    902 be set in the commands `interactive' form and has to be passed
    903 to the setup function:
    904 
    905   (transient-setup \\='NAME nil nil :scope SCOPE)
    906 
    907 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
    908   (declare (debug ( &define name lambda-list
    909                     [&optional lambda-doc]
    910                     [&rest keywordp sexp]
    911                     [&rest vectorp]
    912                     [&optional ("interactive" interactive) def-body]))
    913            (indent defun)
    914            (doc-string 3))
    915   (pcase-let
    916       ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only)
    917         (transient--expand-define-args args arglist 'transient-define-prefix)))
    918     `(progn
    919        (defalias ',name
    920          ,(if body
    921               `(lambda ,arglist ,@body)
    922             `(lambda ()
    923                (interactive)
    924                (transient-setup ',name))))
    925        (put ',name 'interactive-only ,interactive-only)
    926        (put ',name 'function-documentation ,docstr)
    927        (put ',name 'transient--prefix
    928             (,(or class 'transient-prefix) :command ',name ,@slots))
    929        (put ',name 'transient--layout
    930             (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
    931                                suffixes))))))
    932 
    933 (defmacro transient-define-suffix (name arglist &rest args)
    934   "Define NAME as a transient suffix command.
    935 
    936 ARGLIST are the arguments that the command takes.
    937 DOCSTRING is the documentation string and is optional.
    938 
    939 These arguments can optionally be followed by key-value pairs.
    940 Each key has to be a keyword symbol, either `:class' or a
    941 keyword argument supported by the constructor of that class.
    942 The `transient-suffix' class is used if the class is not
    943 specified explicitly.
    944 
    945 The BODY must begin with an `interactive' form that matches
    946 ARGLIST.  The infix arguments are usually accessed by using
    947 `transient-args' inside `interactive'.
    948 
    949 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])"
    950   (declare (debug ( &define name lambda-list
    951                     [&optional lambda-doc]
    952                     [&rest keywordp sexp]
    953                     [&optional ("interactive" interactive) def-body]))
    954            (indent defun)
    955            (doc-string 3))
    956   (pcase-let
    957       ((`(,class ,slots ,_ ,docstr ,body ,interactive-only)
    958         (transient--expand-define-args args arglist 'transient-define-suffix)))
    959     `(progn
    960        (defalias ',name
    961          ,(if (and (not body) class (oref-default class definition))
    962               `(oref-default ',class definition)
    963             `(lambda ,arglist ,@body)))
    964        (put ',name 'interactive-only ,interactive-only)
    965        (put ',name 'function-documentation ,docstr)
    966        (put ',name 'transient--suffix
    967             (,(or class 'transient-suffix) :command ',name ,@slots)))))
    968 
    969 (defmacro transient-augment-suffix (name &rest args)
    970   "Augment existing command NAME with a new transient suffix object.
    971 Similar to `transient-define-suffix' but define a suffix object only.
    972 \n\(fn NAME [KEYWORD VALUE]...)"
    973   (declare (debug (&define name [&rest keywordp sexp]))
    974            (indent defun))
    975   (pcase-let
    976       ((`(,class ,slots)
    977         (transient--expand-define-args args nil 'transient-augment-suffix t)))
    978     `(put ',name 'transient--suffix
    979           (,(or class 'transient-suffix) :command ',name ,@slots))))
    980 
    981 (defmacro transient-define-infix (name arglist &rest args)
    982   "Define NAME as a transient infix command.
    983 
    984 ARGLIST is always ignored and reserved for future use.
    985 DOCSTRING is the documentation string and is optional.
    986 
    987 At least one key-value pair is required.  All transient infix
    988 commands are equal to each other (but not eq).  It is meaning-
    989 less to define an infix command, without providing at least one
    990 keyword argument (usually `:argument' or `:variable', depending
    991 on the class).  The suffix class defaults to `transient-switch'
    992 and can be set using the `:class' keyword.
    993 
    994 The function definitions is always:
    995 
    996   (lambda ()
    997     (interactive)
    998     (let ((obj (transient-suffix-object)))
    999       (transient-infix-set obj (transient-infix-read obj)))
   1000     (transient--show))
   1001 
   1002 `transient-infix-read' and `transient-infix-set' are generic
   1003 functions.  Different infix commands behave differently because
   1004 the concrete methods are different for different infix command
   1005 classes.  In rare case the above command function might not be
   1006 suitable, even if you define your own infix command class.  In
   1007 that case you have to use `transient-define-suffix' to define
   1008 the infix command and use t as the value of the `:transient'
   1009 keyword.
   1010 
   1011 \(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)"
   1012   (declare (debug ( &define name lambda-list
   1013                     [&optional lambda-doc]
   1014                     keywordp sexp
   1015                     [&rest keywordp sexp]))
   1016            (indent defun)
   1017            (doc-string 3))
   1018   (pcase-let
   1019       ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only)
   1020         (transient--expand-define-args args arglist 'transient-define-infix t)))
   1021     `(progn
   1022        (defalias ',name #'transient--default-infix-command)
   1023        (put ',name 'interactive-only ,interactive-only)
   1024        (put ',name 'completion-predicate #'transient--suffix-only)
   1025        (put ',name 'function-documentation ,docstr)
   1026        (put ',name 'transient--suffix
   1027             (,(or class 'transient-switch) :command ',name ,@slots)))))
   1028 
   1029 (defalias 'transient-define-argument #'transient-define-infix
   1030   "Define NAME as a transient infix command.
   1031 
   1032 Only use this alias to define an infix command that actually
   1033 sets an infix argument.  To define a infix command that, for
   1034 example, sets a variable, use `transient-define-infix' instead.
   1035 
   1036 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
   1037 
   1038 (defun transient--default-infix-command ()
   1039   ;; Most infix commands are but an alias for this command.
   1040   "Cannot show any documentation for this transient infix command.
   1041 
   1042 When you request help for an infix command using `transient-help', that
   1043 usually shows the respective man-page and tries to jump to the location
   1044 where the respective argument is being described.
   1045 
   1046 If no man-page is specified for the containing transient menu, then the
   1047 docstring is displayed instead, if any.
   1048 
   1049 If the infix command doesn't have a docstring, as is the case here, then
   1050 this docstring is displayed instead, because technically infix commands
   1051 are aliases for `transient--default-infix-command'.
   1052 
   1053 `describe-function' also shows the docstring of the infix command,
   1054 falling back to that of the same aliased command."
   1055   (interactive)
   1056   (let ((obj (transient-suffix-object)))
   1057     (transient-infix-set obj (transient-infix-read obj)))
   1058   (transient--show))
   1059 (put 'transient--default-infix-command 'interactive-only t)
   1060 (put 'transient--default-infix-command 'completion-predicate
   1061      #'transient--suffix-only)
   1062 
   1063 (define-advice find-function-advised-original
   1064     (:around (fn func) transient-default-infix)
   1065   "Return nil instead of `transient--default-infix-command'.
   1066 When using `find-function' to jump to the definition of a transient
   1067 infix command/argument, then we want to actually jump to that, not to
   1068 the definition of `transient--default-infix-command', which all infix
   1069 commands are aliases for."
   1070   (let ((val (funcall fn func)))
   1071     (and val (not (eq val 'transient--default-infix-command)) val)))
   1072 
   1073 (eval-and-compile ;transient--expand-define-args
   1074   (defun transient--expand-define-args (args &optional arglist form nobody)
   1075     ;; ARGLIST and FORM are only optional for backward compatibility.
   1076     ;; This is necessary because "emoji.el" from Emacs 29 calls this
   1077     ;; function directly, with just one argument.
   1078     (unless (listp arglist)
   1079       (error "Mandatory ARGLIST is missing"))
   1080     (let (class keys suffixes docstr declare (interactive-only t))
   1081       (when (stringp (car args))
   1082         (setq docstr (pop args)))
   1083       (while (keywordp (car args))
   1084         (let ((k (pop args))
   1085               (v (pop args)))
   1086           (if (eq k :class)
   1087               (setq class v)
   1088             (push k keys)
   1089             (push v keys))))
   1090       (while (let ((arg (car args)))
   1091                (or (vectorp arg)
   1092                    (and arg (symbolp arg))))
   1093         (push (pop args) suffixes))
   1094       (when (eq (car-safe (car args)) 'declare)
   1095         (setq declare (car args))
   1096         (setq args (cdr args))
   1097         (when-let ((int (assq 'interactive-only declare)))
   1098           (setq interactive-only (cadr int))
   1099           (delq int declare))
   1100         (unless (cdr declare)
   1101           (setq declare nil)))
   1102       (cond
   1103        ((not args))
   1104        (nobody
   1105         (error "%s: No function body allowed" form))
   1106        ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive))
   1107         (error "%s: Interactive form missing" form)))
   1108       (list (if (eq (car-safe class) 'quote)
   1109                 (cadr class)
   1110               class)
   1111             (nreverse keys)
   1112             (nreverse suffixes)
   1113             docstr
   1114             (if declare (cons declare args) args)
   1115             interactive-only))))
   1116 
   1117 (defun transient--parse-child (prefix spec)
   1118   (cl-typecase spec
   1119     (null    (error "Invalid transient--parse-child spec: %s" spec))
   1120     (symbol  (let ((value (symbol-value spec)))
   1121                (if (and (listp value)
   1122                         (or (listp (car value))
   1123                             (vectorp (car value))))
   1124                    (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value)
   1125                  (transient--parse-child prefix value))))
   1126     (vector  (and-let* ((c (transient--parse-group  prefix spec))) (list c)))
   1127     (list    (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
   1128     (string  (list spec))
   1129     (t       (error "Invalid transient--parse-child spec: %s" spec))))
   1130 
   1131 (defun transient--parse-group (prefix spec)
   1132   (setq spec (append spec nil))
   1133   (cl-symbol-macrolet
   1134       ((car (car spec))
   1135        (pop (pop spec)))
   1136     (let (level class args)
   1137       (when (integerp car)
   1138         (setq level pop))
   1139       (when (stringp car)
   1140         (setq args (plist-put args :description pop)))
   1141       (while (keywordp car)
   1142         (let ((key pop)
   1143               (val pop))
   1144           (cond ((eq key :class)
   1145                  (setq class (macroexp-quote val)))
   1146                 ((or (symbolp val)
   1147                      (and (listp val) (not (eq (car val) 'lambda))))
   1148                  (setq args (plist-put args key (macroexp-quote val))))
   1149                 ((setq args (plist-put args key val))))))
   1150       (unless (or spec class (not (plist-get args :setup-children)))
   1151         (message "WARNING: %s: When %s is used, %s must also be specified"
   1152                  'transient-define-prefix :setup-children :class))
   1153       (list 'vector
   1154             (or level transient--default-child-level)
   1155             (cond (class)
   1156                   ((or (vectorp car)
   1157                        (and car (symbolp car)))
   1158                    (quote 'transient-columns))
   1159                   ((quote 'transient-column)))
   1160             (and args (cons 'list args))
   1161             (cons 'list
   1162                   (cl-mapcan (lambda (s) (transient--parse-child prefix s))
   1163                              spec))))))
   1164 
   1165 (defun transient--parse-suffix (prefix spec)
   1166   (let (level class args)
   1167     (cl-symbol-macrolet
   1168         ((car (car spec))
   1169          (pop (pop spec)))
   1170       (when (integerp car)
   1171         (setq level pop))
   1172       (when (or (stringp car)
   1173                 (vectorp car))
   1174         (setq args (plist-put args :key pop)))
   1175       (cond
   1176        ((or (stringp car)
   1177             (and (eq (car-safe car) 'lambda)
   1178                  (not (commandp car))))
   1179         (setq args (plist-put args :description pop)))
   1180        ((and (symbolp car)
   1181              (not (keywordp car))
   1182              (not (commandp car))
   1183              (commandp (cadr spec)))
   1184         (setq args (plist-put args :description (macroexp-quote pop)))))
   1185       (cond
   1186        ((memq car '(:info :info*)))
   1187        ((keywordp car)
   1188         (error "Need command, argument, `:info' or `:info*'; got `%s'" car))
   1189        ((symbolp car)
   1190         (setq args (plist-put args :command (macroexp-quote pop))))
   1191        ((and (commandp car)
   1192              (eq (car-safe car) 'lambda))
   1193         (let ((cmd pop)
   1194               (sym (intern
   1195                     (format
   1196                      "transient:%s:%s:%d" prefix
   1197                      (replace-regexp-in-string (plist-get args :key) " " "")
   1198                      (prog1 gensym-counter (cl-incf gensym-counter))))))
   1199           (setq args (plist-put
   1200                       args :command
   1201                       `(prog1 ',sym
   1202                          (put ',sym 'interactive-only t)
   1203                          (put ',sym 'completion-predicate #'transient--suffix-only)
   1204                          (defalias ',sym ,cmd))))))
   1205        ((or (stringp car)
   1206             (and car (listp car)))
   1207         (let ((arg pop)
   1208               (sym nil))
   1209           (cl-typecase arg
   1210             (list
   1211              (setq args (plist-put args :shortarg (car  arg)))
   1212              (setq args (plist-put args :argument (cadr arg)))
   1213              (setq arg  (cadr arg)))
   1214             (string
   1215              (when-let ((shortarg (transient--derive-shortarg arg)))
   1216                (setq args (plist-put args :shortarg shortarg)))
   1217              (setq args (plist-put args :argument arg))))
   1218           (setq sym (intern (format "transient:%s:%s" prefix arg)))
   1219           (setq args (plist-put
   1220                       args :command
   1221                       `(prog1 ',sym
   1222                          (put ',sym 'interactive-only t)
   1223                          (put ',sym 'completion-predicate #'transient--suffix-only)
   1224                          (defalias ',sym #'transient--default-infix-command))))
   1225           (cond ((and car (not (keywordp car)))
   1226                  (setq class 'transient-option)
   1227                  (setq args (plist-put args :reader (macroexp-quote pop))))
   1228                 ((not (string-suffix-p "=" arg))
   1229                  (setq class 'transient-switch))
   1230                 ((setq class 'transient-option)))))
   1231        ((error "Need command, argument, `:info' or `:info*'; got %s" car)))
   1232       (while (keywordp car)
   1233         (let ((key pop)
   1234               (val pop))
   1235           (cond ((eq key :class) (setq class val))
   1236                 ((eq key :level) (setq level val))
   1237                 ((eq key :info)
   1238                  (setq class 'transient-information)
   1239                  (setq args (plist-put args :description val)))
   1240                 ((eq key :info*)
   1241                  (setq class 'transient-information*)
   1242                  (setq args (plist-put args :description val)))
   1243                 ((eq (car-safe val) '\,)
   1244                  (setq args (plist-put args key (cadr val))))
   1245                 ((or (symbolp val)
   1246                      (and (listp val) (not (eq (car val) 'lambda))))
   1247                  (setq args (plist-put args key (macroexp-quote val))))
   1248                 ((setq args (plist-put args key val)))))))
   1249     (when-let* (((not (plist-get args :key)))
   1250                 (shortarg (plist-get args :shortarg)))
   1251       (setq args (plist-put args :key shortarg)))
   1252     (list 'list
   1253           (or level transient--default-child-level)
   1254           (macroexp-quote (or class 'transient-suffix))
   1255           (cons 'list args))))
   1256 
   1257 (defun transient--derive-shortarg (arg)
   1258   (save-match-data
   1259     (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
   1260          (match-string 1 arg))))
   1261 
   1262 (defun transient-command-completion-not-suffix-only-p (symbol _buffer)
   1263   "Say whether SYMBOL should be offered as a completion.
   1264 If the value of SYMBOL's `completion-predicate' property is
   1265 `transient--suffix-only', then return nil, otherwise return t.
   1266 This is the case when a command should only ever be used as a
   1267 suffix of a transient prefix command (as opposed to bindings
   1268 in regular keymaps or by using `execute-extended-command')."
   1269   (not (eq (get symbol 'completion-predicate) 'transient--suffix-only)))
   1270 
   1271 (defalias 'transient--suffix-only #'ignore
   1272   "Ignore ARGUMENTS, do nothing, and return nil.
   1273 Also see `transient-command-completion-not-suffix-only-p'.
   1274 Only use this alias as the value of the `completion-predicate'
   1275 symbol property.")
   1276 
   1277 (when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1
   1278            (not read-extended-command-predicate))
   1279   (setq read-extended-command-predicate
   1280         #'transient-command-completion-not-suffix-only-p))
   1281 
   1282 (defun transient-parse-suffix (prefix suffix)
   1283   "Parse SUFFIX, to be added to PREFIX.
   1284 PREFIX is a prefix command, a symbol.
   1285 SUFFIX is a suffix command or a group specification (of
   1286   the same forms as expected by `transient-define-prefix').
   1287 Intended for use in a group's `:setup-children' function."
   1288   (cl-assert (and prefix (symbolp prefix)))
   1289   (eval (car (transient--parse-child prefix suffix)) t))
   1290 
   1291 (defun transient-parse-suffixes (prefix suffixes)
   1292   "Parse SUFFIXES, to be added to PREFIX.
   1293 PREFIX is a prefix command, a symbol.
   1294 SUFFIXES is a list of suffix command or a group specification
   1295   (of the same forms as expected by `transient-define-prefix').
   1296 Intended for use in a group's `:setup-children' function."
   1297   (cl-assert (and prefix (symbolp prefix)))
   1298   (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
   1299 
   1300 ;;; Edit
   1301 
   1302 (defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
   1303   (let* ((suf (cl-etypecase suffix
   1304                 (vector (transient--parse-group  prefix suffix))
   1305                 (list   (transient--parse-suffix prefix suffix))
   1306                 (string suffix)))
   1307          (mem (transient--layout-member loc prefix))
   1308          (elt (car mem)))
   1309     (setq suf (eval suf t))
   1310     (cond
   1311      ((not mem)
   1312       (message "Cannot insert %S into %s; %s not found"
   1313                suffix prefix loc))
   1314      ((or (and (vectorp suffix) (not (vectorp elt)))
   1315           (and (listp   suffix) (vectorp elt))
   1316           (and (stringp suffix) (vectorp elt)))
   1317       (message "Cannot place %S into %s at %s; %s"
   1318                suffix prefix loc
   1319                "suffixes and groups cannot be siblings"))
   1320      (t
   1321       (when-let* ((bindingp (listp suf))
   1322                   (key (transient--spec-key suf))
   1323                   (conflict (car (transient--layout-member key prefix)))
   1324                   (conflictp
   1325                    (and (not (and (eq action 'replace)
   1326                                   (eq conflict elt)))
   1327                         (or (not keep-other)
   1328                             (eq (plist-get (nth 2 suf) :command)
   1329                                 (plist-get (nth 2 conflict) :command)))
   1330                         (equal (transient--suffix-predicate suf)
   1331                                (transient--suffix-predicate conflict)))))
   1332         (transient-remove-suffix prefix key))
   1333       (pcase-exhaustive action
   1334         ('insert  (setcdr mem (cons elt (cdr mem)))
   1335                   (setcar mem suf))
   1336         ('append  (setcdr mem (cons suf (cdr mem))))
   1337         ('replace (setcar mem suf)))))))
   1338 
   1339 ;;;###autoload
   1340 (defun transient-insert-suffix (prefix loc suffix &optional keep-other)
   1341   "Insert a SUFFIX into PREFIX before LOC.
   1342 PREFIX is a prefix command, a symbol.
   1343 SUFFIX is a suffix command or a group specification (of
   1344   the same forms as expected by `transient-define-prefix').
   1345 LOC is a command, a key vector, a key description (a string
   1346   as returned by `key-description'), or a coordination list
   1347   (whose last element may also be a command or key).
   1348 Remove a conflicting binding unless optional KEEP-OTHER is
   1349   non-nil.
   1350 See info node `(transient)Modifying Existing Transients'."
   1351   (declare (indent defun))
   1352   (transient--insert-suffix prefix loc suffix 'insert keep-other))
   1353 
   1354 ;;;###autoload
   1355 (defun transient-append-suffix (prefix loc suffix &optional keep-other)
   1356   "Insert a SUFFIX into PREFIX after LOC.
   1357 PREFIX is a prefix command, a symbol.
   1358 SUFFIX is a suffix command or a group specification (of
   1359   the same forms as expected by `transient-define-prefix').
   1360 LOC is a command, a key vector, a key description (a string
   1361   as returned by `key-description'), or a coordination list
   1362   (whose last element may also be a command or key).
   1363 Remove a conflicting binding unless optional KEEP-OTHER is
   1364   non-nil.
   1365 See info node `(transient)Modifying Existing Transients'."
   1366   (declare (indent defun))
   1367   (transient--insert-suffix prefix loc suffix 'append keep-other))
   1368 
   1369 ;;;###autoload
   1370 (defun transient-replace-suffix (prefix loc suffix)
   1371   "Replace the suffix at LOC in PREFIX with SUFFIX.
   1372 PREFIX is a prefix command, a symbol.
   1373 SUFFIX is a suffix command or a group specification (of
   1374   the same forms as expected by `transient-define-prefix').
   1375 LOC is a command, a key vector, a key description (a string
   1376   as returned by `key-description'), or a coordination list
   1377   (whose last element may also be a command or key).
   1378 See info node `(transient)Modifying Existing Transients'."
   1379   (declare (indent defun))
   1380   (transient--insert-suffix prefix loc suffix 'replace))
   1381 
   1382 ;;;###autoload
   1383 (defun transient-remove-suffix (prefix loc)
   1384   "Remove the suffix or group at LOC in PREFIX.
   1385 PREFIX is a prefix command, a symbol.
   1386 LOC is a command, a key vector, a key description (a string
   1387   as returned by `key-description'), or a coordination list
   1388   (whose last element may also be a command or key).
   1389 See info node `(transient)Modifying Existing Transients'."
   1390   (declare (indent defun))
   1391   (transient--layout-member loc prefix 'remove))
   1392 
   1393 (defun transient-get-suffix (prefix loc)
   1394   "Return the suffix or group at LOC in PREFIX.
   1395 PREFIX is a prefix command, a symbol.
   1396 LOC is a command, a key vector, a key description (a string
   1397   as returned by `key-description'), or a coordination list
   1398   (whose last element may also be a command or key).
   1399 See info node `(transient)Modifying Existing Transients'."
   1400   (if-let ((mem (transient--layout-member loc prefix)))
   1401       (car mem)
   1402     (error "%s not found in %s" loc prefix)))
   1403 
   1404 (defun transient-suffix-put (prefix loc prop value)
   1405   "Edit the suffix at LOC in PREFIX, setting PROP to VALUE.
   1406 PREFIX is a prefix command, a symbol.
   1407 SUFFIX is a suffix command or a group specification (of
   1408   the same forms as expected by `transient-define-prefix').
   1409 LOC is a command, a key vector, a key description (a string
   1410   as returned by `key-description'), or a coordination list
   1411   (whose last element may also be a command or key).
   1412 See info node `(transient)Modifying Existing Transients'."
   1413   (let ((suf (transient-get-suffix prefix loc)))
   1414     (setf (elt suf 2)
   1415           (plist-put (elt suf 2) prop value))))
   1416 
   1417 (defun transient--layout-member (loc prefix &optional remove)
   1418   (let ((val (or (get prefix 'transient--layout)
   1419                  (error "%s is not a transient command" prefix))))
   1420     (when (listp loc)
   1421       (while (integerp (car loc))
   1422         (let* ((children (if (vectorp val) (aref val 3) val))
   1423                (mem (transient--nthcdr (pop loc) children)))
   1424           (if (and remove (not loc))
   1425               (let ((rest (delq (car mem) children)))
   1426                 (if (vectorp val)
   1427                     (aset val 3 rest)
   1428                   (put prefix 'transient--layout rest))
   1429                 (setq val nil))
   1430             (setq val (if loc (car mem) mem)))))
   1431       (setq loc (car loc)))
   1432     (if loc
   1433         (transient--layout-member-1 (transient--kbd loc) val remove)
   1434       val)))
   1435 
   1436 (defun transient--layout-member-1 (loc layout remove)
   1437   (cond ((listp layout)
   1438          (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
   1439                    layout))
   1440         ((vectorp (car (aref layout 3)))
   1441          (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
   1442                    (aref layout 3)))
   1443         (remove
   1444          (aset layout 3
   1445                (delq (car (transient--group-member loc layout))
   1446                      (aref layout 3)))
   1447          nil)
   1448         ((transient--group-member loc layout))))
   1449 
   1450 (defun transient--group-member (loc group)
   1451   (cl-member-if (lambda (suffix)
   1452                   (and (listp suffix)
   1453                        (let* ((def (nth 2 suffix))
   1454                               (cmd (plist-get def :command)))
   1455                          (if (symbolp loc)
   1456                              (eq cmd loc)
   1457                            (equal (transient--kbd
   1458                                    (or (plist-get def :key)
   1459                                        (transient--command-key cmd)))
   1460                                   loc)))))
   1461                 (aref group 3)))
   1462 
   1463 (defun transient--kbd (keys)
   1464   (when (vectorp keys)
   1465     (setq keys (key-description keys)))
   1466   (when (stringp keys)
   1467     (setq keys (kbd keys)))
   1468   keys)
   1469 
   1470 (defun transient--spec-key (spec)
   1471   (let ((plist (nth 2 spec)))
   1472     (or (plist-get plist :key)
   1473         (transient--command-key
   1474          (plist-get plist :command)))))
   1475 
   1476 (defun transient--command-key (cmd)
   1477   (and-let* ((obj (transient--suffix-prototype cmd)))
   1478     (cond ((slot-boundp obj 'key)
   1479            (oref obj key))
   1480           ((slot-exists-p obj 'shortarg)
   1481            (if (slot-boundp obj 'shortarg)
   1482                (oref obj shortarg)
   1483              (transient--derive-shortarg (oref obj argument)))))))
   1484 
   1485 (defun transient--nthcdr (n list)
   1486   (nthcdr (if (< n 0) (- (length list) (abs n)) n) list))
   1487 
   1488 ;;; Variables
   1489 
   1490 (defvar transient-current-prefix nil
   1491   "The transient from which this suffix command was invoked.
   1492 This is an object representing that transient, use
   1493 `transient-current-command' to get the respective command.")
   1494 
   1495 (defvar transient-current-command nil
   1496   "The transient from which this suffix command was invoked.
   1497 This is a symbol representing that transient, use
   1498 `transient-current-prefix' to get the respective object.")
   1499 
   1500 (defvar transient-current-suffixes nil
   1501   "The suffixes of the transient from which this suffix command was invoked.
   1502 This is a list of objects.  Usually it is sufficient to instead
   1503 use the function `transient-args', which returns a list of
   1504 values.  In complex cases it might be necessary to use this
   1505 variable instead.")
   1506 
   1507 (defvar transient-exit-hook nil
   1508   "Hook run after exiting a transient.")
   1509 
   1510 (defvar transient-setup-buffer-hook nil
   1511   "Hook run when setting up the transient buffer.
   1512 That buffer is current and empty when this hook runs.")
   1513 
   1514 (defvar transient--prefix nil)
   1515 (defvar transient--layout nil)
   1516 (defvar transient--suffixes nil)
   1517 
   1518 (defconst transient--stay t   "Do not exit the transient.")
   1519 (defconst transient--exit nil "Do exit the transient.")
   1520 
   1521 (defvar transient--exitp nil "Whether to exit the transient.")
   1522 (defvar transient--showp nil "Whether to show the transient popup buffer.")
   1523 (defvar transient--helpp nil "Whether help-mode is active.")
   1524 (defvar transient--editp nil "Whether edit-mode is active.")
   1525 
   1526 (defvar transient--refreshp nil
   1527   "Whether to refresh the transient completely.")
   1528 
   1529 (defvar transient--all-levels-p nil
   1530   "Whether temporary display of suffixes on all levels is active.")
   1531 
   1532 (defvar transient--timer nil)
   1533 
   1534 (defvar transient--stack nil)
   1535 
   1536 (defvar transient--minibuffer-depth 0)
   1537 
   1538 (defvar transient--buffer-name " *transient*"
   1539   "Name of the transient buffer.")
   1540 
   1541 (defvar transient--buffer nil
   1542   "The transient menu buffer.")
   1543 
   1544 (defvar transient--window nil
   1545   "The window used to display the transient popup buffer.")
   1546 
   1547 (defvar transient--original-window nil
   1548   "The window that was selected before the transient was invoked.
   1549 Usually it remains selected while the transient is active.")
   1550 
   1551 (defvar transient--original-buffer nil
   1552   "The buffer that was current before the transient was invoked.
   1553 Usually it remains current while the transient is active.")
   1554 
   1555 (defvar transient--restore-winconf nil
   1556   "Window configuration to restore after exiting help.")
   1557 
   1558 (defvar transient--shadowed-buffer nil
   1559   "The buffer that is temporarily shadowed by the transient buffer.
   1560 This is bound while the suffix predicate is being evaluated and while
   1561 drawing in the transient buffer.")
   1562 
   1563 (defvar transient--pending-suffix nil
   1564   "The suffix that is currently being processed.
   1565 This is bound while the suffix predicate is being evaluated,
   1566 and while functions that return faces are being evaluated.")
   1567 
   1568 (defvar transient--pending-group nil
   1569   "The group that is currently being processed.
   1570 This is bound while the suffixes are drawn in the transient buffer.")
   1571 
   1572 (defvar transient--debug nil
   1573   "Whether to put debug information into *Messages*.")
   1574 
   1575 (defvar transient--history nil)
   1576 
   1577 (defvar transient--scroll-commands
   1578   '(transient-scroll-up
   1579     transient-scroll-down
   1580     mwheel-scroll
   1581     scroll-bar-toolkit-scroll))
   1582 
   1583 ;;; Identities
   1584 
   1585 (defun transient-active-prefix (&optional prefixes)
   1586   "Return the active transient object.
   1587 
   1588 Return nil if there is no active transient, if the transient buffer
   1589 isn't shown, and while the active transient is suspended (e.g., while
   1590 the minibuffer is in use).
   1591 
   1592 Unlike `transient-current-prefix', which is only ever non-nil in code
   1593 that is run directly by a command that is invoked while a transient
   1594 is current, this function is also suitable for use in asynchronous
   1595 code, such as timers and callbacks (this function's main use-case).
   1596 
   1597 If optional PREFIXES is non-nil, it must be a prefix command symbol
   1598 or a list of symbols, in which case the active transient object is
   1599 only returned if it matches one of PREFIXES."
   1600   (and transient--showp
   1601        transient--prefix
   1602        (or (not prefixes)
   1603            (memq (oref transient--prefix command) (ensure-list prefixes)))
   1604        (or (memq 'transient--pre-command pre-command-hook)
   1605            (and (memq t pre-command-hook)
   1606                 (memq 'transient--pre-command
   1607                       (default-value 'pre-command-hook))))
   1608        transient--prefix))
   1609 
   1610 (defun transient-prefix-object ()
   1611   "Return the current prefix as an object.
   1612 
   1613 While a transient is being setup or refreshed (which involves
   1614 preparing its suffixes) the variable `transient--prefix' can be
   1615 used to access the prefix object.  Thus this is what has to be
   1616 used in suffix methods such as `transient-format-description',
   1617 and in object-specific functions that are stored in suffix slots
   1618 such as `description'.
   1619 
   1620 When a suffix command is invoked (i.e., in its `interactive' form
   1621 and function body) then the variable `transient-current-prefix'
   1622 has to be used instead.
   1623 
   1624 Two distinct variables are needed, because any prefix may itself
   1625 be used as a suffix of another prefix, and such sub-prefixes have
   1626 to be able to tell themselves apart from the prefix they were
   1627 invoked from.
   1628 
   1629 Regular suffix commands, which are not prefixes, do not have to
   1630 concern themselves with this distinction, so they can use this
   1631 function instead.  In the context of a plain suffix, it always
   1632 returns the value of the appropriate variable."
   1633   (or transient--prefix transient-current-prefix))
   1634 
   1635 (defun transient-suffix-object (&optional command)
   1636   "Return the object associated with the current suffix command.
   1637 
   1638 Each suffix commands is associated with an object, which holds
   1639 additional information about the suffix, such as its value (in
   1640 the case of an infix command, which is a kind of suffix command).
   1641 
   1642 This function is intended to be called by infix commands, which
   1643 are usually aliases of `transient--default-infix-command', which
   1644 is defined like this:
   1645 
   1646   (defun transient--default-infix-command ()
   1647     (interactive)
   1648     (let ((obj (transient-suffix-object)))
   1649       (transient-infix-set obj (transient-infix-read obj)))
   1650     (transient--show))
   1651 
   1652 \(User input is read outside of `interactive' to prevent the
   1653 command from being added to `command-history'.  See #23.)
   1654 
   1655 Such commands need to be able to access their associated object
   1656 to guide how `transient-infix-read' reads the new value and to
   1657 store the read value.  Other suffix commands (including non-infix
   1658 commands) may also need the object to guide their behavior.
   1659 
   1660 This function attempts to return the object associated with the
   1661 current suffix command even if the suffix command was not invoked
   1662 from a transient.  (For some suffix command that is a valid thing
   1663 to do, for others it is not.)  In that case nil may be returned,
   1664 if the command was not defined using one of the macros intended
   1665 to define such commands.
   1666 
   1667 The optional argument COMMAND is intended for internal use.  If
   1668 you are contemplating using it in your own code, then you should
   1669 probably use this instead:
   1670 
   1671   (get COMMAND \\='transient--suffix)"
   1672   (when command
   1673     (cl-check-type command command))
   1674   (cond
   1675    (transient--pending-suffix)
   1676    ((or transient--prefix
   1677         transient-current-prefix)
   1678     (let ((suffixes
   1679            (cl-remove-if-not
   1680             (lambda (obj)
   1681               (eq (oref obj command)
   1682                   (or command
   1683                       (if (eq this-command 'transient-set-level)
   1684                           ;; This is how it can look up for which
   1685                           ;; command it is setting the level.
   1686                           this-original-command
   1687                         this-command))))
   1688             (or transient--suffixes
   1689                 transient-current-suffixes))))
   1690       (or (and (cdr suffixes)
   1691                (cl-find-if
   1692                 (lambda (obj)
   1693                   (equal (listify-key-sequence (transient--kbd (oref obj key)))
   1694                          (listify-key-sequence (this-command-keys))))
   1695                 suffixes))
   1696           (car suffixes))))
   1697    ((and-let* ((obj (transient--suffix-prototype (or command this-command)))
   1698                (obj (clone obj)))
   1699       (progn ; work around debbugs#31840
   1700         (transient-init-scope obj)
   1701         (transient-init-value obj)
   1702         obj)))))
   1703 
   1704 (defun transient--suffix-prototype (command)
   1705   (or (get command 'transient--suffix)
   1706       (seq-some (lambda (cmd) (get cmd 'transient--suffix))
   1707                 (function-alias-p command))))
   1708 
   1709 ;;; Keymaps
   1710 
   1711 (defvar-keymap transient-base-map
   1712   :doc "Parent of other keymaps used by Transient.
   1713 
   1714 This is the parent keymap of all the keymaps that are used in
   1715 all transients: `transient-map' (which in turn is the parent
   1716 of the transient-specific keymaps), `transient-edit-map' and
   1717 `transient-sticky-map'.
   1718 
   1719 If you change a binding here, then you might also have to edit
   1720 `transient-sticky-map' and `transient-common-commands'.  While
   1721 the latter isn't a proper transient prefix command, it can be
   1722 edited using the same functions as used for transients.
   1723 
   1724 If you add a new command here, then you must also add a binding
   1725 to `transient-predicate-map'."
   1726   "ESC ESC ESC" #'transient-quit-all
   1727   "C-g"     #'transient-quit-one
   1728   "C-q"     #'transient-quit-all
   1729   "C-z"     #'transient-suspend
   1730   "C-v"     #'transient-scroll-up
   1731   "C-M-v"   #'transient-scroll-down
   1732   "<next>"  #'transient-scroll-up
   1733   "<prior>" #'transient-scroll-down)
   1734 
   1735 (defvar transient-map
   1736   (let ((map (make-sparse-keymap)))
   1737     (set-keymap-parent map transient-base-map)
   1738     (keymap-set map "C-u"   #'universal-argument)
   1739     (keymap-set map "C--"   #'negative-argument)
   1740     (keymap-set map "C-t"   #'transient-show)
   1741     (keymap-set map "?"     #'transient-help)
   1742     (keymap-set map "C-h"   #'transient-help)
   1743     ;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
   1744     (keymap-set map "C-M-p" #'transient-history-prev)
   1745     (keymap-set map "C-M-n" #'transient-history-next)
   1746     (when (fboundp 'other-frame-prefix) ;Emacs >= 28.1
   1747       (keymap-set map "C-x 5 5" 'other-frame-prefix)
   1748       (keymap-set map "C-x 4 4" 'other-window-prefix))
   1749     map)
   1750   "Top-level keymap used by all transients.
   1751 
   1752 If you add a new command here, then you must also add a binding
   1753 to `transient-predicate-map'.  Also see `transient-base-map'.")
   1754 
   1755 (defvar-keymap transient-edit-map
   1756   :doc "Keymap that is active while a transient in is in \"edit mode\"."
   1757   :parent transient-base-map
   1758   "?"     #'transient-help
   1759   "C-h"   #'transient-help
   1760   "C-x l" #'transient-set-level)
   1761 
   1762 (defvar-keymap transient-sticky-map
   1763   :doc "Keymap that is active while an incomplete key sequence is active."
   1764   :parent transient-base-map
   1765   "C-g" #'transient-quit-seq)
   1766 
   1767 (defvar transient--common-command-prefixes '(?\C-x))
   1768 
   1769 (put 'transient-common-commands
   1770      'transient--layout
   1771      (list
   1772       (eval
   1773        (car (transient--parse-child
   1774              'transient-common-commands
   1775              (vector
   1776               :hide
   1777               (lambda ()
   1778                 (and (not (memq
   1779                            (car (bound-and-true-p transient--redisplay-key))
   1780                            transient--common-command-prefixes))
   1781                      (not transient-show-common-commands)))
   1782               (vector
   1783                "Value commands"
   1784                (list "C-x s  " "Set"            #'transient-set)
   1785                (list "C-x C-s" "Save"           #'transient-save)
   1786                (list "C-x C-k" "Reset"          #'transient-reset)
   1787                (list "C-x p  " "Previous value" #'transient-history-prev)
   1788                (list "C-x n  " "Next value"     #'transient-history-next))
   1789               (vector
   1790                "Sticky commands"
   1791                ;; Like `transient-sticky-map' except that
   1792                ;; "C-g" has to be bound to a different command.
   1793                (list "C-g" "Quit prefix or transient" #'transient-quit-one)
   1794                (list "C-q" "Quit transient stack"     #'transient-quit-all)
   1795                (list "C-z" "Suspend transient stack"  #'transient-suspend))
   1796               (vector
   1797                "Customize"
   1798                (list "C-x t" 'transient-toggle-common :description
   1799                      (lambda ()
   1800                        (if transient-show-common-commands
   1801                            "Hide common commands"
   1802                          "Show common permanently")))
   1803                (list "C-x l" "Show/hide suffixes" #'transient-set-level)
   1804                (list "C-x a" #'transient-toggle-level-limit)))))
   1805        t)))
   1806 
   1807 (defvar-keymap transient-popup-navigation-map
   1808   :doc "One of the keymaps used when popup navigation is enabled.
   1809 See `transient-enable-popup-navigation'."
   1810   "<down-mouse-1>" #'transient-noop
   1811   "<up>"   #'transient-backward-button
   1812   "<down>" #'transient-forward-button
   1813   "C-r"    #'transient-isearch-backward
   1814   "C-s"    #'transient-isearch-forward
   1815   "M-RET"  #'transient-push-button)
   1816 
   1817 (defvar-keymap transient-button-map
   1818   :doc "One of the keymaps used when popup navigation is enabled.
   1819 See `transient-enable-popup-navigation'."
   1820   "<mouse-1>" #'transient-push-button
   1821   "<mouse-2>" #'transient-push-button)
   1822 
   1823 (defvar-keymap transient-resume-mode-map
   1824   :doc "Keymap for `transient-resume-mode'.
   1825 
   1826 This keymap remaps every command that would usually just quit the
   1827 documentation buffer to `transient-resume', which additionally
   1828 resumes the suspended transient."
   1829   "<remap> <Man-quit>"    #'transient-resume
   1830   "<remap> <Info-exit>"   #'transient-resume
   1831   "<remap> <quit-window>" #'transient-resume)
   1832 
   1833 (defvar-keymap transient-predicate-map
   1834   :doc "Base keymap used to map common commands to their transient behavior.
   1835 
   1836 The \"transient behavior\" of a command controls, among other
   1837 things, whether invoking the command causes the transient to be
   1838 exited or not, and whether infix arguments are exported before
   1839 doing so.
   1840 
   1841 Each \"key\" is a command that is common to all transients and
   1842 that is bound in `transient-map', `transient-edit-map',
   1843 `transient-sticky-map' and/or `transient-common-command'.
   1844 
   1845 Each binding is a \"pre-command\", a function that controls the
   1846 transient behavior of the respective command.
   1847 
   1848 For transient commands that are bound in individual transients,
   1849 the transient behavior is specified using the `:transient' slot
   1850 of the corresponding object."
   1851   "<transient-suspend>"           #'transient--do-suspend
   1852   "<transient-help>"              #'transient--do-stay
   1853   "<transient-set-level>"         #'transient--do-stay
   1854   "<transient-history-prev>"      #'transient--do-stay
   1855   "<transient-history-next>"      #'transient--do-stay
   1856   "<universal-argument>"          #'transient--do-stay
   1857   "<universal-argument-more>"     #'transient--do-stay
   1858   "<negative-argument>"           #'transient--do-minus
   1859   "<digit-argument>"              #'transient--do-stay
   1860   "<other-frame-prefix>"          #'transient--do-stay
   1861   "<other-window-prefix>"         #'transient--do-stay
   1862   "<top-level>"                   #'transient--do-quit-all
   1863   "<transient-quit-all>"          #'transient--do-quit-all
   1864   "<transient-quit-one>"          #'transient--do-quit-one
   1865   "<transient-quit-seq>"          #'transient--do-stay
   1866   "<transient-show>"              #'transient--do-stay
   1867   "<transient-update>"            #'transient--do-stay
   1868   "<transient-toggle-common>"     #'transient--do-stay
   1869   "<transient-set>"               #'transient--do-call
   1870   "<transient-set-and-exit>"      #'transient--do-exit
   1871   "<transient-save>"              #'transient--do-call
   1872   "<transient-save-and-exit>"     #'transient--do-exit
   1873   "<transient-reset>"             #'transient--do-call
   1874   "<describe-key-briefly>"        #'transient--do-stay
   1875   "<describe-key>"                #'transient--do-stay
   1876   "<transient-scroll-up>"         #'transient--do-stay
   1877   "<transient-scroll-down>"       #'transient--do-stay
   1878   "<mwheel-scroll>"               #'transient--do-stay
   1879   "<scroll-bar-toolkit-scroll>"   #'transient--do-stay
   1880   "<transient-noop>"              #'transient--do-noop
   1881   "<transient-mouse-push-button>" #'transient--do-move
   1882   "<transient-push-button>"       #'transient--do-push-button
   1883   "<transient-backward-button>"   #'transient--do-move
   1884   "<transient-forward-button>"    #'transient--do-move
   1885   "<transient-isearch-backward>"  #'transient--do-move
   1886   "<transient-isearch-forward>"   #'transient--do-move
   1887   ;; If a valid but incomplete prefix sequence is followed by
   1888   ;; an unbound key, then Emacs calls the `undefined' command
   1889   ;; but does not set `this-command', `this-original-command'
   1890   ;; or `real-this-command' accordingly.  Instead they are nil.
   1891   "<nil>"                         #'transient--do-warn
   1892   ;; Bound to the `mouse-movement' event, this command is similar
   1893   ;; to `ignore'.
   1894   "<ignore-preserving-kill-region>" #'transient--do-noop)
   1895 
   1896 (defvar transient--transient-map nil)
   1897 (defvar transient--predicate-map nil)
   1898 (defvar transient--redisplay-map nil)
   1899 (defvar transient--redisplay-key nil)
   1900 
   1901 (defun transient--push-keymap (var)
   1902   (let ((map (symbol-value var)))
   1903     (transient--debug "     push %s%s" var (if map "" " VOID"))
   1904     (when map
   1905       (with-demoted-errors "transient--push-keymap: %S"
   1906         (internal-push-keymap map 'overriding-terminal-local-map)))))
   1907 
   1908 (defun transient--pop-keymap (var)
   1909   (let ((map (symbol-value var)))
   1910     (when map
   1911       (transient--debug "     pop  %s" var)
   1912       (with-demoted-errors "transient--pop-keymap: %S"
   1913         (internal-pop-keymap map 'overriding-terminal-local-map)))))
   1914 
   1915 (defun transient--make-transient-map ()
   1916   (let ((map (make-sparse-keymap)))
   1917     (set-keymap-parent map (if transient--editp
   1918                                transient-edit-map
   1919                              transient-map))
   1920     (dolist (obj transient--suffixes)
   1921       (let ((key (oref obj key)))
   1922         (when (vectorp key)
   1923           (setq key (key-description key))
   1924           (oset obj key key))
   1925         (when transient-substitute-key-function
   1926           (setq key (save-match-data
   1927                       (funcall transient-substitute-key-function obj)))
   1928           (oset obj key key))
   1929         (let* ((kbd (kbd key))
   1930                (cmd (oref obj command))
   1931                (alt (transient--lookup-key map kbd)))
   1932           (cond ((not alt)
   1933                  (define-key map kbd cmd))
   1934                 ((eq alt cmd))
   1935                 ((transient--inapt-suffix-p obj))
   1936                 ((and-let* ((obj (transient-suffix-object alt)))
   1937                    (transient--inapt-suffix-p obj))
   1938                  (define-key map kbd cmd))
   1939                 (transient-detect-key-conflicts
   1940                  (error "Cannot bind %S to %s and also %s"
   1941                         (string-trim key) cmd alt))
   1942                 ((define-key map kbd cmd))))))
   1943     (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b))
   1944     (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b))
   1945     (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b))
   1946     (when transient-enable-popup-navigation
   1947       ;; `transient--make-redisplay-map' maps only over bindings that are
   1948       ;; directly in the base keymap, so that cannot be a composed keymap.
   1949       (set-keymap-parent
   1950        map (make-composed-keymap
   1951             (keymap-parent map)
   1952             transient-popup-navigation-map)))
   1953     map))
   1954 
   1955 (defun transient--make-predicate-map ()
   1956   (let* ((default (transient--resolve-pre-command
   1957                    (oref transient--prefix transient-suffix)))
   1958          (return (and transient--stack (eq default t)))
   1959          (map (make-sparse-keymap)))
   1960     (set-keymap-parent map transient-predicate-map)
   1961     (when (or (and (slot-boundp transient--prefix 'transient-switch-frame)
   1962                    (transient--resolve-pre-command
   1963                     (not (oref transient--prefix transient-switch-frame))))
   1964               (memq (transient--resolve-pre-command
   1965                      (oref transient--prefix transient-non-suffix))
   1966                     '(nil transient--do-warn transient--do-noop)))
   1967       (define-key map [handle-switch-frame] #'transient--do-suspend))
   1968     (dolist (obj transient--suffixes)
   1969       (let* ((cmd (oref obj command))
   1970              (kind (cond ((get cmd 'transient--prefix)    'prefix)
   1971                          ((cl-typep obj 'transient-infix) 'infix)
   1972                          (t                               'suffix))))
   1973         (cond
   1974          ((oref obj inapt)
   1975           (define-key map (vector cmd) #'transient--do-warn-inapt))
   1976          ((slot-boundp obj 'transient)
   1977           (define-key map (vector cmd)
   1978             (pcase (list kind
   1979                          (transient--resolve-pre-command (oref obj transient))
   1980                          return)
   1981               (`(prefix   t ,_) #'transient--do-recurse)
   1982               (`(prefix nil ,_) #'transient--do-stack)
   1983               (`(infix    t ,_) #'transient--do-stay)
   1984               (`(suffix   t ,_) #'transient--do-call)
   1985               ('(suffix nil  t) #'transient--do-return)
   1986               (`(,_     nil ,_) #'transient--do-exit)
   1987               (`(,_     ,do ,_) do))))
   1988          ((not (lookup-key transient-predicate-map (vector cmd)))
   1989           (define-key map (vector cmd)
   1990             (pcase (list kind default return)
   1991               (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_)
   1992                #'transient--do-recurse)
   1993               (`(prefix   t ,_) #'transient--do-recurse)
   1994               (`(prefix  ,_ ,_) #'transient--do-stack)
   1995               (`(infix   ,_ ,_) #'transient--do-stay)
   1996               (`(suffix   t ,_) #'transient--do-call)
   1997               ('(suffix nil  t) #'transient--do-return)
   1998               (`(suffix nil ,_) #'transient--do-exit)
   1999               (`(suffix ,do ,_) do)))))))
   2000     map))
   2001 
   2002 (defun transient--make-redisplay-map ()
   2003   (setq transient--redisplay-key
   2004         (pcase this-command
   2005           ('transient-update
   2006            (setq transient--showp t)
   2007            (setq unread-command-events
   2008                  (listify-key-sequence (this-single-command-raw-keys))))
   2009           ('transient-quit-seq
   2010            (setq unread-command-events
   2011                  (butlast (listify-key-sequence
   2012                            (this-single-command-raw-keys))
   2013                           2))
   2014            (butlast transient--redisplay-key))
   2015           (_ nil)))
   2016   (let ((topmap (make-sparse-keymap))
   2017         (submap (make-sparse-keymap)))
   2018     (when transient--redisplay-key
   2019       (define-key topmap (vconcat transient--redisplay-key) submap)
   2020       (set-keymap-parent submap transient-sticky-map))
   2021     (map-keymap-internal
   2022      (lambda (key def)
   2023        (when (and (not (eq key ?\e))
   2024                   (listp def)
   2025                   (keymapp def))
   2026          (define-key topmap (vconcat transient--redisplay-key (list key))
   2027            #'transient-update)))
   2028      (if transient--redisplay-key
   2029          (let ((key (vconcat transient--redisplay-key)))
   2030            (or (lookup-key transient--transient-map key)
   2031                (and-let* ((regular (lookup-key local-function-key-map key)))
   2032                  (lookup-key transient--transient-map (vconcat regular)))))
   2033        transient--transient-map))
   2034     topmap))
   2035 
   2036 ;;; Setup
   2037 
   2038 (defun transient-setup (&optional name layout edit &rest params)
   2039   "Setup the transient specified by NAME.
   2040 
   2041 This function is called by transient prefix commands to setup the
   2042 transient.  In that case NAME is mandatory, LAYOUT and EDIT must
   2043 be nil and PARAMS may be (but usually is not) used to set, e.g.,
   2044 the \"scope\" of the transient (see `transient-define-prefix').
   2045 
   2046 This function is also called internally, in which case LAYOUT and
   2047 EDIT may be non-nil."
   2048   (transient--debug 'setup)
   2049   (transient--with-emergency-exit :setup
   2050     (cond
   2051      ((not name)
   2052       ;; Switching between regular and edit mode.
   2053       (transient--pop-keymap 'transient--transient-map)
   2054       (transient--pop-keymap 'transient--redisplay-map)
   2055       (setq name (oref transient--prefix command))
   2056       (setq params (list :scope (oref transient--prefix scope))))
   2057      (transient--prefix
   2058       ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}"
   2059       ;; of an outer prefix.  Unlike the usual `transient--do-stack',
   2060       ;; these predicates fail to clean up after the outer prefix.
   2061       (transient--pop-keymap 'transient--transient-map)
   2062       (transient--pop-keymap 'transient--redisplay-map))
   2063      ((not (or layout                      ; resuming parent/suspended prefix
   2064                transient-current-command)) ; entering child prefix
   2065       (transient--stack-zap))              ; replace suspended prefix, if any
   2066      (edit
   2067       ;; Returning from help to edit.
   2068       (setq transient--editp t)))
   2069     (transient--init-objects name layout params)
   2070     (transient--init-keymaps)
   2071     (transient--history-init transient--prefix)
   2072     (setq transient--original-window (selected-window))
   2073     (setq transient--original-buffer (current-buffer))
   2074     (setq transient--minibuffer-depth (minibuffer-depth))
   2075     (transient--redisplay)
   2076     (transient--init-transient)
   2077     (transient--suspend-which-key-mode)))
   2078 
   2079 (cl-defgeneric transient-setup-children (group children)
   2080   "Setup the CHILDREN of GROUP.
   2081 If the value of the `setup-children' slot is non-nil, then call
   2082 that function with CHILDREN as the only argument and return the
   2083 value.  Otherwise return CHILDREN as is."
   2084   (if (slot-boundp group 'setup-children)
   2085       (funcall (oref group setup-children) children)
   2086     children))
   2087 
   2088 (defun transient--init-keymaps ()
   2089   (setq transient--predicate-map (transient--make-predicate-map))
   2090   (setq transient--transient-map (transient--make-transient-map))
   2091   (setq transient--redisplay-map (transient--make-redisplay-map)))
   2092 
   2093 (defun transient--init-objects (&optional name layout params)
   2094   (if name
   2095       (setq transient--prefix (transient--init-prefix name params))
   2096     (setq name (oref transient--prefix command)))
   2097   (setq transient--refreshp (oref transient--prefix refresh-suffixes))
   2098   (setq transient--layout (or layout (transient--init-suffixes name)))
   2099   (setq transient--suffixes (transient--flatten-suffixes transient--layout)))
   2100 
   2101 (defun transient--init-prefix (name &optional params)
   2102   (let ((obj (let ((proto (get name 'transient--prefix)))
   2103                (apply #'clone proto
   2104                       :prototype proto
   2105                       :level (or (alist-get t (alist-get name transient-levels))
   2106                                  transient-default-level)
   2107                       params))))
   2108     (transient--setup-recursion obj)
   2109     (transient-init-value obj)
   2110     obj))
   2111 
   2112 (defun transient--init-suffixes (name)
   2113   (let ((levels (alist-get name transient-levels)))
   2114     (cl-mapcan (lambda (c) (transient--init-child levels c nil))
   2115                (append (get name 'transient--layout)
   2116                        (and (not transient--editp)
   2117                             (get 'transient-common-commands
   2118                                  'transient--layout))))))
   2119 
   2120 (defun transient--flatten-suffixes (layout)
   2121   (cl-labels ((s (def)
   2122                 (cond
   2123                  ((stringp def) nil)
   2124                  ((cl-typep def 'transient-information) nil)
   2125                  ((listp def) (cl-mapcan #'s def))
   2126                  ((cl-typep def 'transient-group)
   2127                   (cl-mapcan #'s (oref def suffixes)))
   2128                  ((cl-typep def 'transient-suffix)
   2129                   (list def)))))
   2130     (cl-mapcan #'s layout)))
   2131 
   2132 (defun transient--init-child (levels spec parent)
   2133   (cl-etypecase spec
   2134     (vector  (transient--init-group  levels spec parent))
   2135     (list    (transient--init-suffix levels spec parent))
   2136     (string  (list spec))))
   2137 
   2138 (defun transient--init-group (levels spec parent)
   2139   (pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
   2140     (and-let* (((transient--use-level-p level))
   2141                (obj (apply class :level level args))
   2142                ((transient--use-suffix-p obj))
   2143                ((prog1 t
   2144                   (when (or (and parent (oref parent inapt))
   2145                             (transient--inapt-suffix-p obj))
   2146                     (oset obj inapt t))))
   2147                (suffixes (cl-mapcan
   2148                           (lambda (c) (transient--init-child levels c obj))
   2149                           (transient-setup-children obj children))))
   2150       (progn ; work around debbugs#31840
   2151         (oset obj suffixes suffixes)
   2152         (list obj)))))
   2153 
   2154 (defun transient--init-suffix (levels spec parent)
   2155   (pcase-let* ((`(,level ,class ,args) spec)
   2156                (cmd (plist-get args :command))
   2157                (key (transient--kbd (plist-get args :key)))
   2158                (level (or (alist-get (cons cmd key) levels nil nil #'equal)
   2159                           (alist-get cmd levels)
   2160                           level)))
   2161     (let ((fn (and (symbolp cmd)
   2162                    (symbol-function cmd))))
   2163       (when (autoloadp fn)
   2164         (transient--debug "   autoload %s" cmd)
   2165         (autoload-do-load fn)))
   2166     (when (transient--use-level-p level)
   2167       (let ((obj (if (child-of-class-p class 'transient-information)
   2168                      (apply class :level level args)
   2169                    (unless (and cmd (symbolp cmd))
   2170                      (error "BUG: Non-symbolic suffix command: %s" cmd))
   2171                    (if-let ((proto (and cmd (transient--suffix-prototype cmd))))
   2172                        (apply #'clone proto :level level args)
   2173                      (apply class :command cmd :level level args)))))
   2174         (cond ((not cmd))
   2175               ((commandp cmd))
   2176               ((or (cl-typep obj 'transient-switch)
   2177                    (cl-typep obj 'transient-option))
   2178                ;; As a temporary special case, if the package was compiled
   2179                ;; with an older version of Transient, then we must define
   2180                ;; "anonymous" switch and option commands here.
   2181                (defalias cmd #'transient--default-infix-command))
   2182               ((transient--use-suffix-p obj)
   2183                (error "Suffix command %s is not defined or autoloaded" cmd)))
   2184         (unless (cl-typep obj 'transient-information)
   2185           (transient--init-suffix-key obj))
   2186         (when (transient--use-suffix-p obj)
   2187           (if (or (and parent (oref parent inapt))
   2188                   (transient--inapt-suffix-p obj))
   2189               (oset obj inapt t)
   2190             (transient-init-scope obj)
   2191             (transient-init-value obj))
   2192           (list obj))))))
   2193 
   2194 (cl-defmethod transient--init-suffix-key ((obj transient-suffix))
   2195   (unless (slot-boundp obj 'key)
   2196     (error "No key for %s" (oref obj command))))
   2197 
   2198 (cl-defmethod transient--init-suffix-key ((obj transient-argument))
   2199   (if (transient-switches--eieio-childp obj)
   2200       (cl-call-next-method obj)
   2201     (when-let* (((not (slot-boundp obj 'shortarg)))
   2202                 (shortarg (transient--derive-shortarg (oref obj argument))))
   2203       (oset obj shortarg shortarg))
   2204     (unless (slot-boundp obj 'key)
   2205       (if (slot-boundp obj 'shortarg)
   2206           (oset obj key (oref obj shortarg))
   2207         (error "No key for %s" (oref obj command))))))
   2208 
   2209 (defun transient--use-level-p (level &optional edit)
   2210   (or transient--all-levels-p
   2211       (and transient--editp (not edit))
   2212       (and (>= level 1)
   2213            (<= level (oref transient--prefix level)))))
   2214 
   2215 (defun transient--use-suffix-p (obj)
   2216   (let ((transient--shadowed-buffer (current-buffer))
   2217         (transient--pending-suffix obj))
   2218     (transient--do-suffix-p
   2219      (oref obj if)
   2220      (oref obj if-not)
   2221      (oref obj if-nil)
   2222      (oref obj if-non-nil)
   2223      (oref obj if-mode)
   2224      (oref obj if-not-mode)
   2225      (oref obj if-derived)
   2226      (oref obj if-not-derived)
   2227      t)))
   2228 
   2229 (defun transient--inapt-suffix-p (obj)
   2230   (let ((transient--shadowed-buffer (current-buffer))
   2231         (transient--pending-suffix obj))
   2232     (transient--do-suffix-p
   2233      (oref obj inapt-if)
   2234      (oref obj inapt-if-not)
   2235      (oref obj inapt-if-nil)
   2236      (oref obj inapt-if-non-nil)
   2237      (oref obj inapt-if-mode)
   2238      (oref obj inapt-if-not-mode)
   2239      (oref obj inapt-if-derived)
   2240      (oref obj inapt-if-not-derived)
   2241      nil)))
   2242 
   2243 (defun transient--do-suffix-p
   2244     (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived
   2245         default)
   2246   (cond
   2247    (if                  (funcall if))
   2248    (if-not         (not (funcall if-not)))
   2249    (if-non-nil          (symbol-value if-non-nil))
   2250    (if-nil         (not (symbol-value if-nil)))
   2251    (if-mode             (if (atom if-mode)
   2252                             (eq major-mode if-mode)
   2253                           (memq major-mode if-mode)))
   2254    (if-not-mode    (not (if (atom if-not-mode)
   2255                             (eq major-mode if-not-mode)
   2256                           (memq major-mode if-not-mode))))
   2257    (if-derived          (if (or (atom if-derived)
   2258                                 (>= emacs-major-version 30))
   2259                             (derived-mode-p if-derived)
   2260                           (apply #'derived-mode-p if-derived)))
   2261    (if-not-derived (not (if (or (atom if-not-derived)
   2262                                 (>= emacs-major-version 30))
   2263                             (derived-mode-p if-not-derived)
   2264                           (apply #'derived-mode-p if-not-derived))))
   2265    (default)))
   2266 
   2267 (defun transient--suffix-predicate (spec)
   2268   (let ((plist (nth 2 spec)))
   2269     (seq-some (lambda (prop)
   2270                 (and-let* ((pred (plist-get plist prop)))
   2271                   (list prop pred)))
   2272               '( :if :if-not
   2273                  :if-nil :if-non-nil
   2274                  :if-mode :if-not-mode
   2275                  :if-derived :if-not-derived
   2276                  :inapt-if :inapt-if-not
   2277                  :inapt-if-nil :inapt-if-non-nil
   2278                  :inapt-if-mode :inapt-if-not-mode
   2279                  :inapt-if-derived :inapt-if-not-derived))))
   2280 
   2281 ;;; Flow-Control
   2282 
   2283 (defun transient--init-transient ()
   2284   (transient--debug 'init-transient)
   2285   (transient--push-keymap 'transient--transient-map)
   2286   (transient--push-keymap 'transient--redisplay-map)
   2287   (add-hook 'pre-command-hook  #'transient--pre-command)
   2288   (add-hook 'post-command-hook #'transient--post-command)
   2289   (advice-add 'recursive-edit :around #'transient--recursive-edit)
   2290   (when transient--exitp
   2291     ;; This prefix command was invoked as the suffix of another.
   2292     ;; Prevent `transient--post-command' from removing the hooks
   2293     ;; that we just added.
   2294     (setq transient--exitp 'replace)))
   2295 
   2296 (defun transient--refresh-transient ()
   2297   (transient--debug 'refresh-transient)
   2298   (transient--pop-keymap 'transient--predicate-map)
   2299   (transient--pop-keymap 'transient--transient-map)
   2300   (transient--pop-keymap 'transient--redisplay-map)
   2301   (if (eq transient--refreshp 'updated-value)
   2302       ;; Preserve the prefix value this once, because the
   2303       ;; invoked suffix indicates that it has updated that.
   2304       (setq transient--refreshp (oref transient--prefix refresh-suffixes))
   2305     ;; Otherwise update the prefix value from suffix values.
   2306     (oset transient--prefix value (transient-get-value)))
   2307   (transient--init-objects)
   2308   (transient--init-keymaps)
   2309   (transient--push-keymap 'transient--transient-map)
   2310   (transient--push-keymap 'transient--redisplay-map)
   2311   (transient--redisplay))
   2312 
   2313 (defun transient--pre-command ()
   2314   (transient--debug 'pre-command)
   2315   (transient--with-emergency-exit :pre-command
   2316     ;; The use of `overriding-terminal-local-map' does not prevent the
   2317     ;; lookup of command remappings in the overridden maps, which can
   2318     ;; lead to a suffix being remapped to a non-suffix.  We have to undo
   2319     ;; the remapping in that case.  However, remapping a non-suffix to
   2320     ;; another should remain possible.
   2321     (when (and (transient--get-pre-command this-original-command 'suffix)
   2322                (not (transient--get-pre-command this-command 'suffix)))
   2323       (setq this-command this-original-command))
   2324     (cond
   2325      ((memq this-command '(transient-update transient-quit-seq))
   2326       (transient--pop-keymap 'transient--redisplay-map))
   2327      ((and transient--helpp
   2328            (not (memq this-command '(transient-quit-one
   2329                                      transient-quit-all))))
   2330       (cond
   2331        ((transient-help)
   2332         (transient--do-suspend)
   2333         (setq this-command 'transient-suspend)
   2334         (transient--pre-exit))
   2335        ((not (transient--edebug-command-p))
   2336         (setq this-command 'transient-undefined))))
   2337      ((and transient--editp
   2338            (transient-suffix-object)
   2339            (not (memq this-command '(transient-quit-one
   2340                                      transient-quit-all
   2341                                      transient-help))))
   2342       (setq this-command 'transient-set-level)
   2343       (transient--wrap-command))
   2344      (t
   2345       (setq transient--exitp nil)
   2346       (let ((exitp (eq (transient--call-pre-command) transient--exit)))
   2347         (transient--wrap-command)
   2348         (when exitp
   2349           (transient--pre-exit)))))))
   2350 
   2351 (defun transient--pre-exit ()
   2352   (transient--debug 'pre-exit)
   2353   (transient--delete-window)
   2354   (transient--timer-cancel)
   2355   (transient--pop-keymap 'transient--transient-map)
   2356   (transient--pop-keymap 'transient--redisplay-map)
   2357   (unless transient--showp
   2358     (let ((message-log-max nil))
   2359       (message "")))
   2360   (setq transient--transient-map nil)
   2361   (setq transient--predicate-map nil)
   2362   (setq transient--redisplay-map nil)
   2363   (setq transient--redisplay-key nil)
   2364   (setq transient--helpp nil)
   2365   (setq transient--editp nil)
   2366   (setq transient--prefix nil)
   2367   (setq transient--layout nil)
   2368   (setq transient--suffixes nil)
   2369   (setq transient--original-window nil)
   2370   (setq transient--original-buffer nil)
   2371   (setq transient--window nil))
   2372 
   2373 (defun transient--delete-window ()
   2374   (when (window-live-p transient--window)
   2375     (let ((win transient--window)
   2376           (remain-in-minibuffer-window
   2377            (and (minibuffer-selected-window)
   2378                 (selected-window))))
   2379       (cond
   2380        ((eq (car (window-parameter win 'quit-restore)) 'other)
   2381         ;; Window used to display another buffer.
   2382         (set-window-parameter win 'no-other-window
   2383                               (window-parameter win 'prev--no-other-window))
   2384         (set-window-parameter win 'prev--no-other-window nil))
   2385        ((with-demoted-errors "Error while exiting transient: %S"
   2386           (delete-window win))))
   2387       (when (buffer-live-p transient--buffer)
   2388         (kill-buffer transient--buffer))
   2389       (setq transient--buffer nil)
   2390       (when remain-in-minibuffer-window
   2391         (select-window remain-in-minibuffer-window)))))
   2392 
   2393 (defun transient--export ()
   2394   (setq transient-current-prefix transient--prefix)
   2395   (setq transient-current-command (oref transient--prefix command))
   2396   (setq transient-current-suffixes transient--suffixes)
   2397   (transient--history-push transient--prefix))
   2398 
   2399 (defun transient--suspend-override (&optional nohide)
   2400   (transient--debug 'suspend-override)
   2401   (transient--timer-cancel)
   2402   (cond ((and (not nohide) transient-hide-during-minibuffer-read)
   2403          (transient--delete-window))
   2404         ((and transient--prefix transient--redisplay-key)
   2405          (setq transient--redisplay-key nil)
   2406          (when transient--showp
   2407            (if-let ((win (minibuffer-selected-window)))
   2408                (with-selected-window win
   2409                  (transient--show))
   2410              (transient--show)))))
   2411   (transient--pop-keymap 'transient--transient-map)
   2412   (transient--pop-keymap 'transient--redisplay-map)
   2413   (remove-hook 'pre-command-hook  #'transient--pre-command)
   2414   (remove-hook 'post-command-hook #'transient--post-command))
   2415 
   2416 (defun transient--resume-override (&optional _ignore)
   2417   (transient--debug 'resume-override)
   2418   (when (and transient--showp transient-hide-during-minibuffer-read)
   2419     (transient--show))
   2420   (transient--push-keymap 'transient--transient-map)
   2421   (transient--push-keymap 'transient--redisplay-map)
   2422   (add-hook 'pre-command-hook  #'transient--pre-command)
   2423   (add-hook 'post-command-hook #'transient--post-command))
   2424 
   2425 (defun transient--recursive-edit (fn)
   2426   (transient--debug 'recursive-edit)
   2427   (if (not transient--prefix)
   2428       (funcall fn)
   2429     (transient--suspend-override (bound-and-true-p edebug-active))
   2430     (funcall fn) ; Already unwind protected.
   2431     (cond ((memq this-command '(top-level abort-recursive-edit))
   2432            (setq transient--exitp t)
   2433            (transient--post-exit)
   2434            (transient--delete-window))
   2435           (transient--prefix
   2436            (transient--resume-override)))))
   2437 
   2438 (defmacro transient--with-suspended-override (&rest body)
   2439   (let ((depth (make-symbol "depth"))
   2440         (setup (make-symbol "setup"))
   2441         (exit  (make-symbol "exit")))
   2442     `(if (and transient--transient-map
   2443               (memq transient--transient-map
   2444                     overriding-terminal-local-map))
   2445          (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit)
   2446            (setq ,setup
   2447                  (lambda () "@transient--with-suspended-override"
   2448                    (transient--debug 'minibuffer-setup)
   2449                    (remove-hook 'minibuffer-setup-hook ,setup)
   2450                    (transient--suspend-override)))
   2451            (setq ,exit
   2452                  (lambda () "@transient--with-suspended-override"
   2453                    (transient--debug 'minibuffer-exit)
   2454                    (when (= (minibuffer-depth) ,depth)
   2455                      (transient--resume-override))))
   2456            (unwind-protect
   2457                (progn
   2458                  (add-hook 'minibuffer-setup-hook ,setup)
   2459                  (add-hook 'minibuffer-exit-hook ,exit)
   2460                  ,@body)
   2461              (remove-hook 'minibuffer-setup-hook ,setup)
   2462              (remove-hook 'minibuffer-exit-hook ,exit)))
   2463        ,@body)))
   2464 
   2465 (defun transient--wrap-command ()
   2466   (static-if (>= emacs-major-version 30)
   2467       (letrec
   2468           ((prefix transient--prefix)
   2469            (suffix this-command)
   2470            (advice
   2471             (lambda (fn &rest args)
   2472               (interactive
   2473                (lambda (spec)
   2474                  (let ((abort t))
   2475                    (unwind-protect
   2476                        (prog1 (let ((debugger #'transient--exit-and-debug))
   2477                                 (advice-eval-interactive-spec spec))
   2478                          (setq abort nil))
   2479                      (when abort
   2480                        (when-let ((unwind (oref prefix unwind-suffix)))
   2481                          (transient--debug 'unwind-interactive)
   2482                          (funcall unwind suffix))
   2483                        (advice-remove suffix advice)
   2484                        (oset prefix unwind-suffix nil))))))
   2485               (unwind-protect
   2486                   (let ((debugger #'transient--exit-and-debug))
   2487                     (apply fn args))
   2488                 (when-let ((unwind (oref prefix unwind-suffix)))
   2489                   (transient--debug 'unwind-command)
   2490                   (funcall unwind suffix))
   2491                 (advice-remove suffix advice)
   2492                 (oset prefix unwind-suffix nil)))))
   2493         (when (symbolp this-command)
   2494           (advice-add suffix :around advice '((depth . -99))))
   2495         (cl-assert
   2496          (>= emacs-major-version 30) nil
   2497          "Emacs was downgraded, making it necessary to recompile Transient"))
   2498     ;; (< emacs-major-version 30)
   2499     (let* ((prefix transient--prefix)
   2500            (suffix this-command)
   2501            (advice nil)
   2502            (advice-interactive
   2503             (lambda (spec)
   2504               (let ((abort t))
   2505                 (unwind-protect
   2506                     (prog1 (let ((debugger #'transient--exit-and-debug))
   2507                              (advice-eval-interactive-spec spec))
   2508                       (setq abort nil))
   2509                   (when abort
   2510                     (when-let ((unwind (oref prefix unwind-suffix)))
   2511                       (transient--debug 'unwind-interactive)
   2512                       (funcall unwind suffix))
   2513                     (advice-remove suffix advice)
   2514                     (oset prefix unwind-suffix nil))))))
   2515            (advice-body
   2516             (lambda (fn &rest args)
   2517               (unwind-protect
   2518                   (let ((debugger #'transient--exit-and-debug))
   2519                     (apply fn args))
   2520                 (when-let ((unwind (oref prefix unwind-suffix)))
   2521                   (transient--debug 'unwind-command)
   2522                   (funcall unwind suffix))
   2523                 (advice-remove suffix advice)
   2524                 (oset prefix unwind-suffix nil)))))
   2525       (setq advice `(lambda (fn &rest args)
   2526                       (interactive ,advice-interactive)
   2527                       (apply ',advice-body fn args)))
   2528       (when (symbolp this-command)
   2529         (advice-add suffix :around advice '((depth . -99)))))))
   2530 
   2531 (defun transient--premature-post-command ()
   2532   (and (equal (this-command-keys-vector) [])
   2533        (= (minibuffer-depth)
   2534           (1+ transient--minibuffer-depth))
   2535        (progn
   2536          (transient--debug 'premature-post-command)
   2537          (transient--suspend-override)
   2538          (oset (or transient--prefix transient-current-prefix)
   2539                unwind-suffix
   2540                (if transient--exitp
   2541                    #'transient--post-exit
   2542                  #'transient--resume-override))
   2543          t)))
   2544 
   2545 (defun transient--post-command ()
   2546   (unless (transient--premature-post-command)
   2547     (transient--debug 'post-command)
   2548     (transient--with-emergency-exit :post-command
   2549       (cond (transient--exitp (transient--post-exit))
   2550             ;; If `this-command' is the current transient prefix, then we
   2551             ;; have already taken care of updating the transient buffer...
   2552             ((and (eq this-command (oref transient--prefix command))
   2553                   ;; ... but if `prefix-arg' is non-nil, then the values
   2554                   ;; of `this-command' and `real-this-command' are untrue
   2555                   ;; because `prefix-command-preserve-state' changes them.
   2556                   ;; We cannot use `current-prefix-arg' because it is set
   2557                   ;; too late (in `command-execute'), and if it were set
   2558                   ;; earlier, then we likely still would not be able to
   2559                   ;; rely on it, and `prefix-command-preserve-state-hook'
   2560                   ;; would have to be used to record that a universal
   2561                   ;; argument is in effect.
   2562                   (not prefix-arg)))
   2563             (transient--refreshp
   2564              (transient--refresh-transient))
   2565             ((let ((old transient--redisplay-map)
   2566                    (new (transient--make-redisplay-map)))
   2567                (unless (equal old new)
   2568                  (transient--pop-keymap 'transient--redisplay-map)
   2569                  (setq transient--redisplay-map new)
   2570                  (transient--push-keymap 'transient--redisplay-map))
   2571                (transient--redisplay)))))
   2572     (setq transient-current-prefix nil)
   2573     (setq transient-current-command nil)
   2574     (setq transient-current-suffixes nil)))
   2575 
   2576 (defun transient--post-exit (&optional command)
   2577   (transient--debug 'post-exit)
   2578   (unless (and (eq transient--exitp 'replace)
   2579                (or transient--prefix
   2580                    ;; The current command could act as a prefix,
   2581                    ;; but decided not to call `transient-setup',
   2582                    ;; or it is prevented from doing so because it
   2583                    ;; uses the minibuffer and the user aborted
   2584                    ;; that.
   2585                    (prog1 nil
   2586                      (if (let ((obj (transient-suffix-object command)))
   2587                            (and (slot-boundp obj 'transient)
   2588                                 (oref obj transient)))
   2589                          ;; This sub-prefix is a transient suffix;
   2590                          ;; go back to outer prefix, by calling
   2591                          ;; `transient--stack-pop' further down.
   2592                          (setq transient--exitp nil)
   2593                        (transient--stack-zap)))))
   2594     (remove-hook 'pre-command-hook  #'transient--pre-command)
   2595     (remove-hook 'post-command-hook #'transient--post-command)
   2596     (advice-remove 'recursive-edit #'transient--recursive-edit))
   2597   (let ((resume (and transient--stack
   2598                      (not (memq transient--exitp '(replace suspend))))))
   2599     (unless (or resume (eq transient--exitp 'replace))
   2600       (setq transient--showp nil))
   2601     (setq transient--exitp nil)
   2602     (setq transient--helpp nil)
   2603     (setq transient--editp nil)
   2604     (setq transient--all-levels-p nil)
   2605     (setq transient--minibuffer-depth 0)
   2606     (run-hooks 'transient-exit-hook)
   2607     (when resume
   2608       (transient--stack-pop))))
   2609 
   2610 (defun transient--stack-push ()
   2611   (transient--debug 'stack-push)
   2612   (push (list (oref transient--prefix command)
   2613               transient--layout
   2614               transient--editp
   2615               :transient-suffix (oref transient--prefix transient-suffix)
   2616               :scope (oref transient--prefix scope))
   2617         transient--stack))
   2618 
   2619 (defun transient--stack-pop ()
   2620   (transient--debug 'stack-pop)
   2621   (and transient--stack
   2622        (prog1 t (apply #'transient-setup (pop transient--stack)))))
   2623 
   2624 (defun transient--stack-zap ()
   2625   (transient--debug 'stack-zap)
   2626   (setq transient--stack nil))
   2627 
   2628 (defun transient--redisplay ()
   2629   (if (or (eq transient-show-popup t)
   2630           transient--showp)
   2631       (unless
   2632           (or (memq this-command transient--scroll-commands)
   2633               (and (or (memq this-command '(mouse-drag-region
   2634                                             mouse-set-region))
   2635                        (equal (key-description (this-command-keys-vector))
   2636                               "<mouse-movement>"))
   2637                    (and (eq (current-buffer) transient--buffer))))
   2638         (transient--show))
   2639     (when (and (numberp transient-show-popup)
   2640                (not (zerop transient-show-popup))
   2641                (not transient--timer))
   2642       (transient--timer-start))
   2643     (transient--show-brief)))
   2644 
   2645 (defun transient--timer-start ()
   2646   (setq transient--timer
   2647         (run-at-time (abs transient-show-popup) nil
   2648                      (lambda ()
   2649                        (transient--timer-cancel)
   2650                        (transient--show)
   2651                        (let ((message-log-max nil))
   2652                          (message ""))))))
   2653 
   2654 (defun transient--timer-cancel ()
   2655   (when transient--timer
   2656     (cancel-timer transient--timer)
   2657     (setq transient--timer nil)))
   2658 
   2659 (defun transient--debug (arg &rest args)
   2660   (when transient--debug
   2661     (let ((inhibit-message (not (eq transient--debug 'message))))
   2662       (if (symbolp arg)
   2663           (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
   2664                    arg
   2665                    (cond ((and (symbolp this-command) this-command))
   2666                          ((fboundp 'help-fns-function-name)
   2667                           (help-fns-function-name this-command))
   2668                          ((byte-code-function-p this-command)
   2669                           "#[...]")
   2670                          (this-command))
   2671                    (key-description (this-command-keys-vector))
   2672                    transient--exitp
   2673                    (cond ((keywordp (car args))
   2674                           (format ", from: %s"
   2675                                   (substring (symbol-name (car args)) 1)))
   2676                          ((stringp (car args))
   2677                           (concat ", " (apply #'format args)))
   2678                          ((functionp (car args))
   2679                           (concat ", " (apply (car args) (cdr args))))
   2680                          ("")))
   2681         (apply #'message arg args)))))
   2682 
   2683 (defun transient--emergency-exit (&optional id)
   2684   "Exit the current transient command after an error occurred.
   2685 When no transient is active (i.e., when `transient--prefix' is
   2686 nil) then do nothing.  Optional ID is a keyword identifying the
   2687 exit."
   2688   (transient--debug 'emergency-exit id)
   2689   (when transient--prefix
   2690     (setq transient--stack nil)
   2691     (setq transient--exitp t)
   2692     (transient--pre-exit)
   2693     (transient--post-exit)))
   2694 
   2695 ;;; Pre-Commands
   2696 
   2697 (defun transient--call-pre-command ()
   2698   (if-let ((fn (transient--get-pre-command this-command)))
   2699       (let ((action (funcall fn)))
   2700         (when (eq action transient--exit)
   2701           (setq transient--exitp (or transient--exitp t)))
   2702         action)
   2703     (if (let ((keys (this-command-keys-vector)))
   2704           (eq (aref keys (1- (length keys))) ?\C-g))
   2705         (setq this-command 'transient-noop)
   2706       (unless (transient--edebug-command-p)
   2707         (setq this-command 'transient-undefined)))
   2708     transient--stay))
   2709 
   2710 (defun transient--get-pre-command (&optional cmd enforce-type)
   2711   (or (and (not (eq enforce-type 'non-suffix))
   2712            (symbolp cmd)
   2713            (lookup-key transient--predicate-map (vector cmd)))
   2714       (and (not (eq enforce-type 'suffix))
   2715            (transient--resolve-pre-command
   2716             (oref transient--prefix transient-non-suffix)
   2717             t))))
   2718 
   2719 (defun transient--resolve-pre-command (pre &optional resolve-boolean)
   2720   (cond ((booleanp pre)
   2721          (if resolve-boolean
   2722              (if pre #'transient--do-stay #'transient--do-warn)
   2723            pre))
   2724         ((string-match-p "--do-" (symbol-name pre)) pre)
   2725         ((let ((sym (intern (format "transient--do-%s" pre))))
   2726            (if (functionp sym) sym pre)))))
   2727 
   2728 (defun transient--do-stay ()
   2729   "Call the command without exporting variables and stay transient."
   2730   transient--stay)
   2731 
   2732 (defun transient--do-noop ()
   2733   "Call `transient-noop' and stay transient."
   2734   (setq this-command 'transient-noop)
   2735   transient--stay)
   2736 
   2737 (defun transient--do-warn ()
   2738   "Call `transient-undefined' and stay transient."
   2739   (setq this-command 'transient-undefined)
   2740   transient--stay)
   2741 
   2742 (defun transient--do-warn-inapt ()
   2743   "Call `transient-inapt' and stay transient."
   2744   (setq this-command 'transient-inapt)
   2745   transient--stay)
   2746 
   2747 (defun transient--do-call ()
   2748   "Call the command after exporting variables and stay transient."
   2749   (transient--export)
   2750   transient--stay)
   2751 
   2752 (defun transient--do-return ()
   2753   "Call the command after exporting variables and return to parent prefix.
   2754 If there is no parent prefix, then behave like `transient--do-exit'."
   2755   (if (not transient--stack)
   2756       (transient--do-exit)
   2757     (transient--export)
   2758     transient--exit))
   2759 
   2760 (defun transient--do-exit ()
   2761   "Call the command after exporting variables and exit the transient."
   2762   (transient--export)
   2763   (transient--stack-zap)
   2764   transient--exit)
   2765 
   2766 (defun transient--do-leave ()
   2767   "Call the command without exporting variables and exit the transient."
   2768   (transient--stack-zap)
   2769   transient--exit)
   2770 
   2771 (defun transient--do-push-button ()
   2772   "Call the command represented by the activated button.
   2773 Use that command's pre-command to determine transient behavior."
   2774   (if (and (mouse-event-p last-command-event)
   2775            (not (eq (posn-window (event-start last-command-event))
   2776                     transient--window)))
   2777       transient--stay
   2778     (setq this-command
   2779           (with-selected-window transient--window
   2780             (get-text-property (if (mouse-event-p last-command-event)
   2781                                    (posn-point (event-start last-command-event))
   2782                                  (point))
   2783                                'command)))
   2784     (transient--call-pre-command)))
   2785 
   2786 (defun transient--do-recurse ()
   2787   "Call the transient prefix command, preparing for return to active transient.
   2788 If there is no parent prefix, then just call the command."
   2789   (transient--do-stack))
   2790 
   2791 (defun transient--setup-recursion (prefix-obj)
   2792   (when transient--stack
   2793     (let ((command (oref prefix-obj command)))
   2794       (when-let ((suffix-obj (transient-suffix-object command)))
   2795         (when (memq (if (slot-boundp suffix-obj 'transient)
   2796                         (oref suffix-obj transient)
   2797                       (oref transient-current-prefix transient-suffix))
   2798                     (list t #'transient--do-recurse))
   2799           (oset prefix-obj transient-suffix t))))))
   2800 
   2801 (defun transient--do-stack ()
   2802   "Call the transient prefix command, stacking the active transient.
   2803 Push the active transient to the transient stack."
   2804   (transient--export)
   2805   (transient--stack-push)
   2806   (setq transient--exitp 'replace)
   2807   transient--exit)
   2808 
   2809 (defun transient--do-replace ()
   2810   "Call the transient prefix command, replacing the active transient.
   2811 Do not push the active transient to the transient stack."
   2812   (transient--export)
   2813   (setq transient--exitp 'replace)
   2814   transient--exit)
   2815 
   2816 (defun transient--do-suspend ()
   2817   "Suspend the active transient, saving the transient stack."
   2818   (transient--stack-push)
   2819   (setq transient--exitp 'suspend)
   2820   transient--exit)
   2821 
   2822 (defun transient--do-quit-one ()
   2823   "If active, quit help or edit mode, else exit the active transient."
   2824   (cond (transient--helpp
   2825          (setq transient--helpp nil)
   2826          transient--stay)
   2827         (transient--editp
   2828          (setq transient--editp nil)
   2829          (transient-setup)
   2830          transient--stay)
   2831         (prefix-arg
   2832          transient--stay)
   2833         (transient--exit)))
   2834 
   2835 (defun transient--do-quit-all ()
   2836   "Exit all transients without saving the transient stack."
   2837   (transient--stack-zap)
   2838   transient--exit)
   2839 
   2840 (defun transient--do-move ()
   2841   "Call the command if `transient-enable-popup-navigation' is non-nil.
   2842 In that case behave like `transient--do-stay', otherwise similar
   2843 to `transient--do-warn'."
   2844   (unless transient-enable-popup-navigation
   2845     (setq this-command 'transient-inhibit-move))
   2846   transient--stay)
   2847 
   2848 (defun transient--do-minus ()
   2849   "Call `negative-argument' or pivot to `transient-update'.
   2850 If `negative-argument' is invoked using \"-\" then preserve the
   2851 prefix argument and pivot to `transient-update'."
   2852   (when (equal (this-command-keys) "-")
   2853     (setq this-command 'transient-update))
   2854   transient--stay)
   2855 
   2856 (put 'transient--do-stay       'transient-face 'transient-key-stay)
   2857 (put 'transient--do-noop       'transient-face 'transient-key-noop)
   2858 (put 'transient--do-warn       'transient-face 'transient-key-noop)
   2859 (put 'transient--do-warn-inapt 'transient-face 'transient-key-noop)
   2860 (put 'transient--do-call       'transient-face 'transient-key-stay)
   2861 (put 'transient--do-return     'transient-face 'transient-key-return)
   2862 (put 'transient--do-exit       'transient-face 'transient-key-exit)
   2863 (put 'transient--do-leave      'transient-face 'transient-key-exit)
   2864 
   2865 (put 'transient--do-recurse    'transient-face 'transient-key-stay)
   2866 (put 'transient--do-stack      'transient-face 'transient-key-stay)
   2867 (put 'transient--do-replace    'transient-face 'transient-key-exit)
   2868 (put 'transient--do-suspend    'transient-face 'transient-key-exit)
   2869 
   2870 (put 'transient--do-quit-one   'transient-face 'transient-key-return)
   2871 (put 'transient--do-quit-all   'transient-face 'transient-key-exit)
   2872 (put 'transient--do-move       'transient-face 'transient-key-stay)
   2873 (put 'transient--do-minus      'transient-face 'transient-key-stay)
   2874 
   2875 ;;; Commands
   2876 ;;;; Noop
   2877 
   2878 (defun transient-noop ()
   2879   "Do nothing at all."
   2880   (interactive))
   2881 
   2882 (defun transient-undefined ()
   2883   "Warn the user that the pressed key is not bound to any suffix."
   2884   (interactive)
   2885   (transient--invalid "Unbound suffix"))
   2886 
   2887 (defun transient-inapt ()
   2888   "Warn the user that the invoked command is inapt."
   2889   (interactive)
   2890   (transient--invalid "Inapt command"))
   2891 
   2892 (defun transient--invalid (msg)
   2893   (ding)
   2894   (message "%s: `%s' (Use `%s' to abort, `%s' for help)%s"
   2895            msg
   2896            (propertize (key-description (this-single-command-keys))
   2897                        'face 'font-lock-warning-face)
   2898            (propertize "C-g" 'face 'transient-key)
   2899            (propertize "?"   'face 'transient-key)
   2900            ;; `this-command' is `transient-undefined' or `transient-inapt'.
   2901            ;; Show the command (`this-original-command') the user actually
   2902            ;; tried to invoke.
   2903            (if-let ((cmd (or (ignore-errors (symbol-name this-original-command))
   2904                              (ignore-errors (symbol-name this-command)))))
   2905                (format " [%s]" (propertize cmd 'face 'font-lock-warning-face))
   2906              ""))
   2907   (unless (and transient--transient-map
   2908                (memq transient--transient-map overriding-terminal-local-map))
   2909     (let ((transient--prefix (or transient--prefix 'sic)))
   2910       (transient--emergency-exit))
   2911     (view-lossage)
   2912     (other-window 1)
   2913     (display-warning 'transient "Inconsistent transient state detected.
   2914 This should never happen.
   2915 Please open an issue and post the shown command log." :error)))
   2916 
   2917 (defun transient-inhibit-move ()
   2918   "Warn the user that popup navigation is disabled."
   2919   (interactive)
   2920   (message "To enable use of `%s', please customize `%s'"
   2921            this-original-command
   2922            'transient-enable-popup-navigation))
   2923 
   2924 ;;;; Core
   2925 
   2926 (defun transient-quit-all ()
   2927   "Exit all transients without saving the transient stack."
   2928   (interactive))
   2929 
   2930 (defun transient-quit-one ()
   2931   "Exit the current transients, returning to outer transient, if any."
   2932   (interactive))
   2933 
   2934 (defun transient-quit-seq ()
   2935   "Abort the current incomplete key sequence."
   2936   (interactive))
   2937 
   2938 (defun transient-update ()
   2939   "Redraw the transient's state in the popup buffer."
   2940   (interactive)
   2941   (setq prefix-arg current-prefix-arg))
   2942 
   2943 (defun transient-show ()
   2944   "Show the transient's state in the popup buffer."
   2945   (interactive)
   2946   (setq transient--showp t))
   2947 
   2948 (defun transient-push-button ()
   2949   "Invoke the suffix command represented by this button."
   2950   (interactive))
   2951 
   2952 ;;;; Suspend
   2953 
   2954 (defun transient-suspend ()
   2955   "Suspend the current transient.
   2956 It can later be resumed using `transient-resume', while no other
   2957 transient is active."
   2958   (interactive))
   2959 
   2960 (define-minor-mode transient-resume-mode
   2961   "Auxiliary minor-mode used to resume a transient after viewing help.")
   2962 
   2963 (defun transient-resume ()
   2964   "Resume a previously suspended stack of transients."
   2965   (interactive)
   2966   (cond (transient--stack
   2967          (let ((winconf transient--restore-winconf))
   2968            (kill-local-variable 'transient--restore-winconf)
   2969            (when transient-resume-mode
   2970              (transient-resume-mode -1)
   2971              (quit-window))
   2972            (when winconf
   2973              (set-window-configuration winconf)))
   2974          (transient--stack-pop))
   2975         (transient-resume-mode
   2976          (kill-local-variable 'transient--restore-winconf)
   2977          (transient-resume-mode -1)
   2978          (quit-window))
   2979         (t
   2980          (message "No suspended transient command"))))
   2981 
   2982 ;;;; Help
   2983 
   2984 (defun transient-help (&optional interactive)
   2985   "Show help for the active transient or one of its suffixes.\n\n(fn)"
   2986   (interactive (list t))
   2987   (if interactive
   2988       (setq transient--helpp t)
   2989     (with-demoted-errors "transient-help: %S"
   2990       (when (lookup-key transient--transient-map
   2991                         (this-single-command-raw-keys))
   2992         (setq transient--helpp nil)
   2993         (let ((winconf (current-window-configuration)))
   2994           (transient-show-help
   2995            (if (eq this-original-command 'transient-help)
   2996                transient--prefix
   2997              (or (transient-suffix-object)
   2998                  this-original-command)))
   2999           (setq-local transient--restore-winconf winconf))
   3000         (fit-window-to-buffer nil (frame-height) (window-height))
   3001         (transient-resume-mode)
   3002         (message (substitute-command-keys
   3003                   "Type \\`q' to resume transient command."))
   3004         t))))
   3005 
   3006 ;;;; Level
   3007 
   3008 (defun transient-set-level (&optional command level)
   3009   "Set the level of the transient or one of its suffix commands."
   3010   (interactive
   3011    (let ((command this-original-command)
   3012          (prefix (oref transient--prefix command)))
   3013      (and (or (not (eq command 'transient-set-level))
   3014               (and transient--editp
   3015                    (setq command prefix)))
   3016           (list command
   3017                 (let ((keys (this-single-command-raw-keys)))
   3018                   (and (lookup-key transient--transient-map keys)
   3019                        (progn
   3020                          (transient--show)
   3021                          (string-to-number
   3022                           (transient--read-number-N
   3023                            (format "Set level for `%s': " command)
   3024                            nil nil (not (eq command prefix)))))))))))
   3025   (cond
   3026    ((not command)
   3027     (setq transient--editp t)
   3028     (transient-setup))
   3029    (level
   3030     (let* ((prefix (oref transient--prefix command))
   3031            (alist (alist-get prefix transient-levels))
   3032            (akey command))
   3033       (cond ((eq command prefix)
   3034              (oset transient--prefix level level)
   3035              (setq akey t))
   3036             (t
   3037              (oset (transient-suffix-object command) level level)
   3038              (when (cdr (cl-remove-if-not (lambda (obj)
   3039                                             (eq (oref obj command) command))
   3040                                           transient--suffixes))
   3041                (setq akey (cons command (this-command-keys))))))
   3042       (setf (alist-get akey alist) level)
   3043       (setf (alist-get prefix transient-levels) alist))
   3044     (transient-save-levels)
   3045     (transient--show))
   3046    (t
   3047     (transient-undefined))))
   3048 
   3049 (transient-define-suffix transient-toggle-level-limit ()
   3050   "Toggle whether to temporarily displayed suffixes on all levels."
   3051   :description
   3052   (lambda ()
   3053     (cond
   3054      ((= transient-default-level transient--max-level)
   3055       "Always displaying all levels")
   3056      (transient--all-levels-p
   3057       (format "Hide suffix %s"
   3058               (propertize
   3059                (format "levels > %s" (oref (transient-prefix-object) level))
   3060                'face 'transient-higher-level)))
   3061      ("Show all suffix levels")))
   3062   :inapt-if (lambda () (= transient-default-level transient--max-level))
   3063   :transient t
   3064   (interactive)
   3065   (setq transient--all-levels-p (not transient--all-levels-p))
   3066   (setq transient--refreshp t))
   3067 
   3068 ;;;; Value
   3069 
   3070 (defun transient-set ()
   3071   "Set active transient's value for this Emacs session."
   3072   (interactive)
   3073   (transient-set-value (transient-prefix-object)))
   3074 
   3075 (defalias 'transient-set-and-exit #'transient-set
   3076   "Set active transient's value for this Emacs session and exit.")
   3077 
   3078 (defun transient-save ()
   3079   "Save active transient's value for this and future Emacs sessions."
   3080   (interactive)
   3081   (transient-save-value (transient-prefix-object)))
   3082 
   3083 (defalias 'transient-save-and-exit #'transient-save
   3084   "Save active transient's value for this and future Emacs sessions and exit.")
   3085 
   3086 (defun transient-reset ()
   3087   "Clear the set and saved values of the active transient."
   3088   (interactive)
   3089   (transient-reset-value (transient-prefix-object)))
   3090 
   3091 (defun transient-history-next ()
   3092   "Switch to the next value used for the active transient."
   3093   (interactive)
   3094   (let* ((obj transient--prefix)
   3095          (pos (1- (oref obj history-pos)))
   3096          (hst (oref obj history)))
   3097     (if (< pos 0)
   3098         (user-error "End of history")
   3099       (oset obj history-pos pos)
   3100       (oset obj value (nth pos hst))
   3101       (mapc #'transient-init-value transient--suffixes))))
   3102 
   3103 (defun transient-history-prev ()
   3104   "Switch to the previous value used for the active transient."
   3105   (interactive)
   3106   (let* ((obj transient--prefix)
   3107          (pos (1+ (oref obj history-pos)))
   3108          (hst (oref obj history))
   3109          (len (length hst)))
   3110     (if (> pos (1- len))
   3111         (user-error "End of history")
   3112       (oset obj history-pos pos)
   3113       (oset obj value (nth pos hst))
   3114       (mapc #'transient-init-value transient--suffixes))))
   3115 
   3116 (transient-define-suffix transient-preset ()
   3117   "Put this preset into action."
   3118   :class transient-value-preset
   3119   (interactive)
   3120   (transient-prefix-set (oref (transient-suffix-object) set)))
   3121 
   3122 ;;;; Auxiliary
   3123 
   3124 (defun transient-toggle-common ()
   3125   "Toggle whether common commands are permanently shown."
   3126   (interactive)
   3127   (setq transient-show-common-commands (not transient-show-common-commands)))
   3128 
   3129 (defun transient-toggle-debug ()
   3130   "Toggle debugging statements for transient commands."
   3131   (interactive)
   3132   (setq transient--debug (not transient--debug))
   3133   (message "Debugging transient %s"
   3134            (if transient--debug "enabled" "disabled")))
   3135 
   3136 (transient-define-suffix transient-echo-arguments (arguments)
   3137   "Show the transient's active ARGUMENTS in the echo area.
   3138 Intended for use in prefixes used for demonstration purposes,
   3139 such as when suggesting a new feature or reporting an issue."
   3140   :transient t
   3141   :description "Echo arguments"
   3142   :key "x"
   3143   (interactive (list (transient-args transient-current-command)))
   3144   (message "%s: %s"
   3145            (key-description (this-command-keys))
   3146            (mapconcat (lambda (arg)
   3147                         (propertize (if (string-match-p " " arg)
   3148                                         (format "%S" arg)
   3149                                       arg)
   3150                                     'face 'transient-argument))
   3151                       arguments " ")))
   3152 
   3153 ;;; Value
   3154 ;;;; Init
   3155 
   3156 (cl-defgeneric transient-init-scope (obj)
   3157   "Set the scope of the suffix object OBJ.
   3158 
   3159 The scope is actually a property of the transient prefix, not of
   3160 individual suffixes.  However it is possible to invoke a suffix
   3161 command directly instead of from a transient.  In that case, if
   3162 the suffix expects a scope, then it has to determine that itself
   3163 and store it in its `scope' slot.
   3164 
   3165 This function is called for all suffix commands, but unless a
   3166 concrete method is implemented this falls through to the default
   3167 implementation, which is a noop.")
   3168 
   3169 (cl-defmethod transient-init-scope ((_   transient-suffix))
   3170   "Noop." nil)
   3171 
   3172 (cl-defgeneric transient-init-value (_)
   3173   "Set the initial value of the object OBJ.
   3174 
   3175 This function is called for all prefix and suffix commands.
   3176 
   3177 For suffix commands (including infix argument commands) the
   3178 default implementation is a noop.  Classes derived from the
   3179 abstract `transient-infix' class must implement this function.
   3180 Non-infix suffix commands usually don't have a value."
   3181   nil)
   3182 
   3183 (cl-defmethod transient-init-value :around ((obj transient-prefix))
   3184   "If bound, then call OBJ's `init-value' function.
   3185 Otherwise call the primary method according to object's class."
   3186   (if (slot-boundp obj 'init-value)
   3187       (funcall (oref obj init-value) obj)
   3188     (cl-call-next-method obj)))
   3189 
   3190 (cl-defmethod transient-init-value :around ((obj transient-infix))
   3191   "If bound, then call OBJ's `init-value' function.
   3192 Otherwise call the primary method according to object's class."
   3193   (if (slot-boundp obj 'init-value)
   3194       (funcall (oref obj init-value) obj)
   3195     (cl-call-next-method obj)))
   3196 
   3197 (cl-defmethod transient-init-value ((obj transient-prefix))
   3198   (if (slot-boundp obj 'value)
   3199       (oref obj value)
   3200     (oset obj value
   3201           (if-let ((saved (assq (oref obj command) transient-values)))
   3202               (cdr saved)
   3203             (transient-default-value obj)))))
   3204 
   3205 (cl-defmethod transient-init-value ((obj transient-argument))
   3206   (oset obj value
   3207         (let ((value (oref transient--prefix value))
   3208               (argument (and (slot-boundp obj 'argument)
   3209                              (oref obj argument)))
   3210               (multi-value (oref obj multi-value))
   3211               (case-fold-search nil)
   3212               (regexp (if (slot-exists-p obj 'argument-regexp)
   3213                           (oref obj argument-regexp)
   3214                         (format "\\`%s\\(.*\\)" (oref obj argument)))))
   3215           (if (memq multi-value '(t rest))
   3216               (cdr (assoc argument value))
   3217             (let ((match (lambda (v)
   3218                            (and (stringp v)
   3219                                 (string-match regexp v)
   3220                                 (match-string 1 v)))))
   3221               (if multi-value
   3222                   (delq nil (mapcar match value))
   3223                 (cl-some match value)))))))
   3224 
   3225 (cl-defmethod transient-init-value ((obj transient-switch))
   3226   (oset obj value
   3227         (car (member (oref obj argument)
   3228                      (oref transient--prefix value)))))
   3229 
   3230 ;;;; Default
   3231 
   3232 (cl-defgeneric transient-default-value (_)
   3233   "Return the default value."
   3234   nil)
   3235 
   3236 (cl-defmethod transient-default-value ((obj transient-prefix))
   3237   (if-let ((default (and (slot-boundp obj 'default-value)
   3238                          (oref obj default-value))))
   3239       (if (functionp default)
   3240           (funcall default)
   3241         default)
   3242     nil))
   3243 
   3244 ;;;; Read
   3245 
   3246 (cl-defgeneric transient-infix-read (obj)
   3247   "Determine the new value of the infix object OBJ.
   3248 
   3249 This function merely determines the value; `transient-infix-set'
   3250 is used to actually store the new value in the object.
   3251 
   3252 For most infix classes this is done by reading a value from the
   3253 user using the reader specified by the `reader' slot (using the
   3254 `transient-infix' method described below).
   3255 
   3256 For some infix classes the value is changed without reading
   3257 anything in the minibuffer, i.e., the mere act of invoking the
   3258 infix command determines what the new value should be, based
   3259 on the previous value.")
   3260 
   3261 (cl-defmethod transient-infix-read :around ((obj transient-infix))
   3262   "Refresh the transient buffer and call the next method.
   3263 
   3264 Also wrap `cl-call-next-method' with two macros:
   3265 - `transient--with-suspended-override' allows use of minibuffer.
   3266 - `transient--with-emergency-exit' arranges for the transient to
   3267   be exited in case of an error."
   3268   (transient--show)
   3269   (transient--with-emergency-exit :infix-read
   3270     (transient--with-suspended-override
   3271      (cl-call-next-method obj))))
   3272 
   3273 (cl-defmethod transient-infix-read ((obj transient-infix))
   3274   "Read a value while taking care of history.
   3275 
   3276 This method is suitable for a wide variety of infix commands,
   3277 including but not limited to inline arguments and variables.
   3278 
   3279 If you do not use this method for your own infix class, then
   3280 you should likely replicate a lot of the behavior of this
   3281 method.  If you fail to do so, then users might not appreciate
   3282 the lack of history, for example.
   3283 
   3284 Only for very simple classes that toggle or cycle through a very
   3285 limited number of possible values should you replace this with a
   3286 simple method that does not handle history.  (E.g., for a command
   3287 line switch the only possible values are \"use it\" and \"don't use
   3288 it\", in which case it is pointless to preserve history.)"
   3289   (with-slots (value multi-value always-read allow-empty choices) obj
   3290     (if (and value
   3291              (not multi-value)
   3292              (not always-read)
   3293              transient--prefix)
   3294         (oset obj value nil)
   3295       (let* ((enable-recursive-minibuffers t)
   3296              (reader (oref obj reader))
   3297              (choices (if (functionp choices) (funcall choices) choices))
   3298              (prompt (transient-prompt obj))
   3299              (value (if multi-value (string-join value ",") value))
   3300              (history-key (or (oref obj history-key)
   3301                               (oref obj command)))
   3302              (transient--history (alist-get history-key transient-history))
   3303              (transient--history (if (or (null value)
   3304                                          (eq value (car transient--history)))
   3305                                      transient--history
   3306                                    (cons value transient--history)))
   3307              (initial-input (and transient-read-with-initial-input
   3308                                  (car transient--history)))
   3309              (history (if initial-input
   3310                           (cons 'transient--history 1)
   3311                         'transient--history))
   3312              (value
   3313               (cond
   3314                (reader (funcall reader prompt initial-input history))
   3315                (multi-value
   3316                 (completing-read-multiple prompt choices nil nil
   3317                                           initial-input history))
   3318                (choices
   3319                 (completing-read prompt choices nil t initial-input history))
   3320                ((read-string prompt initial-input history)))))
   3321         (cond ((and (equal value "") (not allow-empty))
   3322                (setq value nil))
   3323               ((and (equal value "\"\"") allow-empty)
   3324                (setq value "")))
   3325         (when value
   3326           (when (and (bound-and-true-p ivy-mode)
   3327                      (stringp (car transient--history)))
   3328             (set-text-properties 0 (length (car transient--history)) nil
   3329                                  (car transient--history)))
   3330           (setf (alist-get history-key transient-history)
   3331                 (delete-dups transient--history)))
   3332         value))))
   3333 
   3334 (cl-defmethod transient-infix-read ((obj transient-switch))
   3335   "Toggle the switch on or off."
   3336   (if (oref obj value) nil (oref obj argument)))
   3337 
   3338 (cl-defmethod transient-infix-read ((obj transient-switches))
   3339   "Cycle through the mutually exclusive switches.
   3340 The last value is \"don't use any of these switches\"."
   3341   (let ((choices (mapcar (apply-partially #'format (oref obj argument-format))
   3342                          (oref obj choices))))
   3343     (if-let ((value (oref obj value)))
   3344         (cadr (member value choices))
   3345       (car choices))))
   3346 
   3347 (cl-defmethod transient-infix-read ((command symbol))
   3348   "Elsewhere use the reader of the infix command COMMAND.
   3349 Use this if you want to share an infix's history with a regular
   3350 stand-alone command."
   3351   (if-let ((obj (transient--suffix-prototype command)))
   3352       (cl-letf (((symbol-function #'transient--show) #'ignore))
   3353         (transient-infix-read obj))
   3354     (error "Not a suffix command: `%s'" command)))
   3355 
   3356 ;;;; Readers
   3357 
   3358 (defun transient-read-file (prompt _initial-input _history)
   3359   "Read a file."
   3360   (file-local-name (expand-file-name (read-file-name prompt))))
   3361 
   3362 (defun transient-read-existing-file (prompt _initial-input _history)
   3363   "Read an existing file."
   3364   (file-local-name (expand-file-name (read-file-name prompt nil nil t))))
   3365 
   3366 (defun transient-read-directory (prompt _initial-input _history)
   3367   "Read a directory."
   3368   (file-local-name (expand-file-name (read-directory-name prompt))))
   3369 
   3370 (defun transient-read-existing-directory (prompt _initial-input _history)
   3371   "Read an existing directory."
   3372   (file-local-name (expand-file-name (read-directory-name prompt nil nil t))))
   3373 
   3374 (defun transient-read-number-N0 (prompt initial-input history)
   3375   "Read a natural number (including zero) and return it as a string."
   3376   (transient--read-number-N prompt initial-input history t))
   3377 
   3378 (defun transient-read-number-N+ (prompt initial-input history)
   3379   "Read a natural number (excluding zero) and return it as a string."
   3380   (transient--read-number-N prompt initial-input history nil))
   3381 
   3382 (defun transient--read-number-N (prompt initial-input history include-zero)
   3383   (save-match-data
   3384     (cl-block nil
   3385       (while t
   3386         (let ((str (read-from-minibuffer prompt initial-input nil nil history)))
   3387           (when (or (string-equal str "")
   3388                     (string-match-p (if include-zero
   3389                                         "\\`\\(0\\|[1-9][0-9]*\\)\\'"
   3390                                       "\\`[1-9][0-9]*\\'")
   3391                                     str))
   3392             (cl-return str)))
   3393         (message "Please enter a natural number (%s zero)."
   3394                  (if include-zero "including" "excluding"))
   3395         (sit-for 1)))))
   3396 
   3397 (defun transient-read-date (prompt default-time _history)
   3398   "Read a date using `org-read-date' (which see)."
   3399   (require 'org)
   3400   (when (fboundp 'org-read-date)
   3401     (org-read-date 'with-time nil nil prompt default-time)))
   3402 
   3403 ;;;; Prompt
   3404 
   3405 (cl-defgeneric transient-prompt (obj)
   3406   "Return the prompt to be used to read infix object OBJ's value.")
   3407 
   3408 (cl-defmethod transient-prompt ((obj transient-infix))
   3409   "Return the prompt to be used to read infix object OBJ's value.
   3410 
   3411 This implementation should be suitable for almost all infix
   3412 commands.
   3413 
   3414 If the value of OBJ's `prompt' slot is non-nil, then it must be
   3415 a string or a function.  If it is a string, then use that.  If
   3416 it is a function, then call that with OBJ as the only argument.
   3417 That function must return a string, which is then used as the
   3418 prompt.
   3419 
   3420 Otherwise, if the value of either the `argument' or `variable'
   3421 slot of OBJ is a string, then base the prompt on that (preferring
   3422 the former), appending either \"=\" (if it appears to be a
   3423 command-line option) or \": \".
   3424 
   3425 Finally fall through to using \"(BUG: no prompt): \" as the
   3426 prompt."
   3427   (if-let ((prompt (oref obj prompt)))
   3428       (let ((prompt (if (functionp prompt)
   3429                         (funcall prompt obj)
   3430                       prompt)))
   3431         (if (stringp prompt)
   3432             prompt
   3433           "(BUG: no prompt): "))
   3434     (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
   3435           (if (and (stringp arg) (string-suffix-p "=" arg))
   3436               arg
   3437             (concat arg ": ")))
   3438         (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable))))
   3439           (and (stringp var)
   3440                (concat var ": ")))
   3441         "(BUG: no prompt): ")))
   3442 
   3443 ;;;; Set
   3444 
   3445 (cl-defgeneric transient-infix-set (obj value)
   3446   "Set the value of infix object OBJ to VALUE.")
   3447 
   3448 (cl-defmethod transient-infix-set ((obj transient-infix) value)
   3449   "Set the value of infix object OBJ to VALUE."
   3450   (oset obj value value))
   3451 
   3452 (cl-defmethod transient-infix-set :after ((obj transient-argument) value)
   3453   "Unset incompatible infix arguments."
   3454   (when-let* ((value)
   3455               (val (transient-infix-value obj))
   3456               (arg (if (slot-boundp obj 'argument)
   3457                        (oref obj argument)
   3458                      (oref obj argument-format)))
   3459               (spec (oref transient--prefix incompatible))
   3460               (filter (lambda (x rule)
   3461                         (and (member x rule)
   3462                              (remove x rule))))
   3463               (incomp (nconc
   3464                        (cl-mapcan (apply-partially filter arg) spec)
   3465                        (and (not (equal val arg))
   3466                             (cl-mapcan (apply-partially filter val) spec)))))
   3467     (dolist (obj transient--suffixes)
   3468       (when-let* (((cl-typep obj 'transient-argument))
   3469                   (val (transient-infix-value obj))
   3470                   (arg (if (slot-boundp obj 'argument)
   3471                            (oref obj argument)
   3472                          (oref obj argument-format)))
   3473                   ((if (equal val arg)
   3474                        (member arg incomp)
   3475                      (or (member val incomp)
   3476                          (member arg incomp)))))
   3477         (transient-infix-set obj nil)))))
   3478 
   3479 (defun transient-prefix-set (value)
   3480   "Set the value of the active transient prefix to VALUE.
   3481 Intended for use by transient suffix commands."
   3482   (oset transient--prefix value value)
   3483   (setq transient--refreshp 'updated-value))
   3484 
   3485 (cl-defgeneric transient-set-value (obj)
   3486   "Persist the value of the transient prefix OBJ.
   3487 Only intended for use by `transient-set'.
   3488 Also see `transient-prefix-set'.")
   3489 
   3490 (cl-defmethod transient-set-value ((obj transient-prefix))
   3491   (oset (oref obj prototype) value (transient-get-value))
   3492   (transient--history-push obj))
   3493 
   3494 ;;;; Save
   3495 
   3496 (cl-defgeneric transient-save-value (obj)
   3497   "Save the value of the transient prefix OBJ.")
   3498 
   3499 (cl-defmethod transient-save-value ((obj transient-prefix))
   3500   (let ((value (transient-get-value)))
   3501     (oset (oref obj prototype) value value)
   3502     (setf (alist-get (oref obj command) transient-values) value)
   3503     (transient-save-values))
   3504   (transient--history-push obj))
   3505 
   3506 ;;;; Reset
   3507 
   3508 (cl-defgeneric transient-reset-value (obj)
   3509   "Clear the set and saved values of the transient prefix OBJ.")
   3510 
   3511 (cl-defmethod transient-reset-value ((obj transient-prefix))
   3512   (let ((value (transient-default-value obj)))
   3513     (oset obj value value)
   3514     (oset (oref obj prototype) value value)
   3515     (setf (alist-get (oref obj command) transient-values nil 'remove) nil)
   3516     (transient-save-values))
   3517   (transient--history-push obj)
   3518   (mapc #'transient-init-value transient--suffixes))
   3519 
   3520 ;;;; Get
   3521 
   3522 (defun transient-args (prefix)
   3523   "Return the value of the transient prefix command PREFIX.
   3524 If the current command was invoked from the transient prefix
   3525 command PREFIX, then return the active infix arguments.  If
   3526 the current command was not invoked from PREFIX, then return
   3527 the set, saved or default value for PREFIX."
   3528   (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix)))
   3529 
   3530 (defun transient-suffixes (prefix)
   3531   "Return the suffix objects of the transient prefix command PREFIX."
   3532   (if (eq transient-current-command prefix)
   3533       transient-current-suffixes
   3534     (let ((transient--prefix (transient--init-prefix prefix)))
   3535       (transient--flatten-suffixes
   3536        (transient--init-suffixes prefix)))))
   3537 
   3538 (defun transient-get-value ()
   3539   (transient--with-emergency-exit :get-value
   3540     (cl-mapcan (lambda (obj)
   3541                  (and (or (not (slot-exists-p obj 'unsavable))
   3542                           (not (oref obj unsavable)))
   3543                       (transient--get-wrapped-value obj)))
   3544                (or transient--suffixes transient-current-suffixes))))
   3545 
   3546 (defun transient--get-wrapped-value (obj)
   3547   (and-let* ((value (transient-infix-value obj)))
   3548     (pcase-exhaustive (and (slot-exists-p obj 'multi-value)
   3549                            (oref obj multi-value))
   3550       ('nil          (list value))
   3551       ((or 't 'rest) (list value))
   3552       ('repeat       value))))
   3553 
   3554 (cl-defgeneric transient-infix-value (obj)
   3555   "Return the value of the suffix object OBJ.
   3556 
   3557 This function is called by `transient-args' (which see), meaning
   3558 this function is how the value of a transient is determined so
   3559 that the invoked suffix command can use it.
   3560 
   3561 Currently most values are strings, but that is not set in stone.
   3562 Nil is not a value, it means \"no value\".
   3563 
   3564 Usually only infixes have a value, but see the method for
   3565 `transient-suffix'.")
   3566 
   3567 (cl-defmethod transient-infix-value ((_   transient-suffix))
   3568   "Return nil, which means \"no value\".
   3569 
   3570 Infix arguments contribute the transient's value while suffix
   3571 commands consume it.  This function is called for suffixes anyway
   3572 because a command that both contributes to the transient's value
   3573 and also consumes it is not completely unconceivable.
   3574 
   3575 If you define such a command, then you must define a derived
   3576 class and implement this function because this default method
   3577 does nothing." nil)
   3578 
   3579 (cl-defmethod transient-infix-value ((obj transient-infix))
   3580   "Return the value of OBJ's `value' slot."
   3581   (oref obj value))
   3582 
   3583 (cl-defmethod transient-infix-value ((obj transient-option))
   3584   "Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
   3585   (and-let* ((value (oref obj value)))
   3586     (let ((arg (oref obj argument)))
   3587       (pcase-exhaustive (oref obj multi-value)
   3588         ('nil          (concat arg value))
   3589         ((or 't 'rest) (cons arg value))
   3590         ('repeat       (mapcar (lambda (v) (concat arg v)) value))))))
   3591 
   3592 (cl-defmethod transient-infix-value ((_   transient-variable))
   3593   "Return nil, which means \"no value\".
   3594 
   3595 Setting the value of a variable is done by, well, setting the
   3596 value of the variable.  I.e., this is a side-effect and does
   3597 not contribute to the value of the transient."
   3598   nil)
   3599 
   3600 ;;;; Utilities
   3601 
   3602 (defun transient-arg-value (arg args)
   3603   "Return the value of ARG as it appears in ARGS.
   3604 
   3605 For a switch return a boolean.  For an option return the value as
   3606 a string, using the empty string for the empty value, or nil if
   3607 the option does not appear in ARGS."
   3608   (if (string-suffix-p "=" arg)
   3609       (save-match-data
   3610         (and-let* ((match (let ((case-fold-search nil)
   3611                                 (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
   3612                                             (substring arg 0 -1))))
   3613                             (cl-find-if (lambda (a)
   3614                                           (and (stringp a)
   3615                                                (string-match re a)))
   3616                                         args))))
   3617           (or (match-string 1 match) "")))
   3618     (and (member arg args) t)))
   3619 
   3620 (defun transient-scope ()
   3621   "Return the value of the `scope' slot of the current prefix."
   3622   (oref (transient-prefix-object) scope))
   3623 
   3624 ;;; History
   3625 
   3626 (cl-defgeneric transient--history-key (obj)
   3627   "Return OBJ's history key.
   3628 If the value of the `history-key' slot is non-nil, then return
   3629 that.  Otherwise return the value of the `command' slot."
   3630   (or (oref obj history-key)
   3631       (oref obj command)))
   3632 
   3633 (cl-defgeneric transient--history-push (obj)
   3634   "Push the current value of OBJ to its entry in `transient-history'."
   3635   (let ((key (transient--history-key obj)))
   3636     (setf (alist-get key transient-history)
   3637           (let ((args (transient-get-value)))
   3638             (cons args (delete args (alist-get key transient-history)))))))
   3639 
   3640 (cl-defgeneric transient--history-init (obj)
   3641   "Initialize OBJ's `history' slot.
   3642 This is the transient-wide history; many individual infixes also
   3643 have a history of their own.")
   3644 
   3645 (cl-defmethod transient--history-init ((obj transient-prefix))
   3646   "Initialize OBJ's `history' slot from the variable `transient-history'."
   3647   (let ((val (oref obj value)))
   3648     (oset obj history
   3649           (cons val (delete val (alist-get (transient--history-key obj)
   3650                                            transient-history))))))
   3651 
   3652 ;;; Draw
   3653 
   3654 (defun transient--show-brief ()
   3655   (let ((message-log-max nil))
   3656     (if (and transient-show-popup (<= transient-show-popup 0))
   3657         (message "%s-" (key-description (this-command-keys)))
   3658       (message
   3659        "%s- [%s] %s"
   3660        (key-description (this-command-keys))
   3661        (oref transient--prefix command)
   3662        (mapconcat
   3663         #'identity
   3664         (sort
   3665          (cl-mapcan
   3666           (lambda (suffix)
   3667             (let ((key (kbd (oref suffix key))))
   3668               ;; Don't list any common commands.
   3669               (and (not (memq (oref suffix command)
   3670                               `(,(lookup-key transient-map key)
   3671                                 ,(lookup-key transient-sticky-map key)
   3672                                 ;; From transient-common-commands:
   3673                                 transient-set
   3674                                 transient-save
   3675                                 transient-history-prev
   3676                                 transient-history-next
   3677                                 transient-quit-one
   3678                                 transient-toggle-common
   3679                                 transient-set-level)))
   3680                    (list (propertize (oref suffix key) 'face 'transient-key)))))
   3681           transient--suffixes)
   3682          #'string<)
   3683         (propertize "|" 'face 'transient-delimiter))))))
   3684 
   3685 (defun transient--show ()
   3686   (transient--timer-cancel)
   3687   (setq transient--showp t)
   3688   (let ((transient--shadowed-buffer (current-buffer))
   3689         (focus nil))
   3690     (setq transient--buffer (get-buffer-create transient--buffer-name))
   3691     (with-current-buffer transient--buffer
   3692       (when transient-enable-popup-navigation
   3693         (setq focus (or (button-get (point) 'command)
   3694                         (and (not (bobp))
   3695                              (button-get (1- (point)) 'command))
   3696                         (transient--heading-at-point))))
   3697       (erase-buffer)
   3698       (run-hooks 'transient-setup-buffer-hook)
   3699       (when transient-force-fixed-pitch
   3700         (transient--force-fixed-pitch))
   3701       (setq window-size-fixed t)
   3702       (when (bound-and-true-p tab-line-format)
   3703         (setq tab-line-format nil))
   3704       (setq header-line-format nil)
   3705       (setq mode-line-format
   3706             (if (or (natnump transient-mode-line-format)
   3707                     (eq transient-mode-line-format 'line))
   3708                 nil
   3709               transient-mode-line-format))
   3710       (setq mode-line-buffer-identification
   3711             (symbol-name (oref transient--prefix command)))
   3712       (if transient-enable-popup-navigation
   3713           (setq-local cursor-in-non-selected-windows 'box)
   3714         (setq cursor-type nil))
   3715       (setq display-line-numbers nil)
   3716       (setq show-trailing-whitespace nil)
   3717       (transient--insert-groups)
   3718       (when (or transient--helpp transient--editp)
   3719         (transient--insert-help))
   3720       (when-let ((line (transient--separator-line)))
   3721         (insert line)))
   3722     (unless (window-live-p transient--window)
   3723       (setq transient--window
   3724             (display-buffer transient--buffer
   3725                             transient-display-buffer-action)))
   3726     (when (window-live-p transient--window)
   3727       (with-selected-window transient--window
   3728         (set-window-parameter nil 'prev--no-other-window
   3729                               (window-parameter nil 'no-other-window))
   3730         (set-window-parameter nil 'no-other-window t)
   3731         (goto-char (point-min))
   3732         (when transient-enable-popup-navigation
   3733           (transient--goto-button focus))
   3734         (transient--fit-window-to-buffer transient--window)))))
   3735 
   3736 (defun transient--fit-window-to-buffer (window)
   3737   (let ((window-resize-pixelwise t)
   3738         (window-size-fixed nil))
   3739     (if (eq (car (window-parameter window 'quit-restore)) 'other)
   3740         ;; Grow but never shrink window that previously displayed
   3741         ;; another buffer and is going to display that again.
   3742         (fit-window-to-buffer window nil (window-height window))
   3743       (fit-window-to-buffer window nil 1))))
   3744 
   3745 (defun transient--separator-line ()
   3746   (and-let* ((height (cond ((not window-system) nil)
   3747                            ((natnump transient-mode-line-format)
   3748                             transient-mode-line-format)
   3749                            ((eq transient-mode-line-format 'line) 1)))
   3750              (face `(,@(and (>= emacs-major-version 27) '(:extend t))
   3751                      :background
   3752                      ,(or (face-foreground (transient--key-face nil 'non-suffix)
   3753                                            nil t)
   3754                           "#gray60"))))
   3755     (concat (propertize "__" 'face face 'display `(space :height (,height)))
   3756             (propertize "\n" 'face face 'line-height t))))
   3757 
   3758 (defmacro transient-with-shadowed-buffer (&rest body)
   3759   "While in the transient buffer, temporarily make the shadowed buffer current."
   3760   (declare (indent 0) (debug t))
   3761   `(with-current-buffer (or transient--shadowed-buffer (current-buffer))
   3762      ,@body))
   3763 
   3764 (defun transient--insert-groups ()
   3765   (let ((groups (cl-mapcan (lambda (group)
   3766                              (let ((hide (oref group hide)))
   3767                                (and (not (and (functionp hide)
   3768                                               (transient-with-shadowed-buffer
   3769                                                 (funcall hide))))
   3770                                     (list group))))
   3771                            transient--layout)))
   3772     (while-let ((group (pop groups)))
   3773       (transient--insert-group group)
   3774       (when groups
   3775         (insert ?\n)))))
   3776 
   3777 (defvar transient--max-group-level 1)
   3778 
   3779 (cl-defgeneric transient--insert-group (group)
   3780   "Format GROUP and its elements and insert the result.")
   3781 
   3782 (cl-defmethod transient--insert-group :around ((group transient-group))
   3783   "Insert GROUP's description, if any."
   3784   (when-let ((desc (transient-with-shadowed-buffer
   3785                      (transient-format-description group))))
   3786     (insert desc ?\n))
   3787   (let ((transient--max-group-level
   3788          (max (oref group level) transient--max-group-level))
   3789         (transient--pending-group group))
   3790     (cl-call-next-method group)))
   3791 
   3792 (cl-defmethod transient--insert-group ((group transient-row))
   3793   (transient--maybe-pad-keys group)
   3794   (dolist (suffix (oref group suffixes))
   3795     (insert (transient-with-shadowed-buffer (transient-format suffix)))
   3796     (insert "   "))
   3797   (insert ?\n))
   3798 
   3799 (cl-defmethod transient--insert-group ((group transient-column)
   3800                                        &optional skip-empty)
   3801   (transient--maybe-pad-keys group)
   3802   (dolist (suffix (oref group suffixes))
   3803     (let ((str (transient-with-shadowed-buffer (transient-format suffix))))
   3804       (unless (and (not skip-empty) (equal str ""))
   3805         (insert str)
   3806         (unless (string-match-p ".\n\\'" str)
   3807           (insert ?\n))))))
   3808 
   3809 (cl-defmethod transient--insert-group ((group transient-columns))
   3810   (if transient-force-single-column
   3811       (dolist (group (oref group suffixes))
   3812         (transient--insert-group group t))
   3813     (let* ((columns
   3814             (mapcar
   3815              (lambda (column)
   3816                (transient--maybe-pad-keys column group)
   3817                (transient-with-shadowed-buffer
   3818                  `(,@(and-let* ((desc (transient-format-description column)))
   3819                        (list desc))
   3820                    ,@(let ((transient--pending-group column))
   3821                        (mapcar #'transient-format (oref column suffixes))))))
   3822              (oref group suffixes)))
   3823            (stops (transient--column-stops columns)))
   3824       (dolist (row (apply #'transient--mapn #'list columns))
   3825         (let ((stops stops))
   3826           (dolist (cell row)
   3827             (let ((stop (pop stops)))
   3828               (when cell
   3829                 (transient--align-to stop)
   3830                 (insert cell)))))
   3831         (insert ?\n)))))
   3832 
   3833 (cl-defmethod transient--insert-group ((group transient-subgroups))
   3834   (let ((subgroups (oref group suffixes)))
   3835     (while-let ((subgroup (pop subgroups)))
   3836       (transient--maybe-pad-keys subgroup group)
   3837       (transient--insert-group subgroup)
   3838       (when subgroups
   3839         (insert ?\n)))))
   3840 
   3841 (cl-defgeneric transient-format (obj)
   3842   "Format and return OBJ for display.
   3843 
   3844 When this function is called, then the current buffer is some
   3845 temporary buffer.  If you need the buffer from which the prefix
   3846 command was invoked to be current, then do so by temporarily
   3847 making `transient--original-buffer' current.")
   3848 
   3849 (cl-defmethod transient-format ((arg string))
   3850   "Return the string ARG after applying the `transient-heading' face."
   3851   (propertize arg 'face 'transient-heading))
   3852 
   3853 (cl-defmethod transient-format ((_   null))
   3854   "Return a string containing just the newline character."
   3855   "\n")
   3856 
   3857 (cl-defmethod transient-format ((arg integer))
   3858   "Return a string containing just the ARG character."
   3859   (char-to-string arg))
   3860 
   3861 (cl-defmethod transient-format :around ((obj transient-suffix))
   3862   "Add additional formatting if appropriate.
   3863 When reading user input for this infix, then highlight it.
   3864 When edit-mode is enabled, then prepend the level information.
   3865 When `transient-enable-popup-navigation' is non-nil then format
   3866 as a button."
   3867   (let ((str (cl-call-next-method obj)))
   3868     (when (and (cl-typep obj 'transient-infix)
   3869                (eq (oref obj command) this-original-command)
   3870                (active-minibuffer-window))
   3871       (setq str (transient--add-face str 'transient-active-infix)))
   3872     (when transient--editp
   3873       (setq str (concat (let ((level (oref obj level)))
   3874                           (propertize (format " %s " level)
   3875                                       'face (if (transient--use-level-p level t)
   3876                                                 'transient-enabled-suffix
   3877                                               'transient-disabled-suffix)))
   3878                         str)))
   3879     (when (and transient-enable-popup-navigation
   3880                (slot-boundp obj 'command))
   3881       (setq str (make-text-button str nil
   3882                                   'type 'transient
   3883                                   'command (oref obj command))))
   3884     str))
   3885 
   3886 (cl-defmethod transient-format ((obj transient-infix))
   3887   "Return a string generated using OBJ's `format'.
   3888 %k is formatted using `transient-format-key'.
   3889 %d is formatted using `transient-format-description'.
   3890 %v is formatted using `transient-format-value'."
   3891   (format-spec (oref obj format)
   3892                `((?k . ,(transient-format-key obj))
   3893                  (?d . ,(transient-format-description obj))
   3894                  (?v . ,(transient-format-value obj)))))
   3895 
   3896 (cl-defmethod transient-format ((obj transient-suffix))
   3897   "Return a string generated using OBJ's `format'.
   3898 %k is formatted using `transient-format-key'.
   3899 %d is formatted using `transient-format-description'."
   3900   (format-spec (oref obj format)
   3901                `((?k . ,(transient-format-key obj))
   3902                  (?d . ,(transient-format-description obj)))))
   3903 
   3904 (cl-defgeneric transient-format-key (obj)
   3905   "Format OBJ's `key' for display and return the result.")
   3906 
   3907 (cl-defmethod transient-format-key :around ((obj transient-suffix))
   3908   "Add `transient-inapt-suffix' face if suffix is inapt."
   3909   (let ((str (cl-call-next-method)))
   3910     (if (oref obj inapt)
   3911         (transient--add-face str 'transient-inapt-suffix)
   3912       str)))
   3913 
   3914 (cl-defmethod transient-format-key ((obj transient-suffix))
   3915   "Format OBJ's `key' for display and return the result."
   3916   (let ((key (if (slot-boundp obj 'key) (oref obj key) ""))
   3917         (cmd (and (slot-boundp obj 'command) (oref obj command))))
   3918     (when-let ((width (oref transient--pending-group pad-keys)))
   3919       (setq key (truncate-string-to-width key width nil ?\s)))
   3920     (if transient--redisplay-key
   3921         (let ((len (length transient--redisplay-key))
   3922               (seq (cl-coerce (edmacro-parse-keys key t) 'list)))
   3923           (cond
   3924            ((member (seq-take seq len)
   3925                     (list transient--redisplay-key
   3926                           (thread-last transient--redisplay-key
   3927                             (cl-substitute ?- 'kp-subtract)
   3928                             (cl-substitute ?= 'kp-equal)
   3929                             (cl-substitute ?+ 'kp-add))))
   3930             (let ((pre (key-description (vconcat (seq-take seq len))))
   3931                   (suf (key-description (vconcat (seq-drop seq len)))))
   3932               (setq pre (string-replace "RET" "C-m" pre))
   3933               (setq pre (string-replace "TAB" "C-i" pre))
   3934               (setq suf (string-replace "RET" "C-m" suf))
   3935               (setq suf (string-replace "TAB" "C-i" suf))
   3936               ;; We use e.g., "-k" instead of the more correct "- k",
   3937               ;; because the former is prettier.  If we did that in
   3938               ;; the definition, then we want to drop the space that
   3939               ;; is reinserted above.  False-positives are possible
   3940               ;; for silly bindings like "-C-c C-c".
   3941               (unless (string-search " " key)
   3942                 (setq pre (string-replace " " "" pre))
   3943                 (setq suf (string-replace " " "" suf)))
   3944               (concat (propertize pre 'face 'transient-unreachable-key)
   3945                       (and (string-prefix-p (concat pre " ") key) " ")
   3946                       (propertize suf 'face (transient--key-face cmd))
   3947                       (save-excursion
   3948                         (and (string-match " +\\'" key)
   3949                              (propertize (match-string 0 key)
   3950                                          'face 'fixed-pitch))))))
   3951            ((transient--lookup-key transient-sticky-map (kbd key))
   3952             (propertize key 'face (transient--key-face cmd)))
   3953            (t
   3954             (propertize key 'face 'transient-unreachable-key))))
   3955       (propertize key 'face (transient--key-face cmd)))))
   3956 
   3957 (cl-defmethod transient-format-key :around ((obj transient-argument))
   3958   "Handle `transient-highlight-mismatched-keys'."
   3959   (let ((key (cl-call-next-method obj)))
   3960     (cond
   3961      ((not transient-highlight-mismatched-keys) key)
   3962      ((not (slot-boundp obj 'shortarg))
   3963       (transient--add-face key 'transient-nonstandard-key))
   3964      ((not (string-equal key (oref obj shortarg)))
   3965       (transient--add-face key 'transient-mismatched-key))
   3966      (key))))
   3967 
   3968 (cl-defgeneric transient-format-description (obj)
   3969   "Format OBJ's `description' for display and return the result.")
   3970 
   3971 (cl-defmethod transient-format-description ((obj transient-suffix))
   3972   "The `description' slot may be a function, in which case that is
   3973 called inside the correct buffer (see `transient--insert-group')
   3974 and its value is returned to the caller."
   3975   (transient--get-description obj))
   3976 
   3977 (cl-defmethod transient-format-description ((obj transient-value-preset))
   3978   (pcase-let* (((eieio description key set) obj)
   3979                ((eieio value) transient--prefix)
   3980                (active (seq-set-equal-p set value)))
   3981     (format
   3982      "%s %s"
   3983      (propertize (or description (format "Preset %s" key))
   3984                  'face (and active 'transient-argument))
   3985      (format (propertize "(%s)" 'face 'transient-delimiter)
   3986              (mapconcat (lambda (arg)
   3987                           (propertize
   3988                            arg 'face (cond (active 'transient-argument)
   3989                                            ((member arg value)
   3990                                             '((:weight demibold)
   3991                                               transient-inactive-argument))
   3992                                            ('transient-inactive-argument))))
   3993                         set " ")))))
   3994 
   3995 (cl-defmethod transient-format-description ((obj transient-group))
   3996   "Format the description by calling the next method.
   3997 If the result doesn't use the `face' property at all, then apply the
   3998 face `transient-heading' to the complete string."
   3999   (and-let* ((desc (transient--get-description obj)))
   4000     (cond ((oref obj inapt)
   4001            (propertize desc 'face 'transient-inapt-suffix))
   4002           ((text-property-not-all 0 (length desc) 'face nil desc)
   4003            desc)
   4004           ((propertize desc 'face 'transient-heading)))))
   4005 
   4006 (cl-defmethod transient-format-description :around ((obj transient-suffix))
   4007   "Format the description by calling the next method.
   4008 If the result is nil, then use \"(BUG: no description)\" as the
   4009 description.  If the OBJ's `key' is currently unreachable, then
   4010 apply the face `transient-unreachable' to the complete string."
   4011   (let ((desc (or (cl-call-next-method obj)
   4012                   (and (slot-boundp transient--prefix 'suffix-description)
   4013                        (funcall (oref transient--prefix suffix-description)
   4014                                 obj)))))
   4015     (if desc
   4016         (when-let ((face (transient--get-face obj 'face)))
   4017           (setq desc (transient--add-face desc face t)))
   4018       (setq desc (propertize "(BUG: no description)" 'face 'error)))
   4019     (when (if transient--all-levels-p
   4020               (> (oref obj level) transient--default-prefix-level)
   4021             (and transient-highlight-higher-levels
   4022                  (> (max (oref obj level) transient--max-group-level)
   4023                     transient--default-prefix-level)))
   4024       (setq desc (transient--add-face desc 'transient-higher-level)))
   4025     (when-let ((inapt-face (and (oref obj inapt)
   4026                                 (transient--get-face obj 'inapt-face))))
   4027       (setq desc (transient--add-face desc inapt-face)))
   4028     (when (and (slot-boundp obj 'key)
   4029                (transient--key-unreachable-p obj))
   4030       (setq desc (transient--add-face desc 'transient-unreachable)))
   4031     desc))
   4032 
   4033 (cl-defgeneric transient-format-value (obj)
   4034   "Format OBJ's value for display and return the result.")
   4035 
   4036 (cl-defmethod transient-format-value ((obj transient-suffix))
   4037   (propertize (oref obj argument)
   4038               'face (if (oref obj value)
   4039                         'transient-argument
   4040                       'transient-inactive-argument)))
   4041 
   4042 (cl-defmethod transient-format-value ((obj transient-option))
   4043   (let ((argument (oref obj argument)))
   4044     (if-let ((value (oref obj value)))
   4045         (pcase-exhaustive (oref obj multi-value)
   4046           ('nil
   4047            (concat (propertize argument 'face 'transient-argument)
   4048                    (propertize value    'face 'transient-value)))
   4049           ((or 't 'rest)
   4050            (concat (propertize (if (string-suffix-p " " argument)
   4051                                    argument
   4052                                  (concat argument " "))
   4053                                'face 'transient-argument)
   4054                    (propertize (mapconcat #'prin1-to-string value " ")
   4055                                'face 'transient-value)))
   4056           ('repeat
   4057            (mapconcat (lambda (value)
   4058                         (concat (propertize argument 'face 'transient-argument)
   4059                                 (propertize value    'face 'transient-value)))
   4060                       value " ")))
   4061       (propertize argument 'face 'transient-inactive-argument))))
   4062 
   4063 (cl-defmethod transient-format-value ((obj transient-switches))
   4064   (with-slots (value argument-format choices) obj
   4065     (format (propertize argument-format
   4066                         'face (if value
   4067                                   'transient-argument
   4068                                 'transient-inactive-argument))
   4069             (format
   4070              (propertize "[%s]" 'face 'transient-delimiter)
   4071              (mapconcat
   4072               (lambda (choice)
   4073                 (propertize choice 'face
   4074                             (if (equal (format argument-format choice) value)
   4075                                 'transient-value
   4076                               'transient-inactive-value)))
   4077               choices
   4078               (propertize "|" 'face 'transient-delimiter))))))
   4079 
   4080 (cl-defmethod transient--get-description ((obj transient-child))
   4081   (and-let* ((desc (oref obj description)))
   4082     (if (functionp desc)
   4083         (if (= (car (transient--func-arity desc)) 1)
   4084             (funcall desc obj)
   4085           (funcall desc))
   4086       desc)))
   4087 
   4088 (cl-defmethod transient--get-face ((obj transient-suffix) slot)
   4089   (and-let* (((slot-boundp obj slot))
   4090              (face (slot-value obj slot)))
   4091     (if (and (not (facep face))
   4092              (functionp face))
   4093         (let ((transient--pending-suffix obj))
   4094           (if (= (car (transient--func-arity face)) 1)
   4095               (funcall face obj)
   4096             (funcall face)))
   4097       face)))
   4098 
   4099 (defun transient--add-face (string face &optional append beg end)
   4100   (let ((str (copy-sequence string)))
   4101     (add-face-text-property (or beg 0) (or end (length str)) face append str)
   4102     str))
   4103 
   4104 (defun transient--key-face (&optional cmd enforce-type)
   4105   (or (and transient-semantic-coloring
   4106            (not transient--helpp)
   4107            (not transient--editp)
   4108            (or (and cmd (get cmd 'transient-face))
   4109                (get (transient--get-pre-command cmd enforce-type)
   4110                     'transient-face)))
   4111       (if cmd 'transient-key 'transient-key-noop)))
   4112 
   4113 (defun transient--key-unreachable-p (obj)
   4114   (and transient--redisplay-key
   4115        (let ((key (oref obj key)))
   4116          (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list)
   4117                                    (length transient--redisplay-key))
   4118                          transient--redisplay-key)
   4119                   (transient--lookup-key transient-sticky-map (kbd key)))))))
   4120 
   4121 (defun transient--lookup-key (keymap key)
   4122   (let ((val (lookup-key keymap key)))
   4123     (and val (not (integerp val)) val)))
   4124 
   4125 (defun transient--maybe-pad-keys (group &optional parent)
   4126   (when-let ((pad (or (oref group pad-keys)
   4127                       (and parent (oref parent pad-keys)))))
   4128     (oset group pad-keys
   4129           (apply #'max
   4130                  (if (integerp pad) pad 0)
   4131                  (seq-keep (lambda (suffix)
   4132                              (and (eieio-object-p suffix)
   4133                                   (slot-boundp suffix 'key)
   4134                                   (length (oref suffix key))))
   4135                            (oref group suffixes))))))
   4136 
   4137 (defun transient--pixel-width (string)
   4138   (save-window-excursion
   4139     (with-temp-buffer
   4140       (insert string)
   4141       (set-window-dedicated-p nil nil)
   4142       (set-window-buffer nil (current-buffer))
   4143       (car (window-text-pixel-size
   4144             nil (line-beginning-position) (point))))))
   4145 
   4146 (defun transient--column-stops (columns)
   4147   (let* ((var-pitch (or transient-align-variable-pitch
   4148                         (oref transient--prefix variable-pitch)))
   4149          (char-width (and var-pitch (transient--pixel-width " "))))
   4150     (transient--seq-reductions-from
   4151      (apply-partially #'+ (* 2 (if var-pitch char-width 1)))
   4152      (transient--mapn
   4153       (lambda (cells min)
   4154         (apply #'max
   4155                (if min (if var-pitch (* min char-width) min) 0)
   4156                (mapcar (if var-pitch #'transient--pixel-width #'length) cells)))
   4157       columns
   4158       (oref transient--prefix column-widths))
   4159      0)))
   4160 
   4161 (defun transient--align-to (stop)
   4162   (unless (zerop stop)
   4163     (insert (if (or transient-align-variable-pitch
   4164                     (oref transient--prefix variable-pitch))
   4165                 (propertize " " 'display `(space :align-to (,stop)))
   4166               (make-string (max 0 (- stop (current-column))) ?\s)))))
   4167 
   4168 (defun transient-command-summary-or-name (obj)
   4169   "Return the summary or name of the command represented by OBJ.
   4170 
   4171 If the command has a doc-string, then return the first line of
   4172 that, else its name.
   4173 
   4174 Intended to be temporarily used as the `:suffix-description' of
   4175 a prefix command, while porting a regular keymap to a transient."
   4176   (let ((command (oref obj command)))
   4177     (if-let ((doc (documentation command)))
   4178         (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face)
   4179       (propertize (symbol-name command) 'face 'font-lock-function-name-face))))
   4180 
   4181 ;;; Help
   4182 
   4183 (cl-defgeneric transient-show-help (obj)
   4184   "Show documentation for the command represented by OBJ.")
   4185 
   4186 (cl-defmethod transient-show-help ((obj transient-prefix))
   4187   "Call `show-help' if non-nil, else show `info-manual',
   4188 if non-nil, else show the `man-page' if non-nil, else use
   4189 `describe-function'."
   4190   (with-slots (show-help info-manual man-page command) obj
   4191     (cond (show-help (funcall show-help obj))
   4192           (info-manual (transient--show-manual info-manual))
   4193           (man-page (transient--show-manpage man-page))
   4194           ((transient--describe-function command)))))
   4195 
   4196 (cl-defmethod transient-show-help ((obj transient-suffix))
   4197   "Call `show-help' if non-nil, else use `describe-function'.
   4198 Also used to dispatch showing documentation for the current
   4199 prefix.  If the suffix is a sub-prefix, then also call the
   4200 prefix method."
   4201   (cond
   4202    ((eq this-command 'transient-help)
   4203     (transient-show-help transient--prefix))
   4204    ((let ((prefix (get (oref obj command)
   4205                        'transient--prefix)))
   4206       (and prefix (not (eq (oref transient--prefix command) this-command))
   4207            (prog1 t (transient-show-help prefix)))))
   4208    ((if-let ((show-help (oref obj show-help)))
   4209         (funcall show-help obj)
   4210       (transient--describe-function this-command)))))
   4211 
   4212 (cl-defmethod transient-show-help ((obj transient-infix))
   4213   "Call `show-help' if non-nil, else show the `man-page'
   4214 if non-nil, else use `describe-function'.  When showing the
   4215 manpage, then try to jump to the correct location."
   4216   (if-let ((show-help (oref obj show-help)))
   4217       (funcall show-help obj)
   4218     (if-let ((man-page (oref transient--prefix man-page))
   4219              (argument (and (slot-boundp obj 'argument)
   4220                             (oref obj argument))))
   4221         (transient--show-manpage man-page argument)
   4222       (transient--describe-function this-command))))
   4223 
   4224 ;; `cl-generic-generalizers' doesn't support `command' et al.
   4225 (cl-defmethod transient-show-help (cmd)
   4226   "Show the command doc-string."
   4227   (transient--describe-function cmd))
   4228 
   4229 (defmacro transient-with-help-window (&rest body)
   4230   "Evaluate BODY, send output to *Help* buffer, and display it in a window.
   4231 Select the help window, and make the help buffer current and return it."
   4232   (declare (indent 0))
   4233   `(let ((buffer nil)
   4234          (help-window-select t))
   4235      (with-help-window (help-buffer)
   4236        ,@body
   4237        (setq buffer (current-buffer)))
   4238      (set-buffer buffer)))
   4239 
   4240 (defun transient--describe-function (fn)
   4241   (let* ((buffer nil)
   4242          (help-window-select t)
   4243          (temp-buffer-window-setup-hook
   4244           (cons (lambda () (setq buffer (current-buffer)))
   4245                 temp-buffer-window-setup-hook)))
   4246     (describe-function fn)
   4247     (set-buffer buffer)))
   4248 
   4249 (defun transient--show-manual (manual)
   4250   (info manual))
   4251 
   4252 (defun transient--show-manpage (manpage &optional argument)
   4253   (require 'man)
   4254   (let* ((Man-notify-method 'meek)
   4255          (buf (Man-getpage-in-background manpage))
   4256          (proc (get-buffer-process buf)))
   4257     (while (and proc (eq (process-status proc) 'run))
   4258       (accept-process-output proc))
   4259     (switch-to-buffer buf)
   4260     (when argument
   4261       (transient--goto-argument-description argument))))
   4262 
   4263 (defun transient--goto-argument-description (arg)
   4264   (goto-char (point-min))
   4265   (let ((case-fold-search nil)
   4266         ;; This matches preceding/proceeding options.  Options
   4267         ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>"
   4268         ;; are matched by this regex without the shy group.
   4269         ;; The ". " in the shy group is for options such as
   4270         ;; "-m parent-number", and the "-[^[:space:]]+ " is
   4271         ;; for options such as "--mainline parent-number"
   4272         (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
   4273     (when (re-search-forward
   4274            (if (equal arg "--")
   4275                ;; Special case.
   4276                "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)"
   4277              ;; Should start with whitespace and may have
   4278              ;; any number of options before and/or after.
   4279              (format
   4280               "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
   4281               others
   4282               ;; Options don't necessarily end in an "="
   4283               ;; (e.g., "--gpg-sign[=<keyid>]")
   4284               (string-remove-suffix "=" arg)
   4285               ;; Simple options don't end in an "=".  Splitting this
   4286               ;; into 2 cases should make getting false positives
   4287               ;; less likely.
   4288               (if (string-suffix-p "=" arg)
   4289                   ;; "[^[:space:]]*[^.[:space:]]" matches the option
   4290                   ;; value, which is usually after the option name
   4291                   ;; and either '=' or '[='.  The value can't end in
   4292                   ;; a period, as that means it's being used at the
   4293                   ;; end of a sentence.  The space is for options
   4294                   ;; such as '--mainline parent-number'.
   4295                   "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
   4296                 ;; Either this doesn't match anything (e.g., "-a"),
   4297                 ;; or the option is followed by a value delimited
   4298                 ;; by a "[", "<", or ":".  A space might appear
   4299                 ;; before this value, as in "-f <file>".  The
   4300                 ;; space alternative is for options such as
   4301                 ;; "-m parent-number".
   4302                 "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
   4303               others))
   4304            nil t)
   4305       (goto-char (match-beginning 1)))))
   4306 
   4307 (defun transient--insert-help ()
   4308   (unless (looking-back "\n\n" 2)
   4309     (insert "\n"))
   4310   (when transient--helpp
   4311     (insert
   4312      (format (propertize "\
   4313 Type a %s to show help for that suffix command, or %s to show manual.
   4314 Type %s to exit help.\n"
   4315                          'face 'transient-heading)
   4316              (propertize "<KEY>" 'face 'transient-key)
   4317              (propertize "?"     'face 'transient-key)
   4318              (propertize "C-g"   'face 'transient-key))))
   4319   (when transient--editp
   4320     (unless transient--helpp
   4321       (insert
   4322        (format (propertize "\
   4323 Type a %s to set level for that suffix command.
   4324 Type %s to set what levels are available for this prefix command.\n"
   4325                            'face 'transient-heading)
   4326                (propertize "<KEY>" 'face 'transient-key)
   4327                (propertize "C-x l" 'face 'transient-key))))
   4328     (with-slots (level) transient--prefix
   4329       (insert
   4330        (format (propertize "
   4331 Suffixes on levels %s are available.
   4332 Suffixes on levels %s and %s are unavailable.\n"
   4333                            'face 'transient-heading)
   4334                (propertize (format "1-%s" level)
   4335                            'face 'transient-enabled-suffix)
   4336                (propertize " 0 "
   4337                            'face 'transient-disabled-suffix)
   4338                (propertize (format ">=%s" (1+ level))
   4339                            'face 'transient-disabled-suffix))))))
   4340 
   4341 ;;; Popup Navigation
   4342 
   4343 (defun transient-scroll-up (&optional arg)
   4344   "Scroll text of transient popup window upward ARG lines.
   4345 If ARG is nil scroll near full screen.  This is a wrapper
   4346 around `scroll-up-command' (which see)."
   4347   (interactive "^P")
   4348   (with-selected-window transient--window
   4349     (scroll-up-command arg)))
   4350 
   4351 (defun transient-scroll-down (&optional arg)
   4352   "Scroll text of transient popup window down ARG lines.
   4353 If ARG is nil scroll near full screen.  This is a wrapper
   4354 around `scroll-down-command' (which see)."
   4355   (interactive "^P")
   4356   (with-selected-window transient--window
   4357     (scroll-down-command arg)))
   4358 
   4359 (defun transient-backward-button (n)
   4360   "Move to the previous button in the transient popup buffer.
   4361 See `backward-button' for information about N."
   4362   (interactive "p")
   4363   (with-selected-window transient--window
   4364     (backward-button n t)))
   4365 
   4366 (defun transient-forward-button (n)
   4367   "Move to the next button in the transient popup buffer.
   4368 See `forward-button' for information about N."
   4369   (interactive "p")
   4370   (with-selected-window transient--window
   4371     (forward-button n t)))
   4372 
   4373 (define-button-type 'transient
   4374   'face nil
   4375   'keymap transient-button-map)
   4376 
   4377 (defun transient--goto-button (command)
   4378   (cond
   4379    ((stringp command)
   4380     (when (re-search-forward (concat "^" (regexp-quote command)) nil t)
   4381       (goto-char (match-beginning 0))))
   4382    (command
   4383     (while (and (ignore-errors (forward-button 1))
   4384                 (not (eq (button-get (button-at (point)) 'command) command))))
   4385     (unless (eq (button-get (button-at (point)) 'command) command)
   4386       (goto-char (point-min))
   4387       (forward-button 1)))))
   4388 
   4389 (defun transient--heading-at-point ()
   4390   (and (eq (get-text-property (point) 'face) 'transient-heading)
   4391        (let ((beg (line-beginning-position)))
   4392          (buffer-substring-no-properties
   4393           beg (next-single-property-change
   4394                beg 'face nil (line-end-position))))))
   4395 
   4396 ;;; Compatibility
   4397 ;;;; Popup Isearch
   4398 
   4399 (defvar-keymap transient--isearch-mode-map
   4400   :parent isearch-mode-map
   4401   "<remap> <isearch-exit>"   #'transient-isearch-exit
   4402   "<remap> <isearch-cancel>" #'transient-isearch-cancel
   4403   "<remap> <isearch-abort>"  #'transient-isearch-abort)
   4404 
   4405 (defun transient-isearch-backward (&optional regexp-p)
   4406   "Do incremental search backward.
   4407 With a prefix argument, do an incremental regular expression
   4408 search instead."
   4409   (interactive "P")
   4410   (transient--isearch-setup)
   4411   (let ((isearch-mode-map transient--isearch-mode-map))
   4412     (isearch-mode nil regexp-p)))
   4413 
   4414 (defun transient-isearch-forward (&optional regexp-p)
   4415   "Do incremental search forward.
   4416 With a prefix argument, do an incremental regular expression
   4417 search instead."
   4418   (interactive "P")
   4419   (transient--isearch-setup)
   4420   (let ((isearch-mode-map transient--isearch-mode-map))
   4421     (isearch-mode t regexp-p)))
   4422 
   4423 (defun transient-isearch-exit ()
   4424   "Like `isearch-exit' but adapted for `transient'."
   4425   (interactive)
   4426   (isearch-exit)
   4427   (transient--isearch-exit))
   4428 
   4429 (defun transient-isearch-cancel ()
   4430   "Like `isearch-cancel' but adapted for `transient'."
   4431   (interactive)
   4432   (condition-case nil (isearch-cancel) (quit))
   4433   (transient--isearch-exit))
   4434 
   4435 (defun transient-isearch-abort ()
   4436   "Like `isearch-abort' but adapted for `transient'."
   4437   (interactive)
   4438   (let ((around (lambda (fn)
   4439                   (condition-case nil (funcall fn) (quit))
   4440                   (transient--isearch-exit))))
   4441     (advice-add 'isearch-cancel :around around)
   4442     (unwind-protect
   4443         (isearch-abort)
   4444       (advice-remove 'isearch-cancel around))))
   4445 
   4446 (defun transient--isearch-setup ()
   4447   (select-window transient--window)
   4448   (transient--suspend-override t))
   4449 
   4450 (defun transient--isearch-exit ()
   4451   (select-window transient--original-window)
   4452   (transient--resume-override))
   4453 
   4454 ;;;; Edebug
   4455 
   4456 (defun transient--edebug-command-p ()
   4457   (and (bound-and-true-p edebug-active)
   4458        (or (memq this-command '(top-level abort-recursive-edit))
   4459            (string-prefix-p "edebug" (symbol-name this-command)))))
   4460 
   4461 ;;;; Miscellaneous
   4462 
   4463 (cl-pushnew (list nil (concat "^\\s-*("
   4464                               (eval-when-compile
   4465                                 (regexp-opt
   4466                                  '("transient-define-prefix"
   4467                                    "transient-define-suffix"
   4468                                    "transient-define-infix"
   4469                                    "transient-define-argument")
   4470                                  t))
   4471                               "\\s-+\\(" lisp-mode-symbol-regexp "\\)")
   4472                   2)
   4473             lisp-imenu-generic-expression :test #'equal)
   4474 
   4475 (declare-function which-key-mode "which-key" (&optional arg))
   4476 
   4477 (defun transient--suspend-which-key-mode ()
   4478   (when (bound-and-true-p which-key-mode)
   4479     (which-key-mode -1)
   4480     (add-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
   4481 
   4482 (defun transient--resume-which-key-mode ()
   4483   (unless transient--prefix
   4484     (which-key-mode 1)
   4485     (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
   4486 
   4487 (defun transient-bind-q-to-quit ()
   4488   "Modify some keymaps to bind \"q\" to the appropriate quit command.
   4489 
   4490 \"C-g\" is the default binding for such commands now, but Transient's
   4491 predecessor Magit-Popup used \"q\" instead.  If you would like to get
   4492 that binding back, then call this function in your init file like so:
   4493 
   4494   (with-eval-after-load \\='transient
   4495     (transient-bind-q-to-quit))
   4496 
   4497 Individual transients may already bind \"q\" to something else
   4498 and such a binding would shadow the quit binding.  If that is the
   4499 case then \"Q\" is bound to whatever \"q\" would have been bound
   4500 to by setting `transient-substitute-key-function' to a function
   4501 that does that.  Of course \"Q\" may already be bound to something
   4502 else, so that function binds \"M-q\" to that command instead.
   4503 Of course \"M-q\" may already be bound to something else, but
   4504 we stop there."
   4505   (keymap-set transient-base-map   "q" #'transient-quit-one)
   4506   (keymap-set transient-sticky-map "q" #'transient-quit-seq)
   4507   (setq transient-substitute-key-function
   4508         #'transient-rebind-quit-commands))
   4509 
   4510 (defun transient-rebind-quit-commands (obj)
   4511   "See `transient-bind-q-to-quit'."
   4512   (let ((key (oref obj key)))
   4513     (cond ((string-equal key "q") "Q")
   4514           ((string-equal key "Q") "M-q")
   4515           (key))))
   4516 
   4517 (defun transient--force-fixed-pitch ()
   4518   (require 'face-remap)
   4519   (face-remap-reset-base 'default)
   4520   (face-remap-add-relative 'default 'fixed-pitch))
   4521 
   4522 (defun transient--func-arity (fn)
   4523   (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn))))
   4524 
   4525 (defun transient--seq-reductions-from (function sequence initial-value)
   4526   (let ((acc (list initial-value)))
   4527     (seq-doseq (elt sequence)
   4528       (push (funcall function (car acc) elt) acc))
   4529     (nreverse acc)))
   4530 
   4531 (defun transient--mapn (function &rest lists)
   4532   "Apply FUNCTION to elements of LISTS.
   4533 Like `cl-mapcar' but while that stops when the shortest list
   4534 is exhausted, continue until the longest list is, using nil
   4535 as stand-in for elements of exhausted lists."
   4536   (let (result)
   4537     (while (catch 'more (mapc (lambda (l) (and l (throw 'more t))) lists) nil)
   4538       (push (apply function (mapcar #'car-safe lists)) result)
   4539       (setq lists (mapcar #'cdr lists)))
   4540     (nreverse result)))
   4541 
   4542 ;;; Font-Lock
   4543 
   4544 (defconst transient-font-lock-keywords
   4545   (eval-when-compile
   4546     `((,(concat "("
   4547                 (regexp-opt (list "transient-define-prefix"
   4548                                   "transient-define-infix"
   4549                                   "transient-define-argument"
   4550                                   "transient-define-suffix")
   4551                             t)
   4552                 "\\_>[ \t'(]*"
   4553                 "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
   4554        (1 'font-lock-keyword-face)
   4555        (2 'font-lock-function-name-face nil t)))))
   4556 
   4557 (font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords)
   4558 
   4559 ;;; Auxiliary Classes
   4560 ;;;; `transient-lisp-variable'
   4561 
   4562 (defclass transient-lisp-variable (transient-variable)
   4563   ((reader :initform #'transient-lisp-variable--reader)
   4564    (always-read :initform t)
   4565    (set-value :initarg :set-value :initform #'set))
   4566   "[Experimental] Class used for Lisp variables.")
   4567 
   4568 (cl-defmethod transient-init-value ((obj transient-lisp-variable))
   4569   (oset obj value (symbol-value (oref obj variable))))
   4570 
   4571 (cl-defmethod transient-infix-set ((obj transient-lisp-variable) value)
   4572   (funcall (oref obj set-value)
   4573            (oref obj variable)
   4574            (oset obj value value)))
   4575 
   4576 (cl-defmethod transient-format-description ((obj transient-lisp-variable))
   4577   (or (cl-call-next-method obj)
   4578       (symbol-name (oref obj variable))))
   4579 
   4580 (cl-defmethod transient-format-value ((obj transient-lisp-variable))
   4581   (propertize (prin1-to-string (oref obj value))
   4582               'face 'transient-value))
   4583 
   4584 (cl-defmethod transient-prompt ((obj transient-lisp-variable))
   4585   (if (and (slot-boundp obj 'prompt)
   4586            (oref obj prompt))
   4587       (cl-call-next-method obj)
   4588     (format "Set %s: " (oref obj variable))))
   4589 
   4590 (defun transient-lisp-variable--reader (prompt initial-input _history)
   4591   (read--expression prompt initial-input))
   4592 
   4593 ;;; _
   4594 (provide 'transient)
   4595 ;; Local Variables:
   4596 ;; indent-tabs-mode: nil
   4597 ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode")
   4598 ;; End:
   4599 ;;; transient.el ends here