dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

transient.el (146244B)


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