4134 lines
160 KiB
EmacsLisp
4134 lines
160 KiB
EmacsLisp
;;; transient.el --- Transient commands -*- lexical-binding:t -*-
|
||
|
||
;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
|
||
|
||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||
;; Homepage: https://github.com/magit/transient
|
||
;; Keywords: extensions
|
||
|
||
;; Package-Version: 0.3.7-git
|
||
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.0"))
|
||
|
||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published
|
||
;; by the Free Software Foundation, either version 3 of the License,
|
||
;; or (at your option) any later version.
|
||
;;
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
;;
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Taking inspiration from prefix keys and prefix arguments, Transient
|
||
;; implements a similar abstraction involving a prefix command, infix
|
||
;; arguments and suffix commands. We could call this abstraction a
|
||
;; "transient command", but because it always involves at least two
|
||
;; commands (a prefix and a suffix) we prefer to call it just a
|
||
;; "transient".
|
||
|
||
;; When the user calls a transient prefix command, then a transient
|
||
;; (temporary) keymap is activated, which binds the transient's infix
|
||
;; and suffix commands, and functions that control the transient state
|
||
;; are added to `pre-command-hook' and `post-command-hook'. The
|
||
;; available suffix and infix commands and their state are shown in
|
||
;; the echo area until the transient is exited by invoking a suffix
|
||
;; command.
|
||
|
||
;; Calling an infix command causes its value to be changed, possibly
|
||
;; by reading a new value in the minibuffer.
|
||
|
||
;; Calling a suffix command usually causes the transient to be exited
|
||
;; but suffix commands can also be configured to not exit the
|
||
;; transient state.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'compat)
|
||
(require 'eieio)
|
||
(require 'edmacro)
|
||
(require 'format-spec)
|
||
(require 'seq)
|
||
|
||
(eval-when-compile (require 'subr-x))
|
||
|
||
(declare-function info "info" (&optional file-or-node buffer))
|
||
(declare-function Man-find-section "man" (section))
|
||
(declare-function Man-next-section "man" (n))
|
||
(declare-function Man-getpage-in-background "man" (topic))
|
||
|
||
(defvar display-line-numbers) ; since Emacs 26.1
|
||
(defvar Man-notify-method)
|
||
|
||
(defmacro transient--with-emergency-exit (&rest body)
|
||
(declare (indent defun))
|
||
`(condition-case err
|
||
(let ((debugger #'transient--exit-and-debug))
|
||
,(macroexp-progn body))
|
||
((debug error)
|
||
(transient--emergency-exit)
|
||
(signal (car err) (cdr err)))))
|
||
|
||
(defun transient--exit-and-debug (&rest args)
|
||
(transient--emergency-exit)
|
||
(apply #'debug args))
|
||
|
||
;;; Options
|
||
|
||
(defgroup transient nil
|
||
"Transient commands."
|
||
:group 'extensions)
|
||
|
||
(defcustom transient-show-popup t
|
||
"Whether to show the current transient in a popup buffer.
|
||
\\<transient-map>
|
||
- If t, then show the popup as soon as a transient prefix command
|
||
is invoked.
|
||
|
||
- If nil, then do not show the popup unless the user explicitly
|
||
requests it, by pressing \\[transient-show] or a prefix key.
|
||
|
||
- If a number, then delay displaying the popup and instead show
|
||
a brief one-line summary. If zero or negative, then suppress
|
||
even showing that summary and display the pressed key only.
|
||
|
||
Show the popup when the user explicitly requests it by pressing
|
||
\\[transient-show] or a prefix key. Unless zero, then also show the popup
|
||
after that many seconds of inactivity (using the absolute value)."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type '(choice (const :tag "instantly" t)
|
||
(const :tag "on demand" nil)
|
||
(const :tag "on demand (no summary)" 0)
|
||
(number :tag "after delay" 1)))
|
||
|
||
(defcustom transient-enable-popup-navigation t
|
||
"Whether navigation commands are enabled in the transient popup.
|
||
|
||
While a transient is active the transient popup buffer is not the
|
||
current buffer, making it necessary to use dedicated commands to
|
||
act on that buffer itself. If this is non-nil, then the following
|
||
bindings are available:
|
||
|
||
\\<transient-popup-navigation-map>\
|
||
- \\[transient-backward-button] moves the cursor to the previous suffix.
|
||
- \\[transient-forward-button] moves the cursor to the next suffix.
|
||
- \\[transient-push-button] invokes the suffix the cursor is on.
|
||
\\<transient-button-map>\
|
||
- \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix.
|
||
\\<transient-popup-navigation-map>\
|
||
- \\[transient-isearch-backward]\
|
||
and \\[transient-isearch-forward] start isearch in the popup buffer.
|
||
|
||
\\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'.
|
||
All other bindings are in `transient-popup-navigation-map'.
|
||
|
||
By default \\`M-RET' is bound to `transient-push-button', instead of
|
||
\\`RET', because if a transient allows the invocation of non-suffixes
|
||
then it is likely that you would want \\`RET' to do what it would do
|
||
if no transient were active."
|
||
:package-version '(transient . "0.4.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-display-buffer-action
|
||
'(display-buffer-in-side-window
|
||
(side . bottom)
|
||
(dedicated . t)
|
||
(inhibit-same-window . t)
|
||
(window-parameters (no-other-window . t)))
|
||
"The action used to display the transient popup buffer.
|
||
|
||
The transient popup buffer is displayed in a window using
|
||
|
||
(display-buffer BUFFER transient-display-buffer-action)
|
||
|
||
The value of this option has the form (FUNCTION . ALIST),
|
||
where FUNCTION is a function or a list of functions. Each such
|
||
function should accept two arguments: a buffer to display and an
|
||
alist of the same form as ALIST. See info node `(elisp)Choosing
|
||
Window' for details.
|
||
|
||
The default is:
|
||
|
||
(display-buffer-in-side-window
|
||
(side . bottom)
|
||
(dedicated . t)
|
||
(inhibit-same-window . t)
|
||
(window-parameters (no-other-window . t)))
|
||
|
||
This displays the window at the bottom of the selected frame.
|
||
Another useful FUNCTION is `display-buffer-below-selected', which
|
||
is what `magit-popup' used by default. For more alternatives see
|
||
info node `(elisp)Display Action Functions' and info node
|
||
`(elisp)Buffer Display Action Alists'.
|
||
|
||
Note that the buffer that was current before the transient buffer
|
||
is shown should remain the current buffer. Many suffix commands
|
||
act on the thing at point, if appropriate, and if the transient
|
||
buffer became the current buffer, then that would change what is
|
||
at point. To that effect `inhibit-same-window' ensures that the
|
||
selected window is not used to show the transient buffer.
|
||
|
||
It may be possible to display the window in another frame, but
|
||
whether that works in practice depends on the window-manager.
|
||
If the window manager selects the new window (Emacs frame),
|
||
then that unfortunately changes which buffer is current.
|
||
|
||
If you change the value of this option, then you might also
|
||
want to change the value of `transient-mode-line-format'."
|
||
:package-version '(transient . "0.3.0")
|
||
:group 'transient
|
||
:type '(cons (choice function (repeat :tag "Functions" function))
|
||
alist))
|
||
|
||
(defcustom transient-mode-line-format 'line
|
||
"The mode-line format for the transient popup buffer.
|
||
|
||
If nil, then the buffer has no mode-line. If the buffer is not
|
||
displayed right above the echo area, then this probably is not
|
||
a good value.
|
||
|
||
If `line' (the default), then the buffer also has no mode-line,
|
||
but a thin line is drawn instead, using the background color of
|
||
the face `transient-separator'. Termcap frames cannot display
|
||
thin lines and therefore fallback to treating `line' like nil.
|
||
|
||
Otherwise this can be any mode-line format.
|
||
See `mode-line-format' for details."
|
||
:package-version '(transient . "0.2.0")
|
||
:group 'transient
|
||
:type '(choice (const :tag "hide mode-line" nil)
|
||
(const :tag "substitute thin line" line)
|
||
(const :tag "name of prefix command"
|
||
("%e" mode-line-front-space
|
||
mode-line-buffer-identification))
|
||
(sexp :tag "custom mode-line format")))
|
||
|
||
(defcustom transient-show-common-commands nil
|
||
"Whether to show common transient suffixes in the popup buffer.
|
||
|
||
These commands are always shown after typing the prefix key
|
||
\"C-x\" when a transient command is active. To toggle the value
|
||
of this variable use \"C-x t\" when a transient is active."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-read-with-initial-input nil
|
||
"Whether to use the last history element as initial minibuffer input."
|
||
:package-version '(transient . "0.2.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-highlight-mismatched-keys nil
|
||
"Whether to highlight keys that do not match their argument.
|
||
|
||
This only affects infix arguments that represent command-line
|
||
arguments. When this option is non-nil, then the key binding
|
||
for infix argument are highlighted when only a long argument
|
||
\(e.g. \"--verbose\") is specified but no shor-thand (e.g \"-v\").
|
||
In the rare case that a short-hand is specified but does not
|
||
match the key binding, then it is highlighted differently.
|
||
|
||
The highlighting is done using `transient-mismatched-key'
|
||
and `transient-nonstandard-key'."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-highlight-higher-levels nil
|
||
"Whether to highlight suffixes on higher levels.
|
||
|
||
This is primarily intended for package authors.
|
||
|
||
When non-nil then highlight the description of suffixes whose
|
||
level is above 4, the default of `transient-default-level'.
|
||
Assuming you have set that variable to 7, this highlights all
|
||
suffixes that won't be available to users without them making
|
||
the same customization."
|
||
:package-version '(transient . "0.3.6")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-substitute-key-function nil
|
||
"Function used to modify key bindings.
|
||
|
||
This function is called with one argument, the prefix object,
|
||
and must return a key binding description, either the existing
|
||
key description it finds in the `key' slot, or a substitution.
|
||
|
||
This is intended to let users replace certain prefix keys. It
|
||
could also be used to make other substitutions, but that is
|
||
discouraged.
|
||
|
||
For example, \"=\" is hard to reach using my custom keyboard
|
||
layout, so I substitute \"(\" for that, which is easy to reach
|
||
using a layout optimized for Lisp.
|
||
|
||
(setq transient-substitute-key-function
|
||
(lambda (obj)
|
||
(let ((key (oref obj key)))
|
||
(if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key)
|
||
(replace-match \"(\" t t key 1)
|
||
key)))))"
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type '(choice (const :tag "Transform no keys (nil)" nil) function))
|
||
|
||
(defcustom transient-semantic-coloring nil
|
||
"Whether to color prefixes and suffixes in Hydra-like fashion.
|
||
This feature is experimental.
|
||
|
||
If non-nil, then the key binding of each suffix is colorized to
|
||
indicate whether it exits the transient state or not. The color
|
||
of the prefix is indicated using the line that is drawn when the
|
||
value of `transient-mode-line-format' is `line'.
|
||
|
||
For more information about how Hydra uses colors see
|
||
https://github.com/abo-abo/hydra#color and
|
||
https://oremacs.com/2015/02/19/hydra-colors-reloaded."
|
||
:package-version '(transient . "0.3.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-detect-key-conflicts nil
|
||
"Whether to detect key binding conflicts.
|
||
|
||
Conflicts are detected when a transient prefix command is invoked
|
||
and results in an error, which prevents the transient from being
|
||
used."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-align-variable-pitch nil
|
||
"Whether to align columns pixel-wise in the popup buffer.
|
||
|
||
If this is non-nil, then columns are aligned pixel-wise to
|
||
support variable-pitch fonts. Keys are not aligned, so you
|
||
should use a fixed-pitch font for the `transient-key' face.
|
||
Other key faces inherit from that face unless a theme is
|
||
used that breaks that relationship.
|
||
|
||
This option is intended for users who use a variable-pitch
|
||
font for the `default' face.
|
||
|
||
Also see `transient-force-fixed-pitch'."
|
||
:package-version '(transient . "0.4.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-force-fixed-pitch nil
|
||
"Whether to force use of monospaced font in the popup buffer.
|
||
|
||
Even if you use a proportional font for the `default' face,
|
||
you might still want to use a monospaced font in transient's
|
||
popup buffer. Setting this option to t causes `default' to
|
||
be remapped to `fixed-pitch' in that buffer.
|
||
|
||
Also see `transient-align-variable-pitch'."
|
||
:package-version '(transient . "0.2.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-force-single-column nil
|
||
"Whether to force use of a single column to display suffixes.
|
||
|
||
This might be useful for users with low vision who use large
|
||
text and might otherwise have to scroll in two dimensions."
|
||
:package-version '(transient . "0.3.6")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defcustom transient-hide-during-minibuffer-read nil
|
||
"Whether to hide the transient buffer while reading in the minibuffer."
|
||
:package-version '(transient . "0.4.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
(defconst transient--default-child-level 1)
|
||
|
||
(defconst transient--default-prefix-level 4)
|
||
|
||
(defcustom transient-default-level transient--default-prefix-level
|
||
"Control what suffix levels are made available by default.
|
||
|
||
Each suffix command is placed on a level and each prefix command
|
||
has a level, which controls which suffix commands are available.
|
||
Integers between 1 and 7 (inclusive) are valid levels.
|
||
|
||
The levels of individual transients and/or their individual
|
||
suffixes can be changed individually, by invoking the prefix and
|
||
then pressing \"C-x l\".
|
||
|
||
The default level for both transients and their suffixes is 4.
|
||
This option only controls the default for transients. The default
|
||
suffix level is always 4. The author of a transient should place
|
||
certain suffixes on a higher level if they expect that it won't be
|
||
of use to most users, and they should place very important suffixes
|
||
on a lower level so that they remain available even if the user
|
||
lowers the transient level.
|
||
|
||
\(Magit currently places nearly all suffixes on level 4 and lower
|
||
levels are not used at all yet. So for the time being you should
|
||
not set a lower level here and using a higher level might not
|
||
give you as many additional suffixes as you hoped.)"
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type '(choice (const :tag "1 - fewest suffixes" 1)
|
||
(const 2)
|
||
(const 3)
|
||
(const :tag "4 - default" 4)
|
||
(const 5)
|
||
(const 6)
|
||
(const :tag "7 - most suffixes" 7)))
|
||
|
||
(defcustom transient-levels-file
|
||
(locate-user-emacs-file "transient/levels.el")
|
||
"File used to save levels of transients and their suffixes."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'file)
|
||
|
||
(defcustom transient-values-file
|
||
(locate-user-emacs-file "transient/values.el")
|
||
"File used to save values of transients."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'file)
|
||
|
||
(defcustom transient-history-file
|
||
(locate-user-emacs-file "transient/history.el")
|
||
"File used to save history of transients and their infixes."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'file)
|
||
|
||
(defcustom transient-history-limit 10
|
||
"Number of history elements to keep when saving to file."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'integer)
|
||
|
||
(defcustom transient-save-history t
|
||
"Whether to save history of transient commands when exiting Emacs."
|
||
:package-version '(transient . "0.1.0")
|
||
:group 'transient
|
||
:type 'boolean)
|
||
|
||
;;; Faces
|
||
|
||
(defgroup transient-faces nil
|
||
"Faces used by Transient."
|
||
:group 'transient)
|
||
|
||
(defface transient-heading '((t :inherit font-lock-keyword-face))
|
||
"Face used for headings."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-key '((t :inherit font-lock-builtin-face))
|
||
"Face used for keys."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-argument '((t :inherit font-lock-warning-face))
|
||
"Face used for enabled arguments."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-value '((t :inherit font-lock-string-face))
|
||
"Face used for values."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-inactive-argument '((t :inherit shadow))
|
||
"Face used for inactive arguments."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-inactive-value '((t :inherit shadow))
|
||
"Face used for inactive values."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-unreachable '((t :inherit shadow))
|
||
"Face used for suffixes unreachable from the current prefix sequence."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-active-infix '((t :inherit secondary-selection))
|
||
"Face used for the infix for which the value is being read."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-unreachable-key '((t :inherit (transient-key shadow)))
|
||
"Face used for keys unreachable from the current prefix sequence."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-nonstandard-key '((t :underline t))
|
||
"Face optionally used to highlight keys conflicting with short-argument.
|
||
Also see option `transient-highlight-mismatched-keys'."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-mismatched-key '((t :underline t))
|
||
"Face optionally used to highlight keys without a short-argument.
|
||
Also see option `transient-highlight-mismatched-keys'."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-inapt-suffix '((t :inherit shadow :italic t))
|
||
"Face used for suffixes that are inapt at this time."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-enabled-suffix
|
||
'((t :background "green" :foreground "black" :weight bold))
|
||
"Face used for enabled levels while editing suffix levels.
|
||
See info node `(transient)Enabling and Disabling Suffixes'."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-disabled-suffix
|
||
'((t :background "red" :foreground "black" :weight bold))
|
||
"Face used for disabled levels while editing suffix levels.
|
||
See info node `(transient)Enabling and Disabling Suffixes'."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-higher-level '((t :underline t))
|
||
"Face optionally used to highlight suffixes on higher levels.
|
||
Also see option `transient-highlight-higher-levels'."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-separator
|
||
`((((class color) (background light))
|
||
,@(and (>= emacs-major-version 27) '(:extend t))
|
||
:background "grey80")
|
||
(((class color) (background dark))
|
||
,@(and (>= emacs-major-version 27) '(:extend t))
|
||
:background "grey30"))
|
||
"Face used to draw line below transient popup window.
|
||
This is only used if `transient-mode-line-format' is `line'.
|
||
Only the background color is significant."
|
||
:group 'transient-faces)
|
||
|
||
(defgroup transient-color-faces
|
||
'((transient-semantic-coloring custom-variable))
|
||
"Faces used by Transient for Hydra-like command coloring.
|
||
These faces are only used if `transient-semantic-coloring'
|
||
\(which see) is non-nil."
|
||
:group 'transient-faces)
|
||
|
||
(defface transient-red
|
||
'((t :inherit transient-key :foreground "red"))
|
||
"Face used for red prefixes and suffixes."
|
||
:group 'transient-color-faces)
|
||
|
||
(defface transient-blue
|
||
'((t :inherit transient-key :foreground "blue"))
|
||
"Face used for blue prefixes and suffixes."
|
||
:group 'transient-color-faces)
|
||
|
||
(defface transient-amaranth
|
||
'((t :inherit transient-key :foreground "#E52B50"))
|
||
"Face used for amaranth prefixes."
|
||
:group 'transient-color-faces)
|
||
|
||
(defface transient-pink
|
||
'((t :inherit transient-key :foreground "#FF6EB4"))
|
||
"Face used for pink prefixes."
|
||
:group 'transient-color-faces)
|
||
|
||
(defface transient-teal
|
||
'((t :inherit transient-key :foreground "#367588"))
|
||
"Face used for teal prefixes."
|
||
:group 'transient-color-faces)
|
||
|
||
(defface transient-purple
|
||
'((t :inherit transient-key :foreground "#a020f0"))
|
||
"Face used for purple prefixes.
|
||
|
||
This is an addition to the colors supported by Hydra. It is
|
||
used by suffixes that quit the current prefix but return to
|
||
the previous prefix."
|
||
:group 'transient-color-faces)
|
||
|
||
;;; Persistence
|
||
|
||
(defun transient--read-file-contents (file)
|
||
(with-demoted-errors "Transient error: %S"
|
||
(and (file-exists-p file)
|
||
(with-temp-buffer
|
||
(insert-file-contents file)
|
||
(read (current-buffer))))))
|
||
|
||
(defun transient--pp-to-file (list file)
|
||
(make-directory (file-name-directory file) t)
|
||
(setq list (cl-sort (copy-sequence list) #'string< :key #'car))
|
||
(with-temp-file file
|
||
(let ((print-level nil)
|
||
(print-length nil))
|
||
(pp list (current-buffer)))))
|
||
|
||
(defvar transient-values
|
||
(transient--read-file-contents transient-values-file)
|
||
"Values of transient commands.
|
||
The value of this variable persists between Emacs sessions
|
||
and you usually should not change it manually.")
|
||
|
||
(defun transient-save-values ()
|
||
(transient--pp-to-file transient-values transient-values-file))
|
||
|
||
(defvar transient-levels
|
||
(transient--read-file-contents transient-levels-file)
|
||
"Levels of transient commands.
|
||
The value of this variable persists between Emacs sessions
|
||
and you usually should not change it manually.")
|
||
|
||
(defun transient-save-levels ()
|
||
(transient--pp-to-file transient-levels transient-levels-file))
|
||
|
||
(defvar transient-history
|
||
(transient--read-file-contents transient-history-file)
|
||
"History of transient commands and infix arguments.
|
||
The value of this variable persists between Emacs sessions
|
||
\(unless `transient-save-history' is nil) and you usually
|
||
should not change it manually.")
|
||
|
||
(defun transient-save-history ()
|
||
(setq transient-history
|
||
(cl-sort (mapcar (pcase-lambda (`(,key . ,val))
|
||
(cons key (seq-take (delete-dups val)
|
||
transient-history-limit)))
|
||
transient-history)
|
||
#'string< :key #'car))
|
||
(transient--pp-to-file transient-history transient-history-file))
|
||
|
||
(defun transient-maybe-save-history ()
|
||
"Save the value of `transient-history'.
|
||
If `transient-save-history' is nil, then do nothing."
|
||
(when transient-save-history
|
||
(transient-save-history)))
|
||
|
||
(unless noninteractive
|
||
(add-hook 'kill-emacs-hook #'transient-maybe-save-history))
|
||
|
||
;;; Classes
|
||
;;;; Prefix
|
||
|
||
(defclass transient-prefix ()
|
||
((prototype :initarg :prototype)
|
||
(command :initarg :command)
|
||
(level :initarg :level)
|
||
(variable :initarg :variable :initform nil)
|
||
(init-value :initarg :init-value)
|
||
(value) (default-value :initarg :value)
|
||
(scope :initarg :scope :initform nil)
|
||
(history :initarg :history :initform nil)
|
||
(history-pos :initarg :history-pos :initform 0)
|
||
(history-key :initarg :history-key :initform nil)
|
||
(show-help :initarg :show-help :initform nil)
|
||
(info-manual :initarg :info-manual :initform nil)
|
||
(man-page :initarg :man-page :initform nil)
|
||
(transient-suffix :initarg :transient-suffix :initform nil)
|
||
(transient-non-suffix :initarg :transient-non-suffix :initform nil)
|
||
(incompatible :initarg :incompatible :initform nil)
|
||
(suffix-description :initarg :suffix-description)
|
||
(variable-pitch :initarg :variable-pitch :initform nil))
|
||
"Transient prefix command.
|
||
|
||
Each transient prefix command consists of a command, which is
|
||
stored in a symbol's function slot and an object, which is
|
||
stored in the `transient--prefix' property of the same symbol.
|
||
|
||
When a transient prefix command is invoked, then a clone of that
|
||
object is stored in the global variable `transient--prefix' and
|
||
the prototype is stored in the clone's `prototype' slot.")
|
||
|
||
;;;; Suffix
|
||
|
||
(defclass transient-child ()
|
||
((level
|
||
:initarg :level
|
||
:initform (symbol-value 'transient--default-child-level)
|
||
:documentation "Enable if level of prefix is equal or greater.")
|
||
(if
|
||
:initarg :if
|
||
:initform nil
|
||
:documentation "Enable if predicate returns non-nil.")
|
||
(if-not
|
||
:initarg :if-not
|
||
:initform nil
|
||
:documentation "Enable if predicate returns nil.")
|
||
(if-non-nil
|
||
:initarg :if-non-nil
|
||
:initform nil
|
||
:documentation "Enable if variable's value is non-nil.")
|
||
(if-nil
|
||
:initarg :if-nil
|
||
:initform nil
|
||
:documentation "Enable if variable's value is nil.")
|
||
(if-mode
|
||
:initarg :if-mode
|
||
:initform nil
|
||
:documentation "Enable if major-mode matches value.")
|
||
(if-not-mode
|
||
:initarg :if-not-mode
|
||
:initform nil
|
||
:documentation "Enable if major-mode does not match value.")
|
||
(if-derived
|
||
:initarg :if-derived
|
||
:initform nil
|
||
:documentation "Enable if major-mode derives from value.")
|
||
(if-not-derived
|
||
:initarg :if-not-derived
|
||
:initform nil
|
||
:documentation "Enable if major-mode does not derive from value."))
|
||
"Abstract superclass for group and suffix classes.
|
||
|
||
It is undefined what happens if more than one `if*' predicate
|
||
slot is non-nil."
|
||
:abstract t)
|
||
|
||
(defclass transient-suffix (transient-child)
|
||
((key :initarg :key)
|
||
(command :initarg :command)
|
||
(transient :initarg :transient)
|
||
(format :initarg :format :initform " %k %d")
|
||
(description :initarg :description :initform nil)
|
||
(show-help :initarg :show-help :initform nil)
|
||
(inapt :initform nil)
|
||
(inapt-if
|
||
:initarg :inapt-if
|
||
:initform nil
|
||
:documentation "Inapt if predicate returns non-nil.")
|
||
(inapt-if-not
|
||
:initarg :inapt-if-not
|
||
:initform nil
|
||
:documentation "Inapt if predicate returns nil.")
|
||
(inapt-if-non-nil
|
||
:initarg :inapt-if-non-nil
|
||
:initform nil
|
||
:documentation "Inapt if variable's value is non-nil.")
|
||
(inapt-if-nil
|
||
:initarg :inapt-if-nil
|
||
:initform nil
|
||
:documentation "Inapt if variable's value is nil.")
|
||
(inapt-if-mode
|
||
:initarg :inapt-if-mode
|
||
:initform nil
|
||
:documentation "Inapt if major-mode matches value.")
|
||
(inapt-if-not-mode
|
||
:initarg :inapt-if-not-mode
|
||
:initform nil
|
||
:documentation "Inapt if major-mode does not match value.")
|
||
(inapt-if-derived
|
||
:initarg :inapt-if-derived
|
||
:initform nil
|
||
:documentation "Inapt if major-mode derives from value.")
|
||
(inapt-if-not-derived
|
||
:initarg :inapt-if-not-derived
|
||
:initform nil
|
||
:documentation "Inapt if major-mode does not derive from value."))
|
||
"Superclass for suffix command.")
|
||
|
||
(defclass transient-infix (transient-suffix)
|
||
((transient :initform t)
|
||
(argument :initarg :argument)
|
||
(shortarg :initarg :shortarg)
|
||
(value :initform nil)
|
||
(init-value :initarg :init-value)
|
||
(unsavable :initarg :unsavable :initform nil)
|
||
(multi-value :initarg :multi-value :initform nil)
|
||
(always-read :initarg :always-read :initform nil)
|
||
(allow-empty :initarg :allow-empty :initform nil)
|
||
(history-key :initarg :history-key :initform nil)
|
||
(reader :initarg :reader :initform nil)
|
||
(prompt :initarg :prompt :initform nil)
|
||
(choices :initarg :choices :initform nil)
|
||
(format :initform " %k %d (%v)"))
|
||
"Transient infix command."
|
||
:abstract t)
|
||
|
||
(defclass transient-argument (transient-infix) ()
|
||
"Abstract superclass for infix arguments."
|
||
:abstract t)
|
||
|
||
(defclass transient-switch (transient-argument) ()
|
||
"Class used for command-line argument that can be turned on and off.")
|
||
|
||
(defclass transient-option (transient-argument) ()
|
||
"Class used for command-line argument that can take a value.")
|
||
|
||
(defclass transient-variable (transient-infix)
|
||
((variable :initarg :variable)
|
||
(format :initform " %k %d %v"))
|
||
"Abstract superclass for infix commands that set a variable."
|
||
:abstract t)
|
||
|
||
(defclass transient-switches (transient-argument)
|
||
((argument-format :initarg :argument-format)
|
||
(argument-regexp :initarg :argument-regexp))
|
||
"Class used for sets of mutually exclusive command-line switches.")
|
||
|
||
(defclass transient-files (transient-option) ()
|
||
((key :initform "--")
|
||
(argument :initform "--")
|
||
(multi-value :initform rest)
|
||
(reader :initform transient-read-files))
|
||
"Class used for the \"--\" argument or similar.
|
||
All remaining arguments are treated as files.
|
||
They become the value of this argument.")
|
||
|
||
;;;; Group
|
||
|
||
(defclass transient-group (transient-child)
|
||
((suffixes :initarg :suffixes :initform nil)
|
||
(hide :initarg :hide :initform nil)
|
||
(description :initarg :description :initform nil)
|
||
(setup-children :initarg :setup-children)
|
||
(pad-keys :initarg :pad-keys))
|
||
"Abstract superclass of all group classes."
|
||
:abstract t)
|
||
|
||
(defclass transient-column (transient-group) ()
|
||
"Group class that displays each element on a separate line.")
|
||
|
||
(defclass transient-row (transient-group) ()
|
||
"Group class that displays all elements on a single line.")
|
||
|
||
(defclass transient-columns (transient-group) ()
|
||
"Group class that displays elements organized in columns.
|
||
Direct elements have to be groups whose elements have to be
|
||
commands or string. Each subgroup represents a column. This
|
||
class takes care of inserting the subgroups' elements.")
|
||
|
||
(defclass transient-subgroups (transient-group) ()
|
||
"Group class that wraps other groups.
|
||
|
||
Direct elements have to be groups whose elements have to be
|
||
commands or strings. This group inserts an empty line between
|
||
subgroups. The subgroups are responsible for displaying their
|
||
elements themselves.")
|
||
|
||
;;; Define
|
||
|
||
(defmacro transient-define-prefix (name arglist &rest args)
|
||
"Define NAME as a transient prefix command.
|
||
|
||
ARGLIST are the arguments that command takes.
|
||
DOCSTRING is the documentation string and is optional.
|
||
|
||
These arguments can optionally be followed by key-value pairs.
|
||
Each key has to be a keyword symbol, either `:class' or a keyword
|
||
argument supported by the constructor of that class. The
|
||
`transient-prefix' class is used if the class is not specified
|
||
explicitly.
|
||
|
||
GROUPs add key bindings for infix and suffix commands and specify
|
||
how these bindings are presented in the popup buffer. At least
|
||
one GROUP has to be specified. See info node `(transient)Binding
|
||
Suffix and Infix Commands'.
|
||
|
||
The BODY is optional. If it is omitted, then ARGLIST is also
|
||
ignored and the function definition becomes:
|
||
|
||
(lambda ()
|
||
(interactive)
|
||
(transient-setup \\='NAME))
|
||
|
||
If BODY is specified, then it must begin with an `interactive'
|
||
form that matches ARGLIST, and it must call `transient-setup'.
|
||
It may however call that function only when some condition is
|
||
satisfied; that is one of the reason why you might want to use
|
||
an explicit BODY.
|
||
|
||
All transients have a (possibly nil) value, which is exported
|
||
when suffix commands are called, so that they can consume that
|
||
value. For some transients it might be necessary to have a sort
|
||
of secondary value, called a scope. Such a scope would usually
|
||
be set in the commands `interactive' form and has to be passed
|
||
to the setup function:
|
||
|
||
(transient-setup \\='NAME nil nil :scope SCOPE)
|
||
|
||
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
|
||
(declare (debug ( &define name lambda-list
|
||
[&optional lambda-doc]
|
||
[&rest keywordp sexp]
|
||
[&rest vectorp]
|
||
[&optional ("interactive" interactive) def-body]))
|
||
(indent defun)
|
||
(doc-string 3))
|
||
(pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
|
||
(transient--expand-define-args args)))
|
||
`(progn
|
||
(defalias ',name
|
||
,(if body
|
||
`(lambda ,arglist ,@body)
|
||
`(lambda ()
|
||
(interactive)
|
||
(transient-setup ',name))))
|
||
(put ',name 'interactive-only t)
|
||
(put ',name 'function-documentation ,docstr)
|
||
(put ',name 'transient--prefix
|
||
(,(or class 'transient-prefix) :command ',name ,@slots))
|
||
(put ',name 'transient--layout
|
||
(list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
|
||
suffixes))))))
|
||
|
||
(defmacro transient-define-groups (name &rest groups)
|
||
"Define one or more GROUPS and store them in symbol NAME.
|
||
GROUPS, defined using this macro, can be used inside the
|
||
definition of transient prefix commands, by using the symbol
|
||
NAME where a group vector is expected. GROUPS has the same
|
||
form as for `transient-define-prefix'."
|
||
(declare (debug (&define name [&rest vectorp]))
|
||
(indent defun))
|
||
`(put ',name 'transient--layout
|
||
(list ,@(cl-mapcan (lambda (group) (transient--parse-child name group))
|
||
groups))))
|
||
|
||
(defmacro transient-define-suffix (name arglist &rest args)
|
||
"Define NAME as a transient suffix command.
|
||
|
||
ARGLIST are the arguments that the command takes.
|
||
DOCSTRING is the documentation string and is optional.
|
||
|
||
These arguments can optionally be followed by key-value pairs.
|
||
Each key has to be a keyword symbol, either `:class' or a
|
||
keyword argument supported by the constructor of that class.
|
||
The `transient-suffix' class is used if the class is not
|
||
specified explicitly.
|
||
|
||
The BODY must begin with an `interactive' form that matches
|
||
ARGLIST. The infix arguments are usually accessed by using
|
||
`transient-args' inside `interactive'.
|
||
|
||
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
|
||
(declare (debug ( &define name lambda-list
|
||
[&optional lambda-doc]
|
||
[&rest keywordp sexp]
|
||
("interactive" interactive)
|
||
def-body))
|
||
(indent defun)
|
||
(doc-string 3))
|
||
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
|
||
(transient--expand-define-args args)))
|
||
`(progn
|
||
(defalias ',name (lambda ,arglist ,@body))
|
||
(put ',name 'interactive-only t)
|
||
(put ',name 'function-documentation ,docstr)
|
||
(put ',name 'transient--suffix
|
||
(,(or class 'transient-suffix) :command ',name ,@slots)))))
|
||
|
||
(defmacro transient-define-infix (name _arglist &rest args)
|
||
"Define NAME as a transient infix command.
|
||
|
||
ARGLIST is always ignored and reserved for future use.
|
||
DOCSTRING is the documentation string and is optional.
|
||
|
||
The key-value pairs are mandatory. All transient infix commands
|
||
are equal to each other (but not eq), so it is meaningless to
|
||
define an infix command without also setting at least `:class'
|
||
and one other keyword (which it is depends on the used class,
|
||
usually `:argument' or `:variable').
|
||
|
||
Each key has to be a keyword symbol, either `:class' or a keyword
|
||
argument supported by the constructor of that class. The
|
||
`transient-switch' class is used if the class is not specified
|
||
explicitly.
|
||
|
||
The function definitions is always:
|
||
|
||
(lambda ()
|
||
(interactive)
|
||
(let ((obj (transient-suffix-object)))
|
||
(transient-infix-set obj (transient-infix-read obj)))
|
||
(transient--show))
|
||
|
||
`transient-infix-read' and `transient-infix-set' are generic
|
||
functions. Different infix commands behave differently because
|
||
the concrete methods are different for different infix command
|
||
classes. In rare case the above command function might not be
|
||
suitable, even if you define your own infix command class. In
|
||
that case you have to use `transient-define-suffix' to define
|
||
the infix command and use t as the value of the `:transient'
|
||
keyword.
|
||
|
||
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
|
||
(declare (debug ( &define name lambda-list
|
||
[&optional lambda-doc]
|
||
[&rest keywordp sexp]))
|
||
(indent defun)
|
||
(doc-string 3))
|
||
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
|
||
(transient--expand-define-args args)))
|
||
`(progn
|
||
(defalias ',name ,(transient--default-infix-command))
|
||
(put ',name 'interactive-only t)
|
||
(put ',name 'command-modes (list 'not-a-mode))
|
||
(put ',name 'function-documentation ,docstr)
|
||
(put ',name 'transient--suffix
|
||
(,(or class 'transient-switch) :command ',name ,@slots)))))
|
||
|
||
(defalias 'transient-define-argument #'transient-define-infix
|
||
"Define NAME as a transient infix command.
|
||
|
||
Only use this alias to define an infix command that actually
|
||
sets an infix argument. To define a infix command that, for
|
||
example, sets a variable use `transient-define-infix' instead.
|
||
|
||
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
|
||
|
||
(defun transient--expand-define-args (args)
|
||
(let (class keys suffixes docstr)
|
||
(when (stringp (car args))
|
||
(setq docstr (pop args)))
|
||
(while (keywordp (car args))
|
||
(let ((k (pop args))
|
||
(v (pop args)))
|
||
(if (eq k :class)
|
||
(setq class v)
|
||
(push k keys)
|
||
(push v keys))))
|
||
(while (let ((arg (car args)))
|
||
(or (vectorp arg)
|
||
(and arg (symbolp arg))))
|
||
(push (pop args) suffixes))
|
||
(list (if (eq (car-safe class) 'quote)
|
||
(cadr class)
|
||
class)
|
||
(nreverse keys)
|
||
(nreverse suffixes)
|
||
docstr
|
||
args)))
|
||
|
||
(defun transient--parse-child (prefix spec)
|
||
(cl-etypecase spec
|
||
(symbol (let ((value (symbol-value spec)))
|
||
(if (and (listp value)
|
||
(or (listp (car value))
|
||
(vectorp (car value))))
|
||
(cl-mapcan (lambda (s) (transient--parse-child prefix s)) value)
|
||
(transient--parse-child prefix value))))
|
||
(vector (and-let* ((c (transient--parse-group prefix spec))) (list c)))
|
||
(list (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
|
||
(string (list spec))))
|
||
|
||
(defun transient--parse-group (prefix spec)
|
||
(setq spec (append spec nil))
|
||
(cl-symbol-macrolet
|
||
((car (car spec))
|
||
(pop (pop spec)))
|
||
(let (level class args)
|
||
(when (integerp car)
|
||
(setq level pop))
|
||
(when (stringp car)
|
||
(setq args (plist-put args :description pop)))
|
||
(while (keywordp car)
|
||
(let ((key pop)
|
||
(val pop))
|
||
(cond ((eq key :class)
|
||
(setq class (macroexp-quote val)))
|
||
((or (symbolp val)
|
||
(and (listp val) (not (eq (car val) 'lambda))))
|
||
(setq args (plist-put args key (macroexp-quote val))))
|
||
((setq args (plist-put args key val))))))
|
||
(list 'vector
|
||
(or level transient--default-child-level)
|
||
(or class
|
||
(if (vectorp car)
|
||
(quote 'transient-columns)
|
||
(quote 'transient-column)))
|
||
(and args (cons 'list args))
|
||
(cons 'list
|
||
(cl-mapcan (lambda (s) (transient--parse-child prefix s))
|
||
spec))))))
|
||
|
||
(defun transient--parse-suffix (prefix spec)
|
||
(let (level class args)
|
||
(cl-symbol-macrolet
|
||
((car (car spec))
|
||
(pop (pop spec)))
|
||
(when (integerp car)
|
||
(setq level pop))
|
||
(when (or (stringp car)
|
||
(vectorp car))
|
||
(setq args (plist-put args :key pop)))
|
||
(cond
|
||
((or (stringp car)
|
||
(eq (car-safe car) 'lambda))
|
||
(setq args (plist-put args :description pop)))
|
||
((and (symbolp car)
|
||
(not (commandp car))
|
||
(commandp (cadr spec)))
|
||
(setq args (plist-put args :description (macroexp-quote pop)))))
|
||
(cond
|
||
((keywordp car)
|
||
(error "Need command, got %S" car))
|
||
((symbolp car)
|
||
(setq args (plist-put args :command (macroexp-quote pop))))
|
||
((and (commandp car)
|
||
(not (stringp car)))
|
||
(let ((cmd pop)
|
||
(sym (intern (format "transient:%s:%s"
|
||
prefix
|
||
(or (plist-get args :description)
|
||
(plist-get args :key))))))
|
||
(defalias sym cmd)
|
||
(setq args (plist-put args :command (macroexp-quote sym)))))
|
||
((or (stringp car)
|
||
(and car (listp car)))
|
||
(let ((arg pop))
|
||
(cl-typecase arg
|
||
(list
|
||
(setq args (plist-put args :shortarg (car arg)))
|
||
(setq args (plist-put args :argument (cadr arg)))
|
||
(setq arg (cadr arg)))
|
||
(string
|
||
(when-let ((shortarg (transient--derive-shortarg arg)))
|
||
(setq args (plist-put args :shortarg shortarg)))
|
||
(setq args (plist-put args :argument arg))))
|
||
(setq args (plist-put args :command
|
||
(list 'quote (intern (format "transient:%s:%s"
|
||
prefix arg)))))
|
||
(cond ((and car (not (keywordp car)))
|
||
(setq class 'transient-option)
|
||
(setq args (plist-put args :reader (macroexp-quote pop))))
|
||
((not (string-suffix-p "=" arg))
|
||
(setq class 'transient-switch))
|
||
(t
|
||
(setq class 'transient-option)))))
|
||
(t
|
||
(error "Needed command or argument, got %S" car)))
|
||
(while (keywordp car)
|
||
(let ((key pop)
|
||
(val pop))
|
||
(cond ((eq key :class) (setq class val))
|
||
((eq key :level) (setq level val))
|
||
((eq (car-safe val) '\,)
|
||
(setq args (plist-put args key (cadr val))))
|
||
((or (symbolp val)
|
||
(and (listp val) (not (eq (car val) 'lambda))))
|
||
(setq args (plist-put args key (macroexp-quote val))))
|
||
((setq args (plist-put args key val)))))))
|
||
(unless (plist-get args :key)
|
||
(when-let ((shortarg (plist-get args :shortarg)))
|
||
(setq args (plist-put args :key shortarg))))
|
||
(list 'list
|
||
(or level transient--default-child-level)
|
||
(macroexp-quote (or class 'transient-suffix))
|
||
(cons 'list args))))
|
||
|
||
(defun transient--default-infix-command ()
|
||
(cons 'lambda
|
||
'(()
|
||
(interactive)
|
||
(let ((obj (transient-suffix-object)))
|
||
(transient-infix-set obj (transient-infix-read obj)))
|
||
(transient--show))))
|
||
|
||
(defun transient--ensure-infix-command (obj)
|
||
(let ((cmd (oref obj command)))
|
||
(unless (or (commandp cmd)
|
||
(get cmd 'transient--infix-command))
|
||
(if (or (cl-typep obj 'transient-switch)
|
||
(cl-typep obj 'transient-option))
|
||
(put cmd 'transient--infix-command
|
||
(transient--default-infix-command))
|
||
;; This is not an anonymous infix argument.
|
||
(when (transient--use-suffix-p obj)
|
||
(error "Suffix %s is not defined or autoloaded as a command" cmd))))))
|
||
|
||
(defun transient--derive-shortarg (arg)
|
||
(save-match-data
|
||
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
|
||
(match-string 1 arg))))
|
||
|
||
(defun transient-parse-suffix (prefix suffix)
|
||
"Parse SUFFIX, to be added to PREFIX.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIX is a suffix command or a group specification (of
|
||
the same forms as expected by `transient-define-prefix').
|
||
Intended for use in PREFIX's `:setup-children' function."
|
||
(eval (car (transient--parse-child prefix suffix))))
|
||
|
||
(defun transient-parse-suffixes (prefix suffixes)
|
||
"Parse SUFFIXES, to be added to PREFIX.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIXES is a list of suffix command or a group specification
|
||
(of the same forms as expected by `transient-define-prefix').
|
||
Intended for use in PREFIX's `:setup-children' function."
|
||
(mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
|
||
|
||
;;; Edit
|
||
|
||
(defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
|
||
(let* ((suf (cl-etypecase suffix
|
||
(vector (transient--parse-group prefix suffix))
|
||
(list (transient--parse-suffix prefix suffix))
|
||
(string suffix)))
|
||
(mem (transient--layout-member loc prefix))
|
||
(elt (car mem)))
|
||
(setq suf (eval suf))
|
||
(cond
|
||
((not mem)
|
||
(message "Cannot insert %S into %s; %s not found"
|
||
suffix prefix loc))
|
||
((or (and (vectorp suffix) (not (vectorp elt)))
|
||
(and (listp suffix) (vectorp elt))
|
||
(and (stringp suffix) (vectorp elt)))
|
||
(message "Cannot place %S into %s at %s; %s"
|
||
suffix prefix loc
|
||
"suffixes and groups cannot be siblings"))
|
||
(t
|
||
(when-let* ((bindingp (listp suf))
|
||
(key (transient--spec-key suf))
|
||
(conflict (car (transient--layout-member key prefix)))
|
||
(conflictp
|
||
(and (not (and (eq action 'replace)
|
||
(eq conflict elt)))
|
||
(or (not keep-other)
|
||
(eq (plist-get (nth 2 suf) :command)
|
||
(plist-get (nth 2 conflict) :command)))
|
||
(equal (transient--suffix-predicate suf)
|
||
(transient--suffix-predicate conflict)))))
|
||
(transient-remove-suffix prefix key))
|
||
(cl-ecase action
|
||
(insert (setcdr mem (cons elt (cdr mem)))
|
||
(setcar mem suf))
|
||
(append (setcdr mem (cons suf (cdr mem))))
|
||
(replace (setcar mem suf)))))))
|
||
|
||
;;;###autoload
|
||
(defun transient-insert-suffix (prefix loc suffix &optional keep-other)
|
||
"Insert a SUFFIX into PREFIX before LOC.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIX is a suffix command or a group specification (of
|
||
the same forms as expected by `transient-define-prefix').
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
Remove a conflicting binding unless optional KEEP-OTHER is
|
||
non-nil.
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(declare (indent defun))
|
||
(transient--insert-suffix prefix loc suffix 'insert keep-other))
|
||
|
||
;;;###autoload
|
||
(defun transient-append-suffix (prefix loc suffix &optional keep-other)
|
||
"Insert a SUFFIX into PREFIX after LOC.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIX is a suffix command or a group specification (of
|
||
the same forms as expected by `transient-define-prefix').
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
Remove a conflicting binding unless optional KEEP-OTHER is
|
||
non-nil.
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(declare (indent defun))
|
||
(transient--insert-suffix prefix loc suffix 'append keep-other))
|
||
|
||
;;;###autoload
|
||
(defun transient-replace-suffix (prefix loc suffix)
|
||
"Replace the suffix at LOC in PREFIX with SUFFIX.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIX is a suffix command or a group specification (of
|
||
the same forms as expected by `transient-define-prefix').
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(declare (indent defun))
|
||
(transient--insert-suffix prefix loc suffix 'replace))
|
||
|
||
;;;###autoload
|
||
(defun transient-remove-suffix (prefix loc)
|
||
"Remove the suffix or group at LOC in PREFIX.
|
||
PREFIX is a prefix command, a symbol.
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(declare (indent defun))
|
||
(transient--layout-member loc prefix 'remove))
|
||
|
||
(defun transient-get-suffix (prefix loc)
|
||
"Return the suffix or group at LOC in PREFIX.
|
||
PREFIX is a prefix command, a symbol.
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(if-let ((mem (transient--layout-member loc prefix)))
|
||
(car mem)
|
||
(error "%s not found in %s" loc prefix)))
|
||
|
||
(defun transient-suffix-put (prefix loc prop value)
|
||
"Edit the suffix at LOC in PREFIX, setting PROP to VALUE.
|
||
PREFIX is a prefix command, a symbol.
|
||
SUFFIX is a suffix command or a group specification (of
|
||
the same forms as expected by `transient-define-prefix').
|
||
LOC is a command, a key vector, a key description (a string
|
||
as returned by `key-description'), or a coordination list
|
||
(whose last element may also be a command or key).
|
||
See info node `(transient)Modifying Existing Transients'."
|
||
(let ((suf (transient-get-suffix prefix loc)))
|
||
(setf (elt suf 2)
|
||
(plist-put (elt suf 2) prop value))))
|
||
|
||
(defun transient--layout-member (loc prefix &optional remove)
|
||
(let ((val (or (get prefix 'transient--layout)
|
||
(error "%s is not a transient command" prefix))))
|
||
(when (listp loc)
|
||
(while (integerp (car loc))
|
||
(let* ((children (if (vectorp val) (aref val 3) val))
|
||
(mem (transient--nthcdr (pop loc) children)))
|
||
(if (and remove (not loc))
|
||
(let ((rest (delq (car mem) children)))
|
||
(if (vectorp val)
|
||
(aset val 3 rest)
|
||
(put prefix 'transient--layout rest))
|
||
(setq val nil))
|
||
(setq val (if loc (car mem) mem)))))
|
||
(setq loc (car loc)))
|
||
(if loc
|
||
(transient--layout-member-1 (transient--kbd loc) val remove)
|
||
val)))
|
||
|
||
(defun transient--layout-member-1 (loc layout remove)
|
||
(cond ((listp layout)
|
||
(seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
|
||
layout))
|
||
((vectorp (car (aref layout 3)))
|
||
(seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
|
||
(aref layout 3)))
|
||
(remove
|
||
(aset layout 3
|
||
(delq (car (transient--group-member loc layout))
|
||
(aref layout 3)))
|
||
nil)
|
||
(t (transient--group-member loc layout))))
|
||
|
||
(defun transient--group-member (loc group)
|
||
(cl-member-if (lambda (suffix)
|
||
(and (listp suffix)
|
||
(let* ((def (nth 2 suffix))
|
||
(cmd (plist-get def :command)))
|
||
(if (symbolp loc)
|
||
(eq cmd loc)
|
||
(equal (transient--kbd
|
||
(or (plist-get def :key)
|
||
(transient--command-key cmd)))
|
||
loc)))))
|
||
(aref group 3)))
|
||
|
||
(defun transient--kbd (keys)
|
||
(when (vectorp keys)
|
||
(setq keys (key-description keys)))
|
||
(when (stringp keys)
|
||
(setq keys (kbd keys)))
|
||
keys)
|
||
|
||
(defun transient--spec-key (spec)
|
||
(let ((plist (nth 2 spec)))
|
||
(or (plist-get plist :key)
|
||
(transient--command-key
|
||
(plist-get plist :command)))))
|
||
|
||
(defun transient--command-key (cmd)
|
||
(and-let* ((obj (get cmd 'transient--suffix)))
|
||
(cond ((slot-boundp obj 'key)
|
||
(oref obj key))
|
||
((slot-exists-p obj 'shortarg)
|
||
(if (slot-boundp obj 'shortarg)
|
||
(oref obj shortarg)
|
||
(transient--derive-shortarg (oref obj argument)))))))
|
||
|
||
(defun transient--nthcdr (n list)
|
||
(nthcdr (if (< n 0) (- (length list) (abs n)) n) list))
|
||
|
||
;;; Variables
|
||
|
||
(defvar transient-current-prefix nil
|
||
"The transient from which this suffix command was invoked.
|
||
This is an object representing that transient, use
|
||
`transient-current-command' to get the respective command.")
|
||
|
||
(defvar transient-current-command nil
|
||
"The transient from which this suffix command was invoked.
|
||
This is a symbol representing that transient, use
|
||
`transient-current-prefix' to get the respective object.")
|
||
|
||
(defvar transient-current-suffixes nil
|
||
"The suffixes of the transient from which this suffix command was invoked.
|
||
This is a list of objects. Usually it is sufficient to instead
|
||
use the function `transient-args', which returns a list of
|
||
values. In complex cases it might be necessary to use this
|
||
variable instead.")
|
||
|
||
(defvar transient-exit-hook nil
|
||
"Hook run after exiting a transient.")
|
||
|
||
(defvar transient--prefix nil)
|
||
(defvar transient--layout nil)
|
||
(defvar transient--suffixes nil)
|
||
|
||
(defconst transient--stay t "Do not exit the transient.")
|
||
(defconst transient--exit nil "Do exit the transient.")
|
||
|
||
(defvar transient--exitp nil "Whether to exit the transient.")
|
||
(defvar transient--showp nil "Whether the transient is show in a popup buffer.")
|
||
(defvar transient--helpp nil "Whether help-mode is active.")
|
||
(defvar transient--editp nil "Whether edit-mode is active.")
|
||
|
||
(defvar transient--active-infix nil "The active infix awaiting user input.")
|
||
|
||
(defvar transient--timer nil)
|
||
|
||
(defvar transient--stack nil)
|
||
|
||
(defvar transient--minibuffer-depth 0)
|
||
|
||
(defvar transient--buffer-name " *transient*"
|
||
"Name of the transient buffer.")
|
||
|
||
(defvar transient--window nil
|
||
"The window used to display the transient popup.")
|
||
|
||
(defvar transient--original-window nil
|
||
"The window that was selected before the transient was invoked.
|
||
Usually it remains selected while the transient is active.")
|
||
|
||
(defvar transient--original-buffer nil
|
||
"The buffer that was current before the transient was invoked.
|
||
Usually it remains current while the transient is active.")
|
||
|
||
(defvar transient--debug nil "Whether put debug information into *Messages*.")
|
||
|
||
(defvar transient--history nil)
|
||
|
||
(defvar transient--abort-commands
|
||
'(abort-minibuffers ; (minibuffer-quit-recursive-edit)
|
||
abort-recursive-edit ; (throw 'exit t)
|
||
exit-recursive-edit ; (throw 'exit nil)
|
||
keyboard-escape-quit ; dwim
|
||
keyboard-quit ; (signal 'quit nil)
|
||
minibuffer-keyboard-quit ; (abort-minibuffers)
|
||
minibuffer-quit-recursive-edit ; (throw 'exit (lambda ()
|
||
; (signal 'minibuffer-quit nil)))
|
||
top-level)) ; (throw 'top-level nil)
|
||
|
||
(defvar transient--scroll-commands
|
||
'(transient-scroll-up
|
||
transient-scroll-down
|
||
mwheel-scroll
|
||
scroll-bar-toolkit-scroll))
|
||
|
||
;;; Identities
|
||
|
||
(defun transient-suffix-object (&optional command)
|
||
"Return the object associated with the current suffix command.
|
||
|
||
Each suffix commands is associated with an object, which holds
|
||
additional information about the suffix, such as its value (in
|
||
the case of an infix command, which is a kind of suffix command).
|
||
|
||
This function is intended to be called by infix commands, whose
|
||
command definition usually (at least when defined using
|
||
`transient-define-infix') is this:
|
||
|
||
(lambda ()
|
||
(interactive)
|
||
(let ((obj (transient-suffix-object)))
|
||
(transient-infix-set obj (transient-infix-read obj)))
|
||
(transient--show))
|
||
|
||
\(User input is read outside of `interactive' to prevent the
|
||
command from being added to `command-history'. See #23.)
|
||
|
||
Such commands need to be able to access their associated object
|
||
to guide how `transient-infix-read' reads the new value and to
|
||
store the read value. Other suffix commands (including non-infix
|
||
commands) may also need the object to guide their behavior.
|
||
|
||
This function attempts to return the object associated with the
|
||
current suffix command even if the suffix command was not invoked
|
||
from a transient. (For some suffix command that is a valid thing
|
||
to do, for others it is not.) In that case nil may be returned
|
||
if the command was not defined using one of the macros intended
|
||
to define such commands.
|
||
|
||
The optional argument COMMAND is intended for internal use. If
|
||
you are contemplating using it in your own code, then you should
|
||
probably use this instead:
|
||
|
||
(get COMMAND \\='transient--suffix)"
|
||
(when command
|
||
(cl-check-type command command))
|
||
(if (or transient--prefix
|
||
transient-current-prefix)
|
||
(cl-find-if (lambda (obj)
|
||
(eq (transient--suffix-command obj)
|
||
;; When `this-command' is `transient-set-level',
|
||
;; its reader needs to know what command is being
|
||
;; configured.
|
||
(or command this-original-command)))
|
||
(or transient--suffixes
|
||
transient-current-suffixes))
|
||
(when-let* ((obj (get (or command this-command) 'transient--suffix))
|
||
(obj (clone obj)))
|
||
;; Cannot use and-let* because of debbugs#31840.
|
||
(transient-init-scope obj)
|
||
(transient-init-value obj)
|
||
obj)))
|
||
|
||
(defun transient--suffix-command (object)
|
||
"Return the command represented by OBJECT.
|
||
|
||
If the value of OBJECT's `command' slot is a command, then return
|
||
that. Otherwise it is a symbol whose `transient--infix-command'
|
||
property holds an anonymous command, which is returned instead."
|
||
(cl-check-type object transient-suffix)
|
||
(let ((sym (oref object command)))
|
||
(if (commandp sym)
|
||
sym
|
||
(get sym 'transient--infix-command))))
|
||
|
||
(defun transient--suffix-symbol (arg)
|
||
"Return a symbol representing ARG.
|
||
|
||
ARG must be a command and/or a symbol. If it is a symbol,
|
||
then just return it. Otherwise return the symbol whose
|
||
`transient--infix-command' property's value is ARG."
|
||
(or (cl-typep arg 'command)
|
||
(cl-typep arg 'symbol)
|
||
(signal 'wrong-type-argument `((command symbol) ,arg)))
|
||
(if (symbolp arg)
|
||
arg
|
||
(let* ((obj (transient-suffix-object))
|
||
(sym (oref obj command)))
|
||
(if (eq (get sym 'transient--infix-command) arg)
|
||
sym
|
||
(catch 'found
|
||
(mapatoms (lambda (sym)
|
||
(when (eq (get sym 'transient--infix-command) arg)
|
||
(throw 'found sym)))))))))
|
||
|
||
;;; Keymaps
|
||
|
||
(defvar transient-base-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (kbd "ESC ESC ESC") #'transient-quit-all)
|
||
(define-key map (kbd "C-g") #'transient-quit-one)
|
||
(define-key map (kbd "C-q") #'transient-quit-all)
|
||
(define-key map (kbd "C-z") #'transient-suspend)
|
||
(define-key map (kbd "C-v") #'transient-scroll-up)
|
||
(define-key map (kbd "C-M-v") #'transient-scroll-down)
|
||
(define-key map [next] #'transient-scroll-up)
|
||
(define-key map [prior] #'transient-scroll-down)
|
||
map)
|
||
"Parent of other keymaps used by Transient.
|
||
|
||
This is the parent keymap of all the keymaps that are used in
|
||
all transients: `transient-map' (which in turn is the parent
|
||
of the transient-specific keymaps), `transient-edit-map' and
|
||
`transient-sticky-map'.
|
||
|
||
If you change a binding here, then you might also have to edit
|
||
`transient-sticky-map' and `transient-common-commands'. While
|
||
the latter isn't a proper transient prefix command, it can be
|
||
edited using the same functions as used for transients.
|
||
|
||
If you add a new command here, then you must also add a binding
|
||
to `transient-predicate-map'.")
|
||
|
||
(defvar transient-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map transient-base-map)
|
||
(define-key map (kbd "C-u") #'universal-argument)
|
||
(define-key map (kbd "C--") #'negative-argument)
|
||
(define-key map (kbd "C-t") #'transient-show)
|
||
(define-key map (kbd "?") #'transient-help)
|
||
(define-key map (kbd "C-h") #'transient-help)
|
||
;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
|
||
(define-key map (kbd "C-M-p") #'transient-history-prev)
|
||
(define-key map (kbd "C-M-n") #'transient-history-next)
|
||
map)
|
||
"Top-level keymap used by all transients.
|
||
|
||
If you add a new command here, then you must also add a binding
|
||
to `transient-predicate-map'. Also see `transient-base-map'.")
|
||
|
||
(defvar transient-edit-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map transient-base-map)
|
||
(define-key map (kbd "?") #'transient-help)
|
||
(define-key map (kbd "C-h") #'transient-help)
|
||
(define-key map (kbd "C-x l") #'transient-set-level)
|
||
map)
|
||
"Keymap that is active while a transient in is in \"edit mode\".")
|
||
|
||
(defvar transient-sticky-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map transient-base-map)
|
||
(define-key map (kbd "C-g") #'transient-quit-seq)
|
||
map)
|
||
"Keymap that is active while an incomplete key sequence is active.")
|
||
|
||
(defvar transient--common-command-prefixes '(?\C-x))
|
||
|
||
(put 'transient-common-commands
|
||
'transient--layout
|
||
(list
|
||
(eval
|
||
(car (transient--parse-child
|
||
'transient-common-commands
|
||
(vector
|
||
:hide
|
||
(lambda ()
|
||
(and (not (memq
|
||
(car (bound-and-true-p transient--redisplay-key))
|
||
transient--common-command-prefixes))
|
||
(not transient-show-common-commands)))
|
||
(vector
|
||
"Value commands"
|
||
(list "C-x s " "Set" #'transient-set)
|
||
(list "C-x C-s" "Save" #'transient-save)
|
||
(list "C-x C-k" "Reset" #'transient-reset)
|
||
(list "C-x p " "Previous value" #'transient-history-prev)
|
||
(list "C-x n " "Next value" #'transient-history-next))
|
||
(vector
|
||
"Sticky commands"
|
||
;; Like `transient-sticky-map' except that
|
||
;; "C-g" has to be bound to a different command.
|
||
(list "C-g" "Quit prefix or transient" #'transient-quit-one)
|
||
(list "C-q" "Quit transient stack" #'transient-quit-all)
|
||
(list "C-z" "Suspend transient stack" #'transient-suspend))
|
||
(vector
|
||
"Customize"
|
||
(list "C-x t" 'transient-toggle-common :description
|
||
(lambda ()
|
||
(if transient-show-common-commands
|
||
"Hide common commands"
|
||
"Show common permanently")))
|
||
(list "C-x l" "Show/hide suffixes" #'transient-set-level))))))))
|
||
|
||
(defvar transient-popup-navigation-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (kbd "<down-mouse-1>") #'transient-noop)
|
||
(define-key map (kbd "<up>") #'transient-backward-button)
|
||
(define-key map (kbd "<down>") #'transient-forward-button)
|
||
(define-key map (kbd "C-r") #'transient-isearch-backward)
|
||
(define-key map (kbd "C-s") #'transient-isearch-forward)
|
||
(define-key map (kbd "M-RET") #'transient-push-button)
|
||
map)
|
||
"One of the keymaps used when popup navigation is enabled.
|
||
See `transient-enable-popup-navigation'.")
|
||
|
||
(defvar transient-button-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (kbd "<mouse-1>") #'transient-push-button)
|
||
(define-key map (kbd "<mouse-2>") #'transient-push-button)
|
||
map)
|
||
"One of the keymaps used when popup navigation is enabled.
|
||
See `transient-enable-popup-navigation'.")
|
||
|
||
(defvar transient-predicate-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map [transient-suspend] #'transient--do-suspend)
|
||
(define-key map [transient-help] #'transient--do-stay)
|
||
(define-key map [transient-set-level] #'transient--do-stay)
|
||
(define-key map [transient-history-prev] #'transient--do-stay)
|
||
(define-key map [transient-history-next] #'transient--do-stay)
|
||
(define-key map [universal-argument] #'transient--do-stay)
|
||
(define-key map [negative-argument] #'transient--do-minus)
|
||
(define-key map [digit-argument] #'transient--do-stay)
|
||
(define-key map [transient-quit-all] #'transient--do-quit-all)
|
||
(define-key map [transient-quit-one] #'transient--do-quit-one)
|
||
(define-key map [transient-quit-seq] #'transient--do-stay)
|
||
(define-key map [transient-show] #'transient--do-stay)
|
||
(define-key map [transient-update] #'transient--do-stay)
|
||
(define-key map [transient-toggle-common] #'transient--do-stay)
|
||
(define-key map [transient-set] #'transient--do-call)
|
||
(define-key map [transient-save] #'transient--do-call)
|
||
(define-key map [transient-reset] #'transient--do-call)
|
||
(define-key map [describe-key-briefly] #'transient--do-stay)
|
||
(define-key map [describe-key] #'transient--do-stay)
|
||
(define-key map [transient-scroll-up] #'transient--do-stay)
|
||
(define-key map [transient-scroll-down] #'transient--do-stay)
|
||
(define-key map [mwheel-scroll] #'transient--do-stay)
|
||
(define-key map [scroll-bar-toolkit-scroll] #'transient--do-stay)
|
||
(define-key map [transient-noop] #'transient--do-noop)
|
||
(define-key map [transient-mouse-push-button] #'transient--do-move)
|
||
(define-key map [transient-push-button] #'transient--do-push-button)
|
||
(define-key map [transient-backward-button] #'transient--do-move)
|
||
(define-key map [transient-forward-button] #'transient--do-move)
|
||
(define-key map [transient-isearch-backward] #'transient--do-move)
|
||
(define-key map [transient-isearch-forward] #'transient--do-move)
|
||
;; If a valid but incomplete prefix sequence is followed by
|
||
;; an unbound key, then Emacs calls the `undefined' command
|
||
;; but does not set `this-command', `this-original-command'
|
||
;; or `real-this-command' accordingly. Instead they are nil.
|
||
(define-key map [nil] #'transient--do-warn)
|
||
map)
|
||
"Base keymap used to map common commands to their transient behavior.
|
||
|
||
The \"transient behavior\" of a command controls, among other
|
||
things, whether invoking the command causes the transient to be
|
||
exited or not and whether infix arguments are exported before
|
||
doing so.
|
||
|
||
Each \"key\" is a command that is common to all transients and
|
||
that is bound in `transient-map', `transient-edit-map',
|
||
`transient-sticky-map' and/or `transient-common-command'.
|
||
|
||
Each binding is a \"pre-command\", a function that controls the
|
||
transient behavior of the respective command.
|
||
|
||
For transient commands that are bound in individual transients,
|
||
the transient behavior is specified using the `:transient' slot
|
||
of the corresponding object.")
|
||
|
||
(defvar transient--transient-map nil)
|
||
(defvar transient--predicate-map nil)
|
||
(defvar transient--redisplay-map nil)
|
||
(defvar transient--redisplay-key nil)
|
||
|
||
(defun transient--push-keymap (var)
|
||
(let ((map (symbol-value var)))
|
||
(transient--debug " push %s%s" var (if map "" " VOID"))
|
||
(when map
|
||
(with-demoted-errors "transient--push-keymap: %S"
|
||
(internal-push-keymap map 'overriding-terminal-local-map)))))
|
||
|
||
(defun transient--pop-keymap (var)
|
||
(let ((map (symbol-value var)))
|
||
(transient--debug " pop %s%s" var (if map "" " VOID"))
|
||
(when map
|
||
(with-demoted-errors "transient--pop-keymap: %S"
|
||
(internal-pop-keymap map 'overriding-terminal-local-map)))))
|
||
|
||
(defun transient--make-transient-map ()
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map (if transient--editp
|
||
transient-edit-map
|
||
transient-map))
|
||
(dolist (obj transient--suffixes)
|
||
(let ((key (oref obj key)))
|
||
(when (vectorp key)
|
||
(setq key (key-description key))
|
||
(oset obj key key))
|
||
(when transient-substitute-key-function
|
||
(setq key (save-match-data
|
||
(funcall transient-substitute-key-function obj)))
|
||
(oset obj key key))
|
||
(let ((kbd (kbd key))
|
||
(cmd (transient--suffix-command obj)))
|
||
(when-let ((conflict (and transient-detect-key-conflicts
|
||
(transient--lookup-key map kbd))))
|
||
(unless (eq cmd conflict)
|
||
(error "Cannot bind %S to %s and also %s"
|
||
(string-trim key)
|
||
cmd conflict)))
|
||
(define-key map kbd cmd))))
|
||
(when-let ((b (lookup-key map "-"))) (define-key map [kp-subtract] b))
|
||
(when-let ((b (lookup-key map "="))) (define-key map [kp-equal] b))
|
||
(when-let ((b (lookup-key map "+"))) (define-key map [kp-add] b))
|
||
(when transient-enable-popup-navigation
|
||
;; `transient--make-redisplay-map' maps only over bindings that are
|
||
;; directly in the base keymap, so that cannot be a composed keymap.
|
||
(set-keymap-parent
|
||
map (make-composed-keymap
|
||
(keymap-parent map)
|
||
transient-popup-navigation-map)))
|
||
map))
|
||
|
||
(defun transient--make-predicate-map ()
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map transient-predicate-map)
|
||
(when (memq (oref transient--prefix transient-non-suffix)
|
||
'(nil transient--do-warn transient--do-noop))
|
||
(define-key map [handle-switch-frame] #'transient--do-suspend))
|
||
(dolist (obj transient--suffixes)
|
||
(let* ((cmd (oref obj command))
|
||
(sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t))
|
||
(sym (transient--suffix-symbol cmd)))
|
||
(cond
|
||
((oref obj inapt)
|
||
(define-key map (vector sym) #'transient--do-warn-inapt))
|
||
((slot-boundp obj 'transient)
|
||
(define-key map (vector sym)
|
||
(let ((do (oref obj transient)))
|
||
(pcase (list do sub-prefix)
|
||
('(t t) #'transient--do-recurse)
|
||
('(t nil) (if (cl-typep obj 'transient-infix)
|
||
#'transient--do-stay
|
||
#'transient--do-call))
|
||
('(nil t) #'transient--do-replace)
|
||
('(nil nil) #'transient--do-exit)
|
||
(_ do)))))
|
||
((not (lookup-key transient-predicate-map (vector sym)))
|
||
(define-key map (vector sym)
|
||
(if sub-prefix
|
||
#'transient--do-replace
|
||
(or (oref transient--prefix transient-suffix)
|
||
#'transient--do-exit)))))))
|
||
map))
|
||
|
||
(defun transient--make-redisplay-map ()
|
||
(setq transient--redisplay-key
|
||
(cl-case this-command
|
||
(transient-update
|
||
(setq transient--showp t)
|
||
(setq unread-command-events
|
||
(listify-key-sequence (this-single-command-raw-keys))))
|
||
(transient-quit-seq
|
||
(setq unread-command-events
|
||
(butlast (listify-key-sequence
|
||
(this-single-command-raw-keys))
|
||
2))
|
||
(butlast transient--redisplay-key))
|
||
(t nil)))
|
||
(let ((topmap (make-sparse-keymap))
|
||
(submap (make-sparse-keymap)))
|
||
(when transient--redisplay-key
|
||
(define-key topmap (vconcat transient--redisplay-key) submap)
|
||
(set-keymap-parent submap transient-sticky-map))
|
||
(map-keymap-internal
|
||
(lambda (key def)
|
||
(when (and (not (eq key ?\e))
|
||
(listp def)
|
||
(keymapp def))
|
||
(define-key topmap (vconcat transient--redisplay-key (list key))
|
||
#'transient-update)))
|
||
(if transient--redisplay-key
|
||
(let ((key (vconcat transient--redisplay-key)))
|
||
(or (lookup-key transient--transient-map key)
|
||
(and-let* ((regular (lookup-key local-function-key-map key)))
|
||
(lookup-key transient--transient-map (vconcat regular)))))
|
||
transient--transient-map))
|
||
topmap))
|
||
|
||
;;; Setup
|
||
|
||
(defun transient-setup (&optional name layout edit &rest params)
|
||
"Setup the transient specified by NAME.
|
||
|
||
This function is called by transient prefix commands to setup the
|
||
transient. In that case NAME is mandatory, LAYOUT and EDIT must
|
||
be nil and PARAMS may be (but usually is not) used to set e.g. the
|
||
\"scope\" of the transient (see `transient-define-prefix').
|
||
|
||
This function is also called internally in which case LAYOUT and
|
||
EDIT may be non-nil."
|
||
(transient--debug 'setup)
|
||
(transient--with-emergency-exit
|
||
(cond
|
||
((not name)
|
||
;; Switching between regular and edit mode.
|
||
(transient--pop-keymap 'transient--transient-map)
|
||
(transient--pop-keymap 'transient--redisplay-map)
|
||
(setq name (oref transient--prefix command))
|
||
(setq params (list :scope (oref transient--prefix scope))))
|
||
(transient--prefix
|
||
;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}"
|
||
;; of an outer prefix. Unlike the usual `transient--do-replace',
|
||
;; these predicates fail to clean up after the outer prefix.
|
||
(transient--pop-keymap 'transient--transient-map)
|
||
(transient--pop-keymap 'transient--redisplay-map))
|
||
((not (or layout ; resuming parent/suspended prefix
|
||
transient-current-command)) ; entering child prefix
|
||
(transient--stack-zap)) ; replace suspended prefix, if any
|
||
(edit
|
||
;; Returning from help to edit.
|
||
(setq transient--editp t)))
|
||
(transient--init-objects name layout params)
|
||
(transient--history-init transient--prefix)
|
||
(setq transient--predicate-map (transient--make-predicate-map))
|
||
(setq transient--transient-map (transient--make-transient-map))
|
||
(setq transient--redisplay-map (transient--make-redisplay-map))
|
||
(setq transient--original-window (selected-window))
|
||
(setq transient--original-buffer (current-buffer))
|
||
(setq transient--minibuffer-depth (minibuffer-depth))
|
||
(transient--redisplay)
|
||
(transient--init-transient)
|
||
(transient--suspend-which-key-mode)))
|
||
|
||
(cl-defgeneric transient-setup-children (group children)
|
||
"Setup the CHILDREN of GROUP.
|
||
If the value of the `setup-children' slot is non-nil, then call
|
||
that function with CHILDREN as the only argument and return the
|
||
value. Otherwise return CHILDREN as is."
|
||
(if (slot-boundp group 'setup-children)
|
||
(funcall (oref group setup-children) children)
|
||
children))
|
||
|
||
(defun transient--init-objects (name layout params)
|
||
(setq transient--prefix (transient--init-prefix name params))
|
||
(setq transient--layout (or layout (transient--init-suffixes name)))
|
||
(setq transient--suffixes (transient--flatten-suffixes transient--layout)))
|
||
|
||
(defun transient--init-prefix (name &optional params)
|
||
(let ((obj (let ((proto (get name 'transient--prefix)))
|
||
(apply #'clone proto
|
||
:prototype proto
|
||
:level (or (alist-get t (alist-get name transient-levels))
|
||
transient-default-level)
|
||
params))))
|
||
(transient--setup-recursion obj)
|
||
(transient-init-value obj)
|
||
obj))
|
||
|
||
(defun transient--init-suffixes (name)
|
||
(let ((levels (alist-get name transient-levels)))
|
||
(cl-mapcan (lambda (c) (transient--init-child levels c))
|
||
(append (get name 'transient--layout)
|
||
(and (not transient--editp)
|
||
(get 'transient-common-commands
|
||
'transient--layout))))))
|
||
|
||
(defun transient--flatten-suffixes (layout)
|
||
(cl-labels ((s (def)
|
||
(cond
|
||
((stringp def) nil)
|
||
((listp def) (cl-mapcan #'s def))
|
||
((transient-group--eieio-childp def)
|
||
(cl-mapcan #'s (oref def suffixes)))
|
||
((transient-suffix--eieio-childp def)
|
||
(list def)))))
|
||
(cl-mapcan #'s layout)))
|
||
|
||
(defun transient--init-child (levels spec)
|
||
(cl-etypecase spec
|
||
(vector (transient--init-group levels spec))
|
||
(list (transient--init-suffix levels spec))
|
||
(string (list spec))))
|
||
|
||
(defun transient--init-group (levels spec)
|
||
(pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
|
||
(when-let* ((- (transient--use-level-p level))
|
||
(obj (apply class :level level args))
|
||
(- (transient--use-suffix-p obj))
|
||
(suffixes (cl-mapcan (lambda (c) (transient--init-child levels c))
|
||
(transient-setup-children obj children))))
|
||
;; Cannot use and-let* because of debbugs#31840.
|
||
(oset obj suffixes suffixes)
|
||
(list obj))))
|
||
|
||
(defun transient--init-suffix (levels spec)
|
||
(pcase-let* ((`(,level ,class ,args) spec)
|
||
(cmd (plist-get args :command))
|
||
(level (or (alist-get (transient--suffix-symbol cmd) levels)
|
||
level)))
|
||
(let ((fn (and (symbolp cmd)
|
||
(symbol-function cmd))))
|
||
(when (autoloadp fn)
|
||
(transient--debug " autoload %s" cmd)
|
||
(autoload-do-load fn)))
|
||
(when (transient--use-level-p level)
|
||
(let ((obj (if-let ((proto (and cmd
|
||
(symbolp cmd)
|
||
(get cmd 'transient--suffix))))
|
||
(apply #'clone proto :level level args)
|
||
(apply class :level level args))))
|
||
(transient--init-suffix-key obj)
|
||
(transient--ensure-infix-command obj)
|
||
(when (transient--use-suffix-p obj)
|
||
(if (transient--inapt-suffix-p obj)
|
||
(oset obj inapt t)
|
||
(transient-init-scope obj)
|
||
(transient-init-value obj))
|
||
(list obj))))))
|
||
|
||
(cl-defmethod transient--init-suffix-key ((obj transient-suffix))
|
||
(unless (slot-boundp obj 'key)
|
||
(error "No key for %s" (oref obj command))))
|
||
|
||
(cl-defmethod transient--init-suffix-key ((obj transient-argument))
|
||
(if (transient-switches--eieio-childp obj)
|
||
(cl-call-next-method obj)
|
||
(unless (slot-boundp obj 'shortarg)
|
||
(when-let ((shortarg (transient--derive-shortarg (oref obj argument))))
|
||
(oset obj shortarg shortarg)))
|
||
(unless (slot-boundp obj 'key)
|
||
(if (slot-boundp obj 'shortarg)
|
||
(oset obj key (oref obj shortarg))
|
||
(error "No key for %s" (oref obj command))))))
|
||
|
||
(defun transient--use-level-p (level &optional edit)
|
||
(or (and transient--editp (not edit))
|
||
(and (>= level 1)
|
||
(<= level (oref transient--prefix level)))))
|
||
|
||
(defun transient--use-suffix-p (obj)
|
||
(transient--do-suffix-p
|
||
(oref obj if)
|
||
(oref obj if-not)
|
||
(oref obj if-nil)
|
||
(oref obj if-non-nil)
|
||
(oref obj if-mode)
|
||
(oref obj if-not-mode)
|
||
(oref obj if-derived)
|
||
(oref obj if-not-derived)
|
||
t))
|
||
|
||
(defun transient--inapt-suffix-p (obj)
|
||
(transient--do-suffix-p
|
||
(oref obj inapt-if)
|
||
(oref obj inapt-if-not)
|
||
(oref obj inapt-if-nil)
|
||
(oref obj inapt-if-non-nil)
|
||
(oref obj inapt-if-mode)
|
||
(oref obj inapt-if-not-mode)
|
||
(oref obj inapt-if-derived)
|
||
(oref obj inapt-if-not-derived)
|
||
nil))
|
||
|
||
(defun transient--do-suffix-p
|
||
(if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived
|
||
default)
|
||
(cond
|
||
(if (funcall if))
|
||
(if-not (not (funcall if-not)))
|
||
(if-non-nil (symbol-value if-non-nil))
|
||
(if-nil (not (symbol-value if-nil)))
|
||
(if-mode (if (atom if-mode)
|
||
(eq major-mode if-mode)
|
||
(memq major-mode if-mode)))
|
||
(if-not-mode (not (if (atom if-not-mode)
|
||
(eq major-mode if-not-mode)
|
||
(memq major-mode if-not-mode))))
|
||
(if-derived (if (atom if-derived)
|
||
(derived-mode-p if-derived)
|
||
(apply #'derived-mode-p if-derived)))
|
||
(if-not-derived (not (if (atom if-not-derived)
|
||
(derived-mode-p if-not-derived)
|
||
(apply #'derived-mode-p if-not-derived))))
|
||
(t default)))
|
||
|
||
(defun transient--suffix-predicate (spec)
|
||
(let ((plist (nth 2 spec)))
|
||
(seq-some (lambda (prop)
|
||
(and-let* ((pred (plist-get plist prop)))
|
||
(list prop pred)))
|
||
'( :if :if-not
|
||
:if-nil :if-non-nil
|
||
:if-mode :if-not-mode
|
||
:if-derived :if-not-derived
|
||
:inapt-if :inapt-if-not
|
||
:inapt-if-nil :inapt-if-non-nil
|
||
:inapt-if-mode :inapt-if-not-mode
|
||
:inapt-if-derived :inapt-if-not-derived))))
|
||
|
||
;;; Flow-Control
|
||
|
||
(defun transient--init-transient ()
|
||
(transient--debug 'init-transient)
|
||
(transient--push-keymap 'transient--transient-map)
|
||
(transient--push-keymap 'transient--redisplay-map)
|
||
(add-hook 'pre-command-hook #'transient--pre-command)
|
||
(add-hook 'post-command-hook #'transient--post-command)
|
||
(when transient--exitp
|
||
;; This prefix command was invoked as the suffix of another.
|
||
;; Prevent `transient--post-command' from removing the hooks
|
||
;; that we just added.
|
||
(setq transient--exitp 'replace)))
|
||
|
||
(defun transient--pre-command ()
|
||
(transient--debug 'pre-command)
|
||
(transient--with-emergency-exit
|
||
;; The use of `overriding-terminal-local-map' does not prevent the
|
||
;; lookup of command remappings in the overridden maps, which can
|
||
;; lead to a suffix being remapped to a non-suffix. We have to undo
|
||
;; the remapping in that case. However, remapping a non-suffix to
|
||
;; another should remain possible.
|
||
(when (and (transient--get-predicate-for this-original-command 'suffix)
|
||
(not (transient--get-predicate-for this-command 'suffix)))
|
||
(setq this-command this-original-command))
|
||
(cond
|
||
((memq this-command '(transient-update transient-quit-seq))
|
||
(transient--pop-keymap 'transient--redisplay-map))
|
||
((and transient--helpp
|
||
(not (memq this-command '(transient-quit-one
|
||
transient-quit-all))))
|
||
(cond
|
||
((transient-help)
|
||
(transient--do-suspend)
|
||
(setq this-command 'transient-suspend)
|
||
(transient--pre-exit))
|
||
((not (transient--edebug-command-p))
|
||
(setq this-command 'transient-undefined))))
|
||
((and transient--editp
|
||
(transient-suffix-object)
|
||
(not (memq this-command '(transient-quit-one
|
||
transient-quit-all
|
||
transient-help))))
|
||
(setq this-command 'transient-set-level))
|
||
(t
|
||
(setq transient--exitp nil)
|
||
(when (eq (transient--do-pre-command) transient--exit)
|
||
(transient--pre-exit))))))
|
||
|
||
(defun transient--do-pre-command ()
|
||
(if-let ((fn (transient--get-predicate-for this-command)))
|
||
(let ((action (funcall fn)))
|
||
(when (eq action transient--exit)
|
||
(setq transient--exitp (or transient--exitp t)))
|
||
action)
|
||
(if (let ((keys (this-command-keys-vector)))
|
||
(eq (aref keys (1- (length keys))) ?\C-g))
|
||
(setq this-command 'transient-noop)
|
||
(unless (transient--edebug-command-p)
|
||
(setq this-command 'transient-undefined)))
|
||
transient--stay))
|
||
|
||
(defun transient--get-predicate-for (cmd &optional suffix-only)
|
||
(or (ignore-errors
|
||
(lookup-key transient--predicate-map
|
||
(vector (transient--suffix-symbol cmd))))
|
||
(and (not suffix-only)
|
||
(let ((pred (oref transient--prefix transient-non-suffix)))
|
||
(pcase pred
|
||
('t #'transient--do-stay)
|
||
('nil #'transient--do-warn)
|
||
(_ pred))))))
|
||
|
||
(defun transient--pre-exit ()
|
||
(transient--debug 'pre-exit)
|
||
(transient--delete-window)
|
||
(transient--timer-cancel)
|
||
(transient--pop-keymap 'transient--transient-map)
|
||
(transient--pop-keymap 'transient--redisplay-map)
|
||
(unless transient--showp
|
||
(let ((message-log-max nil))
|
||
(message "")))
|
||
(setq transient--transient-map nil)
|
||
(setq transient--predicate-map nil)
|
||
(setq transient--redisplay-map nil)
|
||
(setq transient--redisplay-key nil)
|
||
(setq transient--helpp nil)
|
||
(setq transient--editp nil)
|
||
(setq transient--prefix nil)
|
||
(setq transient--layout nil)
|
||
(setq transient--suffixes nil)
|
||
(setq transient--original-window nil)
|
||
(setq transient--original-buffer nil)
|
||
(setq transient--window nil))
|
||
|
||
(defun transient--delete-window ()
|
||
(when (window-live-p transient--window)
|
||
(let ((remain-in-minibuffer-window
|
||
(and (minibuffer-selected-window)
|
||
(selected-window)))
|
||
(buf (window-buffer transient--window)))
|
||
;; Only delete the window if it never showed another buffer.
|
||
(unless (eq (car (window-parameter transient--window 'quit-restore)) 'other)
|
||
(with-demoted-errors "Error while exiting transient: %S"
|
||
(delete-window transient--window)))
|
||
(kill-buffer buf)
|
||
(when remain-in-minibuffer-window
|
||
(select-window remain-in-minibuffer-window)))))
|
||
|
||
(defun transient--export ()
|
||
(setq transient-current-prefix transient--prefix)
|
||
(setq transient-current-command (oref transient--prefix command))
|
||
(setq transient-current-suffixes transient--suffixes)
|
||
(transient--history-push transient--prefix))
|
||
|
||
(defun transient--suspend-override (&optional nohide)
|
||
(transient--debug 'suspend-override)
|
||
(transient--timer-cancel)
|
||
(cond ((and (not nohide) transient-hide-during-minibuffer-read)
|
||
(transient--delete-window))
|
||
((and transient--prefix transient--redisplay-key)
|
||
(setq transient--redisplay-key nil)
|
||
(when transient--showp
|
||
(transient--show))))
|
||
(transient--pop-keymap 'transient--transient-map)
|
||
(transient--pop-keymap 'transient--redisplay-map)
|
||
(remove-hook 'pre-command-hook #'transient--pre-command)
|
||
(remove-hook 'post-command-hook #'transient--post-command))
|
||
|
||
(defun transient--resume-override ()
|
||
(transient--debug 'resume-override)
|
||
(when (and transient--showp transient-hide-during-minibuffer-read)
|
||
(transient--show))
|
||
(transient--push-keymap 'transient--transient-map)
|
||
(transient--push-keymap 'transient--redisplay-map)
|
||
(add-hook 'pre-command-hook #'transient--pre-command)
|
||
(add-hook 'post-command-hook #'transient--post-command))
|
||
|
||
(defmacro transient--with-suspended-override (&rest body)
|
||
(let ((depth (make-symbol "depth"))
|
||
(setup (make-symbol "setup"))
|
||
(exit (make-symbol "exit")))
|
||
`(if (and transient--transient-map
|
||
(memq transient--transient-map
|
||
overriding-terminal-local-map))
|
||
(let ((,depth (1+ (minibuffer-depth))) ,setup ,exit)
|
||
(setq ,setup
|
||
(lambda () "@transient--with-suspended-override"
|
||
(transient--debug 'minibuffer-setup)
|
||
(remove-hook 'minibuffer-setup-hook ,setup)
|
||
(transient--suspend-override)))
|
||
(setq ,exit
|
||
(lambda () "@transient--with-suspended-override"
|
||
(transient--debug 'minibuffer-exit)
|
||
(when (= (minibuffer-depth) ,depth)
|
||
(transient--resume-override))))
|
||
(unwind-protect
|
||
(progn
|
||
(add-hook 'minibuffer-setup-hook ,setup)
|
||
(add-hook 'minibuffer-exit-hook ,exit)
|
||
,@body)
|
||
(remove-hook 'minibuffer-setup-hook ,setup)
|
||
(remove-hook 'minibuffer-exit-hook ,exit)))
|
||
,@body)))
|
||
|
||
(defun transient--post-command-hook ()
|
||
(run-hooks 'transient--post-command-hook))
|
||
|
||
(add-hook 'post-command-hook #'transient--post-command-hook)
|
||
|
||
(defun transient--delay-post-command (&optional abort-only)
|
||
(transient--debug 'delay-post-command)
|
||
(let ((depth (minibuffer-depth))
|
||
(command this-command)
|
||
(delayed (if transient--exitp
|
||
(apply-partially #'transient--post-exit this-command)
|
||
#'transient--resume-override))
|
||
post-command abort-minibuffer)
|
||
(unless abort-only
|
||
(setq post-command
|
||
(lambda () "@transient--delay-post-command"
|
||
(let ((act (and (not (eq (this-command-keys-vector) []))
|
||
(or (eq this-command command)
|
||
;; `execute-extended-command' was
|
||
;; used to call another command
|
||
;; that also uses the minibuffer.
|
||
(equal
|
||
(ignore-errors
|
||
(string-to-multibyte (this-command-keys)))
|
||
(format "\M-x%s\r" this-command))))))
|
||
(transient--debug 'post-command-hook "act: %s" act)
|
||
(when act
|
||
(remove-hook 'transient--post-command-hook post-command)
|
||
(remove-hook 'minibuffer-exit-hook abort-minibuffer)
|
||
(funcall delayed)))))
|
||
(add-hook 'transient--post-command-hook post-command))
|
||
(setq abort-minibuffer
|
||
(lambda () "@transient--delay-post-command"
|
||
(let ((act (and (or (memq this-command transient--abort-commands)
|
||
(equal (this-command-keys) ""))
|
||
(= (minibuffer-depth) depth))))
|
||
(transient--debug
|
||
'abort-minibuffer
|
||
"mini: %s|%s, act %s" (minibuffer-depth) depth act)
|
||
(when act
|
||
(remove-hook 'transient--post-command-hook post-command)
|
||
(remove-hook 'minibuffer-exit-hook abort-minibuffer)
|
||
(funcall delayed)))))
|
||
(add-hook 'minibuffer-exit-hook abort-minibuffer)))
|
||
|
||
(defun transient--post-command ()
|
||
(transient--debug 'post-command)
|
||
(transient--with-emergency-exit
|
||
(cond
|
||
((and (eq (this-command-keys-vector) [])
|
||
(= (minibuffer-depth)
|
||
(1+ transient--minibuffer-depth)))
|
||
(transient--suspend-override)
|
||
(transient--delay-post-command (eq transient--exitp 'replace)))
|
||
(transient--exitp
|
||
(transient--post-exit))
|
||
((eq this-command (oref transient--prefix command)))
|
||
(t
|
||
(let ((old transient--redisplay-map)
|
||
(new (transient--make-redisplay-map)))
|
||
(unless (equal old new)
|
||
(transient--pop-keymap 'transient--redisplay-map)
|
||
(setq transient--redisplay-map new)
|
||
(transient--push-keymap 'transient--redisplay-map)))
|
||
(transient--redisplay)))))
|
||
|
||
(defun transient--post-exit (&optional command)
|
||
(transient--debug 'post-exit)
|
||
(unless (and (eq transient--exitp 'replace)
|
||
(or transient--prefix
|
||
;; The current command could act as a prefix,
|
||
;; but decided not to call `transient-setup',
|
||
;; or it is prevented from doing so because it
|
||
;; uses the minibuffer and the user aborted
|
||
;; that.
|
||
(prog1 nil
|
||
(if (let ((obj (transient-suffix-object command)))
|
||
(and (slot-boundp obj 'transient)
|
||
(oref obj transient)))
|
||
;; This sub-prefix is a transient suffix;
|
||
;; go back to outer prefix, by calling
|
||
;; `transient--stack-pop' further down.
|
||
(setq transient--exitp nil)
|
||
(transient--stack-zap)))))
|
||
(remove-hook 'pre-command-hook #'transient--pre-command)
|
||
(remove-hook 'post-command-hook #'transient--post-command))
|
||
(setq transient-current-prefix nil)
|
||
(setq transient-current-command nil)
|
||
(setq transient-current-suffixes nil)
|
||
(let ((resume (and transient--stack
|
||
(not (memq transient--exitp '(replace suspend))))))
|
||
(unless (or resume (eq transient--exitp 'replace))
|
||
(setq transient--showp nil))
|
||
(setq transient--exitp nil)
|
||
(setq transient--helpp nil)
|
||
(setq transient--editp nil)
|
||
(setq transient--minibuffer-depth 0)
|
||
(run-hooks 'transient-exit-hook)
|
||
(when resume
|
||
(transient--stack-pop))))
|
||
|
||
(defun transient--stack-push ()
|
||
(transient--debug 'stack-push)
|
||
(push (list (oref transient--prefix command)
|
||
transient--layout
|
||
transient--editp
|
||
:scope (oref transient--prefix scope))
|
||
transient--stack))
|
||
|
||
(defun transient--stack-pop ()
|
||
(transient--debug 'stack-pop)
|
||
(and transient--stack
|
||
(prog1 t (apply #'transient-setup (pop transient--stack)))))
|
||
|
||
(defun transient--stack-zap ()
|
||
(transient--debug 'stack-zap)
|
||
(setq transient--stack nil))
|
||
|
||
(defun transient--redisplay ()
|
||
(if (or (eq transient-show-popup t)
|
||
transient--showp)
|
||
(unless
|
||
(or (memq this-command transient--scroll-commands)
|
||
(and (or (memq this-command '(mouse-drag-region
|
||
mouse-set-region))
|
||
(equal (key-description (this-command-keys-vector))
|
||
"<mouse-movement>"))
|
||
(and (eq (current-buffer)
|
||
(get-buffer transient--buffer-name)))))
|
||
(transient--show))
|
||
(when (and (numberp transient-show-popup)
|
||
(not (zerop transient-show-popup))
|
||
(not transient--timer))
|
||
(transient--timer-start))
|
||
(transient--show-brief)))
|
||
|
||
(defun transient--timer-start ()
|
||
(setq transient--timer
|
||
(run-at-time (abs transient-show-popup) nil
|
||
(lambda ()
|
||
(transient--timer-cancel)
|
||
(transient--show)
|
||
(let ((message-log-max nil))
|
||
(message ""))))))
|
||
|
||
(defun transient--timer-cancel ()
|
||
(when transient--timer
|
||
(cancel-timer transient--timer)
|
||
(setq transient--timer nil)))
|
||
|
||
(defun transient--debug (arg &rest args)
|
||
(when transient--debug
|
||
(let ((inhibit-message (not (eq transient--debug 'message))))
|
||
(if (symbolp arg)
|
||
(message "-- %-18s (cmd: %s, event: %S, exit: %s%s)"
|
||
arg
|
||
(or (ignore-errors (transient--suffix-symbol this-command))
|
||
(if (byte-code-function-p this-command)
|
||
"#[...]"
|
||
this-command))
|
||
(key-description (this-command-keys-vector))
|
||
transient--exitp
|
||
(cond ((stringp (car args))
|
||
(concat ", " (apply #'format args)))
|
||
(args
|
||
(concat ", " (apply (car args) (cdr args))))
|
||
(t "")))
|
||
(apply #'message arg args)))))
|
||
|
||
(defun transient--emergency-exit ()
|
||
"Exit the current transient command after an error occurred.
|
||
When no transient is active (i.e. when `transient--prefix' is
|
||
nil) then do nothing."
|
||
(transient--debug 'emergency-exit)
|
||
(when transient--prefix
|
||
(setq transient--stack nil)
|
||
(setq transient--exitp t)
|
||
(transient--pre-exit)
|
||
(transient--post-exit)))
|
||
|
||
;;; Pre-Commands
|
||
|
||
(defun transient--do-stay ()
|
||
"Call the command without exporting variables and stay transient."
|
||
transient--stay)
|
||
|
||
(defun transient--do-noop ()
|
||
"Call `transient-noop' and stay transient."
|
||
(setq this-command 'transient-noop)
|
||
transient--stay)
|
||
|
||
(defun transient--do-warn ()
|
||
"Call `transient-undefined' and stay transient."
|
||
(setq this-command 'transient-undefined)
|
||
transient--stay)
|
||
|
||
(defun transient--do-warn-inapt ()
|
||
"Call `transient-inapt' and stay transient."
|
||
(setq this-command 'transient-inapt)
|
||
transient--stay)
|
||
|
||
(defun transient--do-call ()
|
||
"Call the command after exporting variables and stay transient."
|
||
(transient--export)
|
||
transient--stay)
|
||
|
||
(defun transient--do-return ()
|
||
"Call the command after exporting variables and return to parent prefix.
|
||
If there is no parent prefix, then behave like `transient--do-exit'."
|
||
(if (not transient--stack)
|
||
(transient--do-exit)
|
||
(transient--export)
|
||
transient--exit))
|
||
|
||
(defun transient--do-exit ()
|
||
"Call the command after exporting variables and exit the transient."
|
||
(transient--export)
|
||
(transient--stack-zap)
|
||
transient--exit)
|
||
|
||
(defun transient--do-push-button ()
|
||
"Call the command represented by the activated button.
|
||
Use that command's pre-command to determine transient behavior."
|
||
(if (and (mouse-event-p last-command-event)
|
||
(not (eq (posn-window (event-start last-command-event))
|
||
transient--window)))
|
||
transient--stay
|
||
(setq this-command
|
||
(with-selected-window transient--window
|
||
(get-text-property (if (mouse-event-p last-command-event)
|
||
(posn-point (event-start last-command-event))
|
||
(point))
|
||
'command)))
|
||
(transient--do-pre-command)))
|
||
|
||
(defun transient--do-recurse ()
|
||
"Call the transient prefix command, preparing for return to active transient.
|
||
If there is no parent prefix, then just call the command."
|
||
(transient--do-replace))
|
||
|
||
(defun transient--setup-recursion (prefix-obj)
|
||
(when transient--stack
|
||
(let ((command (oref prefix-obj command)))
|
||
(when-let ((suffix-obj (transient-suffix-object command)))
|
||
(when (and (slot-boundp suffix-obj 'transient)
|
||
(memq (oref suffix-obj transient)
|
||
(list t #'transient--do-recurse)))
|
||
(oset prefix-obj transient-suffix 'transient--do-return))))))
|
||
|
||
(defun transient--do-replace ()
|
||
"Call the transient prefix command, replacing the active transient."
|
||
(transient--export)
|
||
(transient--stack-push)
|
||
(setq transient--exitp 'replace)
|
||
transient--exit)
|
||
|
||
(defun transient--do-suspend ()
|
||
"Suspend the active transient, saving the transient stack."
|
||
(transient--stack-push)
|
||
(setq transient--exitp 'suspend)
|
||
transient--exit)
|
||
|
||
(defun transient--do-quit-one ()
|
||
"If active, quit help or edit mode, else exit the active transient."
|
||
(cond (transient--helpp
|
||
(setq transient--helpp nil)
|
||
transient--stay)
|
||
(transient--editp
|
||
(setq transient--editp nil)
|
||
(transient-setup)
|
||
transient--stay)
|
||
(t transient--exit)))
|
||
|
||
(defun transient--do-quit-all ()
|
||
"Exit all transients without saving the transient stack."
|
||
(transient--stack-zap)
|
||
transient--exit)
|
||
|
||
(defun transient--do-move ()
|
||
"Call the command if `transient-enable-popup-navigation' is non-nil.
|
||
In that case behave like `transient--do-stay', otherwise similar
|
||
to `transient--do-warn'."
|
||
(unless transient-enable-popup-navigation
|
||
(setq this-command 'transient-popup-navigation-help))
|
||
transient--stay)
|
||
|
||
(defun transient--do-minus ()
|
||
"Call `negative-argument' or pivot to `transient-update'.
|
||
If `negative-argument' is invoked using \"-\" then preserve the
|
||
prefix argument and pivot to `transient-update'."
|
||
(when (equal (this-command-keys) "-")
|
||
(setq this-command 'transient-update))
|
||
transient--stay)
|
||
|
||
(put 'transient--do-stay 'transient-color 'transient-red)
|
||
(put 'transient--do-noop 'transient-color 'transient-red)
|
||
(put 'transient--do-warn 'transient-color 'transient-red)
|
||
(put 'transient--do-warn-inapt 'transient-color 'transient-red)
|
||
(put 'transient--do-call 'transient-color 'transient-red)
|
||
(put 'transient--do-return 'transient-color 'transient-purple)
|
||
(put 'transient--do-exit 'transient-color 'transient-blue)
|
||
(put 'transient--do-recurse 'transient-color 'transient-red)
|
||
(put 'transient--do-replace 'transient-color 'transient-blue)
|
||
(put 'transient--do-suspend 'transient-color 'transient-blue)
|
||
(put 'transient--do-quit-one 'transient-color 'transient-blue)
|
||
(put 'transient--do-quit-all 'transient-color 'transient-blue)
|
||
(put 'transient--do-move 'transient-color 'transient-red)
|
||
(put 'transient--do-minus 'transient-color 'transient-red)
|
||
|
||
;;; Commands
|
||
|
||
(defun transient-noop ()
|
||
"Do nothing at all."
|
||
(interactive))
|
||
|
||
(defun transient-undefined ()
|
||
"Warn the user that the pressed key is not bound to any suffix."
|
||
(interactive)
|
||
(transient--invalid "Unbound suffix"))
|
||
|
||
(defun transient-inapt ()
|
||
"Warn the user that the invoked command is inapt."
|
||
(interactive)
|
||
(transient--invalid "Inapt command"))
|
||
|
||
(defun transient--invalid (msg)
|
||
(ding)
|
||
(message "%s: `%s' (Use `%s' to abort, `%s' for help) [%s]"
|
||
msg
|
||
(propertize (key-description (this-single-command-keys))
|
||
'face 'font-lock-warning-face)
|
||
(propertize "C-g" 'face 'transient-key)
|
||
(propertize "?" 'face 'transient-key)
|
||
;; `this-command' is `transient--undefined' or similar at this
|
||
;; point. Show the command the user actually tried to invoke.
|
||
(propertize (symbol-name (transient--suffix-symbol
|
||
this-original-command))
|
||
'face 'font-lock-warning-face))
|
||
(unless (and transient--transient-map
|
||
(memq transient--transient-map overriding-terminal-local-map))
|
||
(let ((transient--prefix (or transient--prefix 'sic)))
|
||
(transient--emergency-exit))
|
||
(view-lossage)
|
||
(other-window 1)
|
||
(display-warning 'transient "Inconsistent transient state detected.
|
||
This should never happen.
|
||
Please open an issue and post the shown command log.
|
||
This is a heisenbug, so any additional details might help.
|
||
Thanks!" :error)))
|
||
|
||
(defun transient-toggle-common ()
|
||
"Toggle whether common commands are always shown."
|
||
(interactive)
|
||
(setq transient-show-common-commands (not transient-show-common-commands)))
|
||
|
||
(defun transient-suspend ()
|
||
"Suspend the current transient.
|
||
It can later be resumed using `transient-resume' while no other
|
||
transient is active."
|
||
(interactive))
|
||
|
||
(defun transient-quit-all ()
|
||
"Exit all transients without saving the transient stack."
|
||
(interactive))
|
||
|
||
(defun transient-quit-one ()
|
||
"Exit the current transients, possibly returning to the previous."
|
||
(interactive))
|
||
|
||
(defun transient-quit-seq ()
|
||
"Abort the current incomplete key sequence."
|
||
(interactive))
|
||
|
||
(defun transient-update ()
|
||
"Redraw the transient's state in the popup buffer."
|
||
(interactive)
|
||
(when (equal this-original-command 'negative-argument)
|
||
(setq prefix-arg current-prefix-arg)))
|
||
|
||
(defun transient-show ()
|
||
"Show the transient's state in the popup buffer."
|
||
(interactive)
|
||
(setq transient--showp t))
|
||
|
||
(defvar-local transient--restore-winconf nil)
|
||
|
||
(defvar transient-resume-mode)
|
||
|
||
(defun transient-help ()
|
||
"Show help for the active transient or one of its suffixes."
|
||
(interactive)
|
||
(if (called-interactively-p 'any)
|
||
(setq transient--helpp t)
|
||
(with-demoted-errors "transient-help: %S"
|
||
(when (lookup-key transient--transient-map
|
||
(this-single-command-raw-keys))
|
||
(setq transient--helpp nil)
|
||
(let ((winconf (current-window-configuration)))
|
||
(transient-show-help
|
||
(if (eq this-original-command 'transient-help)
|
||
transient--prefix
|
||
(or (transient-suffix-object)
|
||
this-original-command)))
|
||
(setq transient--restore-winconf winconf))
|
||
(fit-window-to-buffer nil (frame-height) (window-height))
|
||
(transient-resume-mode)
|
||
(message "Type \"q\" to resume transient command.")
|
||
t))))
|
||
|
||
(defun transient-set-level (&optional command level)
|
||
"Set the level of the transient or one of its suffix commands."
|
||
(interactive
|
||
(let ((command this-original-command)
|
||
(prefix (oref transient--prefix command)))
|
||
(and (or (not (eq command 'transient-set-level))
|
||
(and transient--editp
|
||
(setq command prefix)))
|
||
(list command
|
||
(let ((keys (this-single-command-raw-keys)))
|
||
(and (lookup-key transient--transient-map keys)
|
||
(string-to-number
|
||
(let ((transient--active-infix
|
||
(transient-suffix-object command)))
|
||
(transient--show)
|
||
(transient--read-number-N
|
||
(format "Set level for `%s': "
|
||
(transient--suffix-symbol command))
|
||
nil nil (not (eq command prefix)))))))))))
|
||
(cond
|
||
((not command)
|
||
(setq transient--editp t)
|
||
(transient-setup))
|
||
(level
|
||
(let* ((prefix (oref transient--prefix command))
|
||
(alist (alist-get prefix transient-levels))
|
||
(sym (transient--suffix-symbol command)))
|
||
(if (eq command prefix)
|
||
(progn (oset transient--prefix level level)
|
||
(setq sym t))
|
||
(oset (transient-suffix-object command) level level))
|
||
(setf (alist-get sym alist) level)
|
||
(setf (alist-get prefix transient-levels) alist))
|
||
(transient-save-levels)
|
||
(transient--show))
|
||
(t
|
||
(transient-undefined))))
|
||
|
||
(defun transient-set ()
|
||
"Save the value of the active transient for this Emacs session."
|
||
(interactive)
|
||
(transient-set-value (or transient--prefix transient-current-prefix)))
|
||
|
||
(defun transient-save ()
|
||
"Save the value of the active transient persistenly across Emacs sessions."
|
||
(interactive)
|
||
(transient-save-value (or transient--prefix transient-current-prefix)))
|
||
|
||
(defun transient-reset ()
|
||
"Clear the set and saved values of the active transient."
|
||
(interactive)
|
||
(transient-reset-value (or transient--prefix transient-current-prefix)))
|
||
|
||
(defun transient-history-next ()
|
||
"Switch to the next value used for the active transient."
|
||
(interactive)
|
||
(let* ((obj transient--prefix)
|
||
(pos (1- (oref obj history-pos)))
|
||
(hst (oref obj history)))
|
||
(if (< pos 0)
|
||
(user-error "End of history")
|
||
(oset obj history-pos pos)
|
||
(oset obj value (nth pos hst))
|
||
(mapc #'transient-init-value transient--suffixes))))
|
||
|
||
(defun transient-history-prev ()
|
||
"Switch to the previous value used for the active transient."
|
||
(interactive)
|
||
(let* ((obj transient--prefix)
|
||
(pos (1+ (oref obj history-pos)))
|
||
(hst (oref obj history))
|
||
(len (length hst)))
|
||
(if (> pos (1- len))
|
||
(user-error "End of history")
|
||
(oset obj history-pos pos)
|
||
(oset obj value (nth pos hst))
|
||
(mapc #'transient-init-value transient--suffixes))))
|
||
|
||
(defun transient-scroll-up (&optional arg)
|
||
"Scroll text of transient popup window upward ARG lines.
|
||
If ARG is nil scroll near full screen. This is a wrapper
|
||
around `scroll-up-command' (which see)."
|
||
(interactive "^P")
|
||
(with-selected-window transient--window
|
||
(scroll-up-command arg)))
|
||
|
||
(defun transient-scroll-down (&optional arg)
|
||
"Scroll text of transient popup window down ARG lines.
|
||
If ARG is nil scroll near full screen. This is a wrapper
|
||
around `scroll-down-command' (which see)."
|
||
(interactive "^P")
|
||
(with-selected-window transient--window
|
||
(scroll-down-command arg)))
|
||
|
||
(defun transient-push-button ()
|
||
"Invoke the suffix command represented by this button."
|
||
(interactive))
|
||
|
||
(defun transient-resume ()
|
||
"Resume a previously suspended stack of transients."
|
||
(interactive)
|
||
(cond (transient--stack
|
||
(let ((winconf transient--restore-winconf))
|
||
(kill-local-variable 'transient--restore-winconf)
|
||
(when transient-resume-mode
|
||
(transient-resume-mode -1)
|
||
(quit-window))
|
||
(when winconf
|
||
(set-window-configuration winconf)))
|
||
(transient--stack-pop))
|
||
(transient-resume-mode
|
||
(kill-local-variable 'transient--restore-winconf)
|
||
(transient-resume-mode -1)
|
||
(quit-window))
|
||
(t
|
||
(message "No suspended transient command"))))
|
||
|
||
;;; Value
|
||
;;;; Init
|
||
|
||
(cl-defgeneric transient-init-scope (obj)
|
||
"Set the scope of the suffix object OBJ.
|
||
|
||
The scope is actually a property of the transient prefix, not of
|
||
individual suffixes. However it is possible to invoke a suffix
|
||
command directly instead of from a transient. In that case, if
|
||
the suffix expects a scope, then it has to determine that itself
|
||
and store it in its `scope' slot.
|
||
|
||
This function is called for all suffix commands, but unless a
|
||
concrete method is implemented this falls through to the default
|
||
implementation, which is a noop.")
|
||
|
||
(cl-defmethod transient-init-scope ((_ transient-suffix))
|
||
"Noop." nil)
|
||
|
||
(cl-defgeneric transient-init-value (_)
|
||
"Set the initial value of the object OBJ.
|
||
|
||
This function is called for all prefix and suffix commands.
|
||
|
||
For suffix commands (including infix argument commands) the
|
||
default implementation is a noop. Classes derived from the
|
||
abstract `transient-infix' class must implement this function.
|
||
Non-infix suffix commands usually don't have a value."
|
||
nil)
|
||
|
||
(cl-defmethod transient-init-value :around ((obj transient-prefix))
|
||
"If bound, then call OBJ's `init-value' function.
|
||
Otherwise call the primary method according to object's class."
|
||
(if (slot-boundp obj 'init-value)
|
||
(funcall (oref obj init-value) obj)
|
||
(cl-call-next-method obj)))
|
||
|
||
(cl-defmethod transient-init-value :around ((obj transient-infix))
|
||
"If bound, then call OBJ's `init-value' function.
|
||
Otherwise call the primary method according to object's class."
|
||
(if (slot-boundp obj 'init-value)
|
||
(funcall (oref obj init-value) obj)
|
||
(cl-call-next-method obj)))
|
||
|
||
(cl-defmethod transient-init-value ((obj transient-prefix))
|
||
(if (slot-boundp obj 'value)
|
||
(oref obj value)
|
||
(oset obj value
|
||
(if-let ((saved (assq (oref obj command) transient-values)))
|
||
(cdr saved)
|
||
(transient-default-value obj)))))
|
||
|
||
(cl-defmethod transient-init-value ((obj transient-argument))
|
||
(oset obj value
|
||
(let ((value (oref transient--prefix value))
|
||
(argument (and (slot-boundp obj 'argument)
|
||
(oref obj argument)))
|
||
(multi-value (oref obj multi-value))
|
||
(case-fold-search nil)
|
||
(regexp (if (slot-exists-p obj 'argument-regexp)
|
||
(oref obj argument-regexp)
|
||
(format "\\`%s\\(.*\\)" (oref obj argument)))))
|
||
(if (memq multi-value '(t rest))
|
||
(cdr (assoc argument value))
|
||
(let ((match (lambda (v)
|
||
(and (stringp v)
|
||
(string-match regexp v)
|
||
(match-string 1 v)))))
|
||
(if multi-value
|
||
(delq nil (mapcar match value))
|
||
(cl-some match value)))))))
|
||
|
||
(cl-defmethod transient-init-value ((obj transient-switch))
|
||
(oset obj value
|
||
(car (member (oref obj argument)
|
||
(oref transient--prefix value)))))
|
||
|
||
;;;; Default
|
||
|
||
(cl-defgeneric transient-default-value (_)
|
||
"Return the default value."
|
||
nil)
|
||
|
||
(cl-defmethod transient-default-value ((obj transient-prefix))
|
||
(if-let ((default (and (slot-boundp obj 'default-value)
|
||
(oref obj default-value))))
|
||
(if (functionp default)
|
||
(funcall default)
|
||
default)
|
||
nil))
|
||
|
||
;;;; Read
|
||
|
||
(cl-defgeneric transient-infix-read (obj)
|
||
"Determine the new value of the infix object OBJ.
|
||
|
||
This function merely determines the value; `transient-infix-set'
|
||
is used to actually store the new value in the object.
|
||
|
||
For most infix classes this is done by reading a value from the
|
||
user using the reader specified by the `reader' slot (using the
|
||
`transient-infix' method described below).
|
||
|
||
For some infix classes the value is changed without reading
|
||
anything in the minibuffer, i.e. the mere act of invoking the
|
||
infix command determines what the new value should be, based
|
||
on the previous value.")
|
||
|
||
(cl-defmethod transient-infix-read :around ((obj transient-infix))
|
||
"Highlight the infix in the popup buffer.
|
||
|
||
This also wraps the call to `cl-call-next-method' with two
|
||
macros.
|
||
|
||
`transient--with-suspended-override' is necessary to allow
|
||
reading user input using the minibuffer.
|
||
|
||
`transient--with-emergency-exit' arranges for the transient to
|
||
be exited in case of an error because otherwise Emacs would get
|
||
stuck in an inconsistent state, which might make it necessary to
|
||
kill it from the outside.
|
||
|
||
If you replace this method, then you must make sure to always use
|
||
the latter macro and most likely also the former."
|
||
(let ((transient--active-infix obj))
|
||
(transient--show))
|
||
(transient--with-emergency-exit
|
||
(transient--with-suspended-override
|
||
(cl-call-next-method obj))))
|
||
|
||
(cl-defmethod transient-infix-read ((obj transient-infix))
|
||
"Read a value while taking care of history.
|
||
|
||
This method is suitable for a wide variety of infix commands,
|
||
including but not limited to inline arguments and variables.
|
||
|
||
If you do not use this method for your own infix class, then
|
||
you should likely replicate a lot of the behavior of this
|
||
method. If you fail to do so, then users might not appreciate
|
||
the lack of history, for example.
|
||
|
||
Only for very simple classes that toggle or cycle through a very
|
||
limited number of possible values should you replace this with a
|
||
simple method that does not handle history. (E.g. for a command
|
||
line switch the only possible values are \"use it\" and \"don't use
|
||
it\", in which case it is pointless to preserve history.)"
|
||
(with-slots (value multi-value always-read allow-empty choices) obj
|
||
(if (and value
|
||
(not multi-value)
|
||
(not always-read)
|
||
transient--prefix)
|
||
(oset obj value nil)
|
||
(let* ((enable-recursive-minibuffers t)
|
||
(reader (oref obj reader))
|
||
(prompt (transient-prompt obj))
|
||
(value (if multi-value (mapconcat #'identity value ",") value))
|
||
(history-key (or (oref obj history-key)
|
||
(oref obj command)))
|
||
(transient--history (alist-get history-key transient-history))
|
||
(transient--history (if (or (null value)
|
||
(eq value (car transient--history)))
|
||
transient--history
|
||
(cons value transient--history)))
|
||
(initial-input (and transient-read-with-initial-input
|
||
(car transient--history)))
|
||
(history (if initial-input
|
||
(cons 'transient--history 1)
|
||
'transient--history))
|
||
(value
|
||
(cond
|
||
(reader (funcall reader prompt initial-input history))
|
||
(multi-value
|
||
(completing-read-multiple prompt choices nil nil
|
||
initial-input history))
|
||
(choices
|
||
(completing-read prompt choices nil t initial-input history))
|
||
(t (read-string prompt initial-input history)))))
|
||
(cond ((and (equal value "") (not allow-empty))
|
||
(setq value nil))
|
||
((and (equal value "\"\"") allow-empty)
|
||
(setq value "")))
|
||
(when value
|
||
(when (and (bound-and-true-p ivy-mode)
|
||
(stringp (car transient--history)))
|
||
(set-text-properties 0 (length (car transient--history)) nil
|
||
(car transient--history)))
|
||
(setf (alist-get history-key transient-history)
|
||
(delete-dups transient--history)))
|
||
value))))
|
||
|
||
(cl-defmethod transient-infix-read ((obj transient-switch))
|
||
"Toggle the switch on or off."
|
||
(if (oref obj value) nil (oref obj argument)))
|
||
|
||
(cl-defmethod transient-infix-read ((obj transient-switches))
|
||
"Cycle through the mutually exclusive switches.
|
||
The last value is \"don't use any of these switches\"."
|
||
(let ((choices (mapcar (apply-partially #'format (oref obj argument-format))
|
||
(oref obj choices))))
|
||
(if-let ((value (oref obj value)))
|
||
(cadr (member value choices))
|
||
(car choices))))
|
||
|
||
(cl-defmethod transient-infix-read ((command symbol))
|
||
"Elsewhere use the reader of the infix command COMMAND.
|
||
Use this if you want to share an infix's history with a regular
|
||
stand-alone command."
|
||
(cl-letf (((symbol-function #'transient--show) #'ignore))
|
||
(transient-infix-read (get command 'transient--suffix))))
|
||
|
||
;;;; Readers
|
||
|
||
(defun transient-read-file (prompt _initial-input _history)
|
||
"Read a file."
|
||
(file-local-name (expand-file-name (read-file-name prompt))))
|
||
|
||
(defun transient-read-existing-file (prompt _initial-input _history)
|
||
"Read an existing file."
|
||
(file-local-name (expand-file-name (read-file-name prompt nil nil t))))
|
||
|
||
(defun transient-read-directory (prompt _initial-input _history)
|
||
"Read a directory."
|
||
(file-local-name (expand-file-name (read-directory-name prompt))))
|
||
|
||
(defun transient-read-existing-directory (prompt _initial-input _history)
|
||
"Read an existing directory."
|
||
(file-local-name (expand-file-name (read-directory-name prompt nil nil t))))
|
||
|
||
(defun transient-read-number-N0 (prompt initial-input history)
|
||
"Read a natural number (including zero) and return it as a string."
|
||
(transient--read-number-N prompt initial-input history t))
|
||
|
||
(defun transient-read-number-N+ (prompt initial-input history)
|
||
"Read a natural number (excluding zero) and return it as a string."
|
||
(transient--read-number-N prompt initial-input history nil))
|
||
|
||
(defun transient--read-number-N (prompt initial-input history include-zero)
|
||
(save-match-data
|
||
(cl-block nil
|
||
(while t
|
||
(let ((str (read-from-minibuffer prompt initial-input nil nil history)))
|
||
(when (or (string-equal str "")
|
||
(string-match-p (if include-zero
|
||
"\\`\\(0\\|[1-9][0-9]*\\)\\'"
|
||
"\\`[1-9][0-9]*\\'")
|
||
str))
|
||
(cl-return str)))
|
||
(message "Please enter a natural number (%s zero)."
|
||
(if include-zero "including" "excluding"))
|
||
(sit-for 1)))))
|
||
|
||
(defun transient-read-date (prompt default-time _history)
|
||
"Read a date using `org-read-date' (which see)."
|
||
(require 'org)
|
||
(when (fboundp 'org-read-date)
|
||
(org-read-date 'with-time nil nil prompt default-time)))
|
||
|
||
;;;; Prompt
|
||
|
||
(cl-defgeneric transient-prompt (obj)
|
||
"Return the prompt to be used to read infix object OBJ's value.")
|
||
|
||
(cl-defmethod transient-prompt ((obj transient-infix))
|
||
"Return the prompt to be used to read infix object OBJ's value.
|
||
|
||
This implementation should be suitable for almost all infix
|
||
commands.
|
||
|
||
If the value of OBJ's `prompt' slot is non-nil, then it must be
|
||
a string or a function. If it is a string, then use that. If
|
||
it is a function, then call that with OBJ as the only argument.
|
||
That function must return a string, which is then used as the
|
||
prompt.
|
||
|
||
Otherwise, if the value of either the `argument' or `variable'
|
||
slot of OBJ is a string, then base the prompt on that (preferring
|
||
the former), appending either \"=\" (if it appears to be a
|
||
command-line option) or \": \".
|
||
|
||
Finally fall through to using \"(BUG: no prompt): \" as the
|
||
prompt."
|
||
(if-let ((prompt (oref obj prompt)))
|
||
(let ((prompt (if (functionp prompt)
|
||
(funcall prompt obj)
|
||
prompt)))
|
||
(if (stringp prompt)
|
||
prompt
|
||
"(BUG: no prompt): "))
|
||
(or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
|
||
(if (and (stringp arg) (string-suffix-p "=" arg))
|
||
arg
|
||
(concat arg ": ")))
|
||
(and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable))))
|
||
(and (stringp var)
|
||
(concat var ": ")))
|
||
"(BUG: no prompt): ")))
|
||
|
||
;;;; Set
|
||
|
||
(defvar transient--unset-incompatible t)
|
||
|
||
(cl-defgeneric transient-infix-set (obj value)
|
||
"Set the value of infix object OBJ to value.")
|
||
|
||
(cl-defmethod transient-infix-set ((obj transient-infix) value)
|
||
"Set the value of infix object OBJ to value."
|
||
(oset obj value value))
|
||
|
||
(cl-defmethod transient-infix-set :around ((obj transient-argument) value)
|
||
"Unset incompatible infix arguments."
|
||
(let ((arg (if (slot-boundp obj 'argument)
|
||
(oref obj argument)
|
||
(oref obj argument-regexp))))
|
||
(if-let ((sic (and value arg transient--unset-incompatible))
|
||
(spec (oref transient--prefix incompatible))
|
||
(incomp (cl-mapcan (lambda (rule)
|
||
(and (member arg rule)
|
||
(remove arg rule)))
|
||
spec)))
|
||
(progn
|
||
(cl-call-next-method obj value)
|
||
(dolist (arg incomp)
|
||
(when-let ((obj (cl-find-if (lambda (obj)
|
||
(and (slot-boundp obj 'argument)
|
||
(equal (oref obj argument) arg)))
|
||
transient--suffixes)))
|
||
(let ((transient--unset-incompatible nil))
|
||
(transient-infix-set obj nil)))))
|
||
(cl-call-next-method obj value))))
|
||
|
||
(cl-defgeneric transient-set-value (obj)
|
||
"Set the value of the transient prefix OBJ.")
|
||
|
||
(cl-defmethod transient-set-value ((obj transient-prefix))
|
||
(oset (oref obj prototype) value (transient-get-value))
|
||
(transient--history-push obj))
|
||
|
||
;;;; Save
|
||
|
||
(cl-defgeneric transient-save-value (obj)
|
||
"Save the value of the transient prefix OBJ.")
|
||
|
||
(cl-defmethod transient-save-value ((obj transient-prefix))
|
||
(let ((value (transient-get-value)))
|
||
(oset (oref obj prototype) value value)
|
||
(setf (alist-get (oref obj command) transient-values) value)
|
||
(transient-save-values))
|
||
(transient--history-push obj))
|
||
|
||
;;;; Reset
|
||
|
||
(cl-defgeneric transient-reset-value (obj)
|
||
"Clear the set and saved values of the transient prefix OBJ.")
|
||
|
||
(cl-defmethod transient-reset-value ((obj transient-prefix))
|
||
(let ((value (transient-default-value obj)))
|
||
(oset obj value value)
|
||
(oset (oref obj prototype) value value)
|
||
(setf (alist-get (oref obj command) transient-values nil 'remove) nil)
|
||
(transient-save-values))
|
||
(transient--history-push obj)
|
||
(mapc #'transient-init-value transient--suffixes))
|
||
|
||
;;;; Get
|
||
|
||
(defun transient-args (prefix)
|
||
"Return the value of the transient prefix command PREFIX.
|
||
If the current command was invoked from the transient prefix
|
||
command PREFIX, then return the active infix arguments. If
|
||
the current command was not invoked from PREFIX, then return
|
||
the set, saved or default value for PREFIX."
|
||
(cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix)))
|
||
|
||
(defun transient-suffixes (prefix)
|
||
"Return the suffix objects of the transient prefix command PREFIX."
|
||
(if (eq transient-current-command prefix)
|
||
transient-current-suffixes
|
||
(let ((transient--prefix (transient--init-prefix prefix)))
|
||
(transient--flatten-suffixes
|
||
(transient--init-suffixes prefix)))))
|
||
|
||
(defun transient-get-value ()
|
||
(transient--with-emergency-exit
|
||
(cl-mapcan (lambda (obj)
|
||
(and (or (not (slot-exists-p obj 'unsavable))
|
||
(not (oref obj unsavable)))
|
||
(transient--get-wrapped-value obj)))
|
||
transient-current-suffixes)))
|
||
|
||
(defun transient--get-wrapped-value (obj)
|
||
(and-let* ((value (transient-infix-value obj)))
|
||
(cl-ecase (and (slot-exists-p obj 'multi-value)
|
||
(oref obj multi-value))
|
||
((nil) (list value))
|
||
((t rest) (list value))
|
||
(repeat value))))
|
||
|
||
(cl-defgeneric transient-infix-value (obj)
|
||
"Return the value of the suffix object OBJ.
|
||
|
||
This function is called by `transient-args' (which see), meaning
|
||
this function is how the value of a transient is determined so
|
||
that the invoked suffix command can use it.
|
||
|
||
Currently most values are strings, but that is not set in stone.
|
||
Nil is not a value, it means \"no value\".
|
||
|
||
Usually only infixes have a value, but see the method for
|
||
`transient-suffix'.")
|
||
|
||
(cl-defmethod transient-infix-value ((_ transient-suffix))
|
||
"Return nil, which means \"no value\".
|
||
|
||
Infix arguments contribute the transient's value while suffix
|
||
commands consume it. This function is called for suffixes anyway
|
||
because a command that both contributes to the transient's value
|
||
and also consumes it is not completely unconceivable.
|
||
|
||
If you define such a command, then you must define a derived
|
||
class and implement this function because this default method
|
||
does nothing." nil)
|
||
|
||
(cl-defmethod transient-infix-value ((obj transient-infix))
|
||
"Return the value of OBJ's `value' slot."
|
||
(oref obj value))
|
||
|
||
(cl-defmethod transient-infix-value ((obj transient-option))
|
||
"Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
|
||
(and-let* ((value (oref obj value)))
|
||
(let ((arg (oref obj argument)))
|
||
(cl-ecase (oref obj multi-value)
|
||
((nil) (concat arg value))
|
||
((t rest) (cons arg value))
|
||
(repeat (mapcar (lambda (v) (concat arg v)) value))))))
|
||
|
||
(cl-defmethod transient-infix-value ((_ transient-variable))
|
||
"Return nil, which means \"no value\".
|
||
|
||
Setting the value of a variable is done by, well, setting the
|
||
value of the variable. I.e. this is a side-effect and does not
|
||
contribute to the value of the transient."
|
||
nil)
|
||
|
||
;;;; Utilities
|
||
|
||
(defun transient-arg-value (arg args)
|
||
"Return the value of ARG as it appears in ARGS.
|
||
|
||
For a switch return a boolean. For an option return the value as
|
||
a string, using the empty string for the empty value, or nil if
|
||
the option does not appear in ARGS."
|
||
(if (string-suffix-p "=" arg)
|
||
(save-match-data
|
||
(and-let* ((match (let ((case-fold-search nil)
|
||
(re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
|
||
(substring arg 0 -1))))
|
||
(cl-find-if (lambda (a)
|
||
(and (stringp a)
|
||
(string-match re a)))
|
||
args))))
|
||
(or (match-string 1 match) "")))
|
||
(and (member arg args) t)))
|
||
|
||
;;; History
|
||
|
||
(cl-defgeneric transient--history-key (obj)
|
||
"Return OBJ's history key.
|
||
If the value of the `history-key' slot is non-nil, then return
|
||
that. Otherwise return the value of the `command' slot."
|
||
(or (oref obj history-key)
|
||
(oref obj command)))
|
||
|
||
(cl-defgeneric transient--history-push (obj)
|
||
"Push the current value of OBJ to its entry in `transient-history'."
|
||
(let ((key (transient--history-key obj)))
|
||
(setf (alist-get key transient-history)
|
||
(let ((args (transient-get-value)))
|
||
(cons args (delete args (alist-get key transient-history)))))))
|
||
|
||
(cl-defgeneric transient--history-init (obj)
|
||
"Initialize OBJ's `history' slot.
|
||
This is the transient-wide history; many individual infixes also
|
||
have a history of their own.")
|
||
|
||
(cl-defmethod transient--history-init ((obj transient-prefix))
|
||
"Initialize OBJ's `history' slot from the variable `transient-history'."
|
||
(let ((val (oref obj value)))
|
||
(oset obj history
|
||
(cons val (delete val (alist-get (transient--history-key obj)
|
||
transient-history))))))
|
||
|
||
;;; Draw
|
||
|
||
(defun transient--show-brief ()
|
||
(let ((message-log-max nil))
|
||
(if (and transient-show-popup (<= transient-show-popup 0))
|
||
(message "%s-" (key-description (this-command-keys)))
|
||
(message
|
||
"%s- [%s] %s"
|
||
(key-description (this-command-keys))
|
||
(oref transient--prefix command)
|
||
(mapconcat
|
||
#'identity
|
||
(sort
|
||
(cl-mapcan
|
||
(lambda (suffix)
|
||
(let ((key (kbd (oref suffix key))))
|
||
;; Don't list any common commands.
|
||
(and (not (memq (oref suffix command)
|
||
`(,(lookup-key transient-map key)
|
||
,(lookup-key transient-sticky-map key)
|
||
;; From transient-common-commands:
|
||
transient-set
|
||
transient-save
|
||
transient-history-prev
|
||
transient-history-next
|
||
transient-quit-one
|
||
transient-toggle-common
|
||
transient-set-level)))
|
||
(list (propertize (oref suffix key) 'face 'transient-key)))))
|
||
transient--suffixes)
|
||
#'string<)
|
||
(propertize "|" 'face 'transient-unreachable-key))))))
|
||
|
||
(defun transient--show ()
|
||
(transient--timer-cancel)
|
||
(setq transient--showp t)
|
||
(let ((buf (get-buffer-create transient--buffer-name))
|
||
(focus nil))
|
||
(with-current-buffer buf
|
||
(when transient-enable-popup-navigation
|
||
(setq focus (or (button-get (point) 'command)
|
||
(transient--heading-at-point))))
|
||
(erase-buffer)
|
||
(setq window-size-fixed t)
|
||
(when (bound-and-true-p tab-line-format)
|
||
(setq tab-line-format nil))
|
||
(setq header-line-format nil)
|
||
(setq mode-line-format (if (eq transient-mode-line-format 'line)
|
||
nil
|
||
transient-mode-line-format))
|
||
(setq mode-line-buffer-identification
|
||
(symbol-name (oref transient--prefix command)))
|
||
(if transient-enable-popup-navigation
|
||
(setq-local cursor-in-non-selected-windows 'box)
|
||
(setq cursor-type nil))
|
||
(setq display-line-numbers nil)
|
||
(setq show-trailing-whitespace nil)
|
||
(transient--insert-groups)
|
||
(when (or transient--helpp transient--editp)
|
||
(transient--insert-help))
|
||
(when (and (eq transient-mode-line-format 'line)
|
||
window-system)
|
||
(let ((face
|
||
(if-let ((f (and (transient--semantic-coloring-p)
|
||
(transient--prefix-color transient--prefix))))
|
||
`(,@(and (>= emacs-major-version 27) '(:extend t))
|
||
:background ,(face-foreground f))
|
||
'transient-separator)))
|
||
(insert (propertize "__" 'face face 'display '(space :height (1))))
|
||
(insert (propertize "\n" 'face face 'line-height t))))
|
||
(when transient-force-fixed-pitch
|
||
(transient--force-fixed-pitch)))
|
||
(unless (window-live-p transient--window)
|
||
(setq transient--window
|
||
(display-buffer buf transient-display-buffer-action)))
|
||
(when (window-live-p transient--window)
|
||
(with-selected-window transient--window
|
||
(goto-char (point-min))
|
||
(when transient-enable-popup-navigation
|
||
(transient--goto-button focus))
|
||
(transient--fit-window-to-buffer transient--window)))))
|
||
|
||
(defun transient--fit-window-to-buffer (window)
|
||
(let ((window-resize-pixelwise t)
|
||
(window-size-fixed nil))
|
||
(if (eq (car (window-parameter window 'quit-restore)) 'other)
|
||
;; Grow but never shrink window that previously displayed
|
||
;; another buffer and is going to display that again.
|
||
(fit-window-to-buffer window nil (window-height window))
|
||
(fit-window-to-buffer window nil 1))))
|
||
|
||
(defun transient--insert-groups ()
|
||
(let ((groups (cl-mapcan (lambda (group)
|
||
(let ((hide (oref group hide)))
|
||
(and (not (and (functionp hide)
|
||
(funcall hide)))
|
||
(list group))))
|
||
transient--layout))
|
||
group)
|
||
(while (setq group (pop groups))
|
||
(transient--insert-group group)
|
||
(when groups
|
||
(insert ?\n)))))
|
||
|
||
(defvar transient--max-group-level 1)
|
||
|
||
(cl-defgeneric transient--insert-group (group)
|
||
"Format GROUP and its elements and insert the result.")
|
||
|
||
(cl-defmethod transient--insert-group :around ((group transient-group))
|
||
"Insert GROUP's description, if any."
|
||
(when-let ((desc (transient-format-description group)))
|
||
(insert desc ?\n))
|
||
(let ((transient--max-group-level
|
||
(max (oref group level) transient--max-group-level)))
|
||
(cl-call-next-method group)))
|
||
|
||
(cl-defmethod transient--insert-group ((group transient-row))
|
||
(transient--maybe-pad-keys group)
|
||
(dolist (suffix (oref group suffixes))
|
||
(insert (transient-format suffix))
|
||
(insert " "))
|
||
(insert ?\n))
|
||
|
||
(cl-defmethod transient--insert-group ((group transient-column))
|
||
(transient--maybe-pad-keys group)
|
||
(dolist (suffix (oref group suffixes))
|
||
(let ((str (transient-format suffix)))
|
||
(insert str)
|
||
(unless (string-match-p ".\n\\'" str)
|
||
(insert ?\n)))))
|
||
|
||
(cl-defmethod transient--insert-group ((group transient-columns))
|
||
(let* ((columns
|
||
(mapcar
|
||
(lambda (column)
|
||
(transient--maybe-pad-keys column group)
|
||
(let ((rows (mapcar #'transient-format (oref column suffixes))))
|
||
(when-let ((desc (transient-format-description column)))
|
||
(push desc rows))
|
||
(flatten-tree rows)))
|
||
(oref group suffixes)))
|
||
(vp (or (oref transient--prefix variable-pitch)
|
||
transient-align-variable-pitch))
|
||
(rs (apply #'max (mapcar #'length columns)))
|
||
(cs (length columns))
|
||
(cw (mapcar (lambda (col)
|
||
(apply #'max
|
||
(mapcar (if vp #'transient--pixel-width #'length)
|
||
col)))
|
||
columns))
|
||
(cc (transient--seq-reductions-from
|
||
(apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1)))
|
||
cw 0)))
|
||
(if transient-force-single-column
|
||
(dotimes (c cs)
|
||
(dotimes (r rs)
|
||
(when-let ((cell (nth r (nth c columns))))
|
||
(unless (equal cell "")
|
||
(insert cell ?\n))))
|
||
(unless (= c (1- cs))
|
||
(insert ?\n)))
|
||
(dotimes (r rs)
|
||
(dotimes (c cs)
|
||
(if vp
|
||
(progn
|
||
(when-let ((cell (nth r (nth c columns))))
|
||
(insert cell))
|
||
(if (= c (1- cs))
|
||
(insert ?\n)
|
||
(insert (propertize " " 'display
|
||
`(space :align-to (,(nth (1+ c) cc)))))))
|
||
(insert (make-string (max 1 (- (nth c cc) (current-column))) ?\s))
|
||
(when-let ((cell (nth r (nth c columns))))
|
||
(insert cell))
|
||
(when (= c (1- cs))
|
||
(insert ?\n))))))))
|
||
|
||
(defun transient--pixel-width (string)
|
||
(save-window-excursion
|
||
(with-temp-buffer
|
||
(insert string)
|
||
(set-window-dedicated-p nil nil)
|
||
(set-window-buffer nil (current-buffer))
|
||
(car (window-text-pixel-size
|
||
nil (line-beginning-position) (point))))))
|
||
|
||
(cl-defmethod transient--insert-group ((group transient-subgroups))
|
||
(let* ((subgroups (oref group suffixes))
|
||
(n (length subgroups)))
|
||
(dotimes (s n)
|
||
(let ((subgroup (nth s subgroups)))
|
||
(transient--maybe-pad-keys subgroup group)
|
||
(transient--insert-group subgroup)
|
||
(when (< s (1- n))
|
||
(insert ?\n))))))
|
||
|
||
(cl-defgeneric transient-format (obj)
|
||
"Format and return OBJ for display.
|
||
|
||
When this function is called, then the current buffer is some
|
||
temporary buffer. If you need the buffer from which the prefix
|
||
command was invoked to be current, then do so by temporarily
|
||
making `transient--original-buffer' current.")
|
||
|
||
(cl-defmethod transient-format ((arg string))
|
||
"Return the string ARG after applying the `transient-heading' face."
|
||
(propertize arg 'face 'transient-heading))
|
||
|
||
(cl-defmethod transient-format ((_ null))
|
||
"Return a string containing just the newline character."
|
||
"\n")
|
||
|
||
(cl-defmethod transient-format ((arg integer))
|
||
"Return a string containing just the ARG character."
|
||
(char-to-string arg))
|
||
|
||
(cl-defmethod transient-format :around ((obj transient-infix))
|
||
"When reading user input for this infix, then highlight it."
|
||
(let ((str (cl-call-next-method obj)))
|
||
(when (eq obj transient--active-infix)
|
||
(setq str (concat str "\n"))
|
||
(add-face-text-property
|
||
(if (eq this-command 'transient-set-level) 3 0)
|
||
(length str)
|
||
'transient-active-infix nil str))
|
||
str))
|
||
|
||
(cl-defmethod transient-format :around ((obj transient-suffix))
|
||
"When edit-mode is enabled, then prepend the level information.
|
||
Optional support for popup buttons is also implemented here."
|
||
(let ((str (concat
|
||
(and transient--editp
|
||
(let ((level (oref obj level)))
|
||
(propertize (format " %s " level)
|
||
'face (if (transient--use-level-p level t)
|
||
'transient-enabled-suffix
|
||
'transient-disabled-suffix))))
|
||
(cl-call-next-method obj))))
|
||
(when (oref obj inapt)
|
||
(add-face-text-property 0 (length str) 'transient-inapt-suffix nil str))
|
||
(if transient-enable-popup-navigation
|
||
(make-text-button str nil
|
||
'type 'transient
|
||
'command (transient--suffix-command obj))
|
||
str)))
|
||
|
||
(cl-defmethod transient-format ((obj transient-infix))
|
||
"Return a string generated using OBJ's `format'.
|
||
%k is formatted using `transient-format-key'.
|
||
%d is formatted using `transient-format-description'.
|
||
%v is formatted using `transient-format-value'."
|
||
(format-spec (oref obj format)
|
||
`((?k . ,(transient-format-key obj))
|
||
(?d . ,(transient-format-description obj))
|
||
(?v . ,(transient-format-value obj)))))
|
||
|
||
(cl-defmethod transient-format ((obj transient-suffix))
|
||
"Return a string generated using OBJ's `format'.
|
||
%k is formatted using `transient-format-key'.
|
||
%d is formatted using `transient-format-description'."
|
||
(format-spec (oref obj format)
|
||
`((?k . ,(transient-format-key obj))
|
||
(?d . ,(transient-format-description obj)))))
|
||
|
||
(cl-defgeneric transient-format-key (obj)
|
||
"Format OBJ's `key' for display and return the result.")
|
||
|
||
(cl-defmethod transient-format-key ((obj transient-suffix))
|
||
"Format OBJ's `key' for display and return the result."
|
||
(let ((key (oref obj key))
|
||
(cmd (oref obj command)))
|
||
(if transient--redisplay-key
|
||
(let ((len (length transient--redisplay-key))
|
||
(seq (cl-coerce (edmacro-parse-keys key t) 'list)))
|
||
(cond
|
||
((member (seq-take seq len)
|
||
(list transient--redisplay-key
|
||
(thread-last transient--redisplay-key
|
||
(cl-substitute ?- 'kp-subtract)
|
||
(cl-substitute ?= 'kp-equal)
|
||
(cl-substitute ?+ 'kp-add))))
|
||
(let ((pre (key-description (vconcat (seq-take seq len))))
|
||
(suf (key-description (vconcat (seq-drop seq len)))))
|
||
(setq pre (string-replace "RET" "C-m" pre))
|
||
(setq pre (string-replace "TAB" "C-i" pre))
|
||
(setq suf (string-replace "RET" "C-m" suf))
|
||
(setq suf (string-replace "TAB" "C-i" suf))
|
||
;; We use e.g. "-k" instead of the more correct "- k",
|
||
;; because the former is prettier. If we did that in
|
||
;; the definition, then we want to drop the space that
|
||
;; is reinserted above. False-positives are possible
|
||
;; for silly bindings like "-C-c C-c".
|
||
(unless (string-search " " key)
|
||
(setq pre (string-replace " " "" pre))
|
||
(setq suf (string-replace " " "" suf)))
|
||
(concat (propertize pre 'face 'transient-unreachable-key)
|
||
(and (string-prefix-p (concat pre " ") key) " ")
|
||
(transient--colorize-key suf cmd)
|
||
(save-excursion
|
||
(and (string-match " +\\'" key)
|
||
(propertize (match-string 0 key)
|
||
'face 'fixed-pitch))))))
|
||
((transient--lookup-key transient-sticky-map (kbd key))
|
||
(transient--colorize-key key cmd))
|
||
(t
|
||
(propertize key 'face 'transient-unreachable-key))))
|
||
(transient--colorize-key key cmd))))
|
||
|
||
(defun transient--colorize-key (key command)
|
||
(propertize key 'face
|
||
(or (and (transient--semantic-coloring-p)
|
||
(transient--suffix-color command))
|
||
'transient-key)))
|
||
|
||
(cl-defmethod transient-format-key :around ((obj transient-argument))
|
||
(let ((key (cl-call-next-method obj)))
|
||
(cond ((not transient-highlight-mismatched-keys))
|
||
((not (slot-boundp obj 'shortarg))
|
||
(add-face-text-property
|
||
0 (length key) 'transient-nonstandard-key nil key))
|
||
((not (string-equal key (oref obj shortarg)))
|
||
(add-face-text-property
|
||
0 (length key) 'transient-mismatched-key nil key)))
|
||
key))
|
||
|
||
(cl-defgeneric transient-format-description (obj)
|
||
"Format OBJ's `description' for display and return the result.")
|
||
|
||
(cl-defmethod transient-format-description ((obj transient-child))
|
||
"The `description' slot may be a function, in which case that is
|
||
called inside the correct buffer (see `transient--insert-group')
|
||
and its value is returned to the caller."
|
||
(and-let* ((desc (oref obj description)))
|
||
(if (functionp desc)
|
||
(with-current-buffer transient--original-buffer
|
||
(funcall desc))
|
||
desc)))
|
||
|
||
(cl-defmethod transient-format-description ((obj transient-group))
|
||
"Format the description by calling the next method. If the result
|
||
doesn't use the `face' property at all, then apply the face
|
||
`transient-heading' to the complete string."
|
||
(and-let* ((desc (cl-call-next-method obj)))
|
||
(if (text-property-not-all 0 (length desc) 'face nil desc)
|
||
desc
|
||
(propertize desc 'face 'transient-heading))))
|
||
|
||
(cl-defmethod transient-format-description :around ((obj transient-suffix))
|
||
"Format the description by calling the next method. If the result
|
||
is nil, then use \"(BUG: no description)\" as the description.
|
||
If the OBJ's `key' is currently unreachable, then apply the face
|
||
`transient-unreachable' to the complete string."
|
||
(let ((desc (or (cl-call-next-method obj)
|
||
(and (slot-boundp transient--prefix 'suffix-description)
|
||
(funcall (oref transient--prefix suffix-description)
|
||
obj))
|
||
(propertize "(BUG: no description)" 'face 'error))))
|
||
(cond ((transient--key-unreachable-p obj)
|
||
(propertize desc 'face 'transient-unreachable))
|
||
((and transient-highlight-higher-levels
|
||
(> (max (oref obj level) transient--max-group-level)
|
||
transient--default-prefix-level))
|
||
(add-face-text-property
|
||
0 (length desc) 'transient-higher-level nil desc)
|
||
desc)
|
||
(t
|
||
desc))))
|
||
|
||
(cl-defgeneric transient-format-value (obj)
|
||
"Format OBJ's value for display and return the result.")
|
||
|
||
(cl-defmethod transient-format-value ((obj transient-suffix))
|
||
(propertize (oref obj argument)
|
||
'face (if (oref obj value)
|
||
'transient-argument
|
||
'transient-inactive-argument)))
|
||
|
||
(cl-defmethod transient-format-value ((obj transient-option))
|
||
(let ((argument (oref obj argument)))
|
||
(if-let ((value (oref obj value)))
|
||
(propertize
|
||
(cl-ecase (oref obj multi-value)
|
||
((nil) (concat argument value))
|
||
((t rest) (concat argument
|
||
(and (not (string-suffix-p " " argument)) " ")
|
||
(mapconcat #'prin1-to-string value " ")))
|
||
(repeat (mapconcat (lambda (v) (concat argument v)) value " ")))
|
||
'face 'transient-value)
|
||
(propertize argument 'face 'transient-inactive-value))))
|
||
|
||
(cl-defmethod transient-format-value ((obj transient-switches))
|
||
(with-slots (value argument-format choices) obj
|
||
(format (propertize argument-format
|
||
'face (if value
|
||
'transient-value
|
||
'transient-inactive-value))
|
||
(concat
|
||
(propertize "[" 'face 'transient-inactive-value)
|
||
(mapconcat
|
||
(lambda (choice)
|
||
(propertize choice 'face
|
||
(if (equal (format argument-format choice) value)
|
||
'transient-value
|
||
'transient-inactive-value)))
|
||
choices
|
||
(propertize "|" 'face 'transient-inactive-value))
|
||
(propertize "]" 'face 'transient-inactive-value)))))
|
||
|
||
(defun transient--key-unreachable-p (obj)
|
||
(and transient--redisplay-key
|
||
(let ((key (oref obj key)))
|
||
(not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list)
|
||
(length transient--redisplay-key))
|
||
transient--redisplay-key)
|
||
(transient--lookup-key transient-sticky-map (kbd key)))))))
|
||
|
||
(defun transient--lookup-key (keymap key)
|
||
(let ((val (lookup-key keymap key)))
|
||
(and val (not (integerp val)) val)))
|
||
|
||
(defun transient--maybe-pad-keys (group &optional parent)
|
||
(when-let ((pad (if (slot-boundp group 'pad-keys)
|
||
(oref group pad-keys)
|
||
(and parent
|
||
(slot-boundp parent 'pad-keys)
|
||
(oref parent pad-keys)))))
|
||
(let ((width (apply #'max
|
||
(cons (if (integerp pad) pad 0)
|
||
(mapcar (lambda (suffix)
|
||
(length (oref suffix key)))
|
||
(oref group suffixes))))))
|
||
(dolist (suffix (oref group suffixes))
|
||
(oset suffix key
|
||
(truncate-string-to-width (oref suffix key) width nil ?\s))))))
|
||
|
||
(defun transient-command-summary-or-name (obj)
|
||
"Return the summary or name of the command represented by OBJ.
|
||
|
||
If the command has a doc-string, then return the first line of
|
||
that, else its name.
|
||
|
||
Intended to be temporarily used as the `:suffix-description' of
|
||
a prefix command, while porting a regular keymap to a transient."
|
||
(let ((command (transient--suffix-symbol (oref obj command))))
|
||
(if-let ((doc (documentation command)))
|
||
(propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face)
|
||
(propertize (symbol-name command) 'face 'font-lock-function-name-face))))
|
||
|
||
;;; Help
|
||
|
||
(cl-defgeneric transient-show-help (obj)
|
||
"Show documentation for the command represented by OBJ.")
|
||
|
||
(cl-defmethod transient-show-help ((obj transient-prefix))
|
||
"Call `show-help' if non-nil, else show `info-manual',
|
||
if non-nil, else show the `man-page' if non-nil, else use
|
||
`describe-function'."
|
||
(with-slots (show-help info-manual man-page command) obj
|
||
(cond (show-help (funcall show-help obj))
|
||
(info-manual (transient--show-manual info-manual))
|
||
(man-page (transient--show-manpage man-page))
|
||
(t (transient--describe-function command)))))
|
||
|
||
(cl-defmethod transient-show-help ((obj transient-suffix))
|
||
"Call `show-help' if non-nil, else use `describe-function'.
|
||
Also used to dispatch showing documentation for the current
|
||
prefix. If the suffix is a sub-prefix, then also call the
|
||
prefix method."
|
||
(cond
|
||
((eq this-command 'transient-help)
|
||
(transient-show-help transient--prefix))
|
||
((let ((prefix (get (transient--suffix-command obj)
|
||
'transient--prefix)))
|
||
(and prefix (not (eq (oref transient--prefix command) this-command))
|
||
(prog1 t (transient-show-help prefix)))))
|
||
(t (if-let ((show-help (oref obj show-help)))
|
||
(funcall show-help obj)
|
||
(transient--describe-function this-command)))))
|
||
|
||
(cl-defmethod transient-show-help ((obj transient-infix))
|
||
"Call `show-help' if non-nil, else show the `man-page'
|
||
if non-nil, else use `describe-function'. When showing the
|
||
manpage, then try to jump to the correct location."
|
||
(if-let ((show-help (oref obj show-help)))
|
||
(funcall show-help obj)
|
||
(if-let ((man-page (oref transient--prefix man-page))
|
||
(argument (and (slot-boundp obj 'argument)
|
||
(oref obj argument))))
|
||
(transient--show-manpage man-page argument)
|
||
(transient--describe-function this-command))))
|
||
|
||
;; `cl-generic-generalizers' doesn't support `command' et al.
|
||
(cl-defmethod transient-show-help (cmd)
|
||
"Show the command doc-string."
|
||
(transient--describe-function cmd))
|
||
|
||
(defun transient--describe-function (fn)
|
||
(describe-function (if (symbolp fn) fn 'transient--anonymous-infix-argument))
|
||
(unless (derived-mode-p 'help-mode)
|
||
(when-let* ((buf (get-buffer "*Help*"))
|
||
(win (or (and buf (get-buffer-window buf))
|
||
(cl-find-if (lambda (win)
|
||
(with-current-buffer (window-buffer win)
|
||
(derived-mode-p 'help-mode)))
|
||
(window-list)))))
|
||
(select-window win))))
|
||
|
||
(defun transient--anonymous-infix-argument ()
|
||
"Cannot show any documentation for this anonymous infix command.
|
||
|
||
The infix command in question was defined anonymously, i.e.,
|
||
it was define when the prefix command that it belongs to was
|
||
defined, which means that it gets no docstring and also that
|
||
no symbol is bound to it.
|
||
|
||
When you request help for an infix command, then we usually
|
||
show the respective man-page and jump to the location where
|
||
the respective argument is being described.
|
||
|
||
Because the containing prefix command does not specify any
|
||
man-page, we cannot do that in this case. Sorry about that.")
|
||
|
||
(defun transient--show-manual (manual)
|
||
(info manual))
|
||
|
||
(defun transient--show-manpage (manpage &optional argument)
|
||
(require 'man)
|
||
(let* ((Man-notify-method 'meek)
|
||
(buf (Man-getpage-in-background manpage))
|
||
(proc (get-buffer-process buf)))
|
||
(while (and proc (eq (process-status proc) 'run))
|
||
(accept-process-output proc))
|
||
(switch-to-buffer buf)
|
||
(when argument
|
||
(transient--goto-argument-description argument))))
|
||
|
||
(defun transient--goto-argument-description (arg)
|
||
(goto-char (point-min))
|
||
(let ((case-fold-search nil)
|
||
;; This matches preceding/proceeding options. Options
|
||
;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>"
|
||
;; are matched by this regex without the shy group.
|
||
;; The ". " in the shy group is for options such as
|
||
;; "-m parent-number", and the "-[^[:space:]]+ " is
|
||
;; for options such as "--mainline parent-number"
|
||
(others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
|
||
(when (re-search-forward
|
||
(if (equal arg "--")
|
||
;; Special case.
|
||
"^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)"
|
||
;; Should start with whitespace and may have
|
||
;; any number of options before and/or after.
|
||
(format
|
||
"^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
|
||
others
|
||
;; Options don't necessarily end in an "="
|
||
;; (e.g., "--gpg-sign[=<keyid>]")
|
||
(string-remove-suffix "=" arg)
|
||
;; Simple options don't end in an "=". Splitting this
|
||
;; into 2 cases should make getting false positives
|
||
;; less likely.
|
||
(if (string-suffix-p "=" arg)
|
||
;; "[^[:space:]]*[^.[:space:]]" matches the option
|
||
;; value, which is usually after the option name
|
||
;; and either '=' or '[='. The value can't end in
|
||
;; a period, as that means it's being used at the
|
||
;; end of a sentence. The space is for options
|
||
;; such as '--mainline parent-number'.
|
||
"\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
|
||
;; Either this doesn't match anything (e.g., "-a"),
|
||
;; or the option is followed by a value delimited
|
||
;; by a "[", "<", or ":". A space might appear
|
||
;; before this value, as in "-f <file>". The
|
||
;; space alternative is for options such as
|
||
;; "-m parent-number".
|
||
"\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
|
||
others))
|
||
nil t)
|
||
(goto-char (match-beginning 1)))))
|
||
|
||
(defun transient--insert-help ()
|
||
(unless (looking-back "\n\n" 2)
|
||
(insert "\n"))
|
||
(when transient--helpp
|
||
(insert
|
||
(format (propertize "\
|
||
Type a %s to show help for that suffix command, or %s to show manual.
|
||
Type %s to exit help.\n"
|
||
'face 'transient-heading)
|
||
(propertize "<KEY>" 'face 'transient-key)
|
||
(propertize "?" 'face 'transient-key)
|
||
(propertize "C-g" 'face 'transient-key))))
|
||
(when transient--editp
|
||
(unless transient--helpp
|
||
(insert
|
||
(format (propertize "\
|
||
Type a %s to set level for that suffix command.
|
||
Type %s to set what levels are available for this prefix command.\n"
|
||
'face 'transient-heading)
|
||
(propertize "<KEY>" 'face 'transient-key)
|
||
(propertize "C-x l" 'face 'transient-key))))
|
||
(with-slots (level) transient--prefix
|
||
(insert
|
||
(format (propertize "
|
||
Suffixes on levels %s are available.
|
||
Suffixes on levels %s and %s are unavailable.\n"
|
||
'face 'transient-heading)
|
||
(propertize (format "1-%s" level)
|
||
'face 'transient-enabled-suffix)
|
||
(propertize " 0 "
|
||
'face 'transient-disabled-suffix)
|
||
(propertize (format ">=%s" (1+ level))
|
||
'face 'transient-disabled-suffix))))))
|
||
|
||
(defvar transient-resume-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map [remap Man-quit] #'transient-resume)
|
||
(define-key map [remap Info-exit] #'transient-resume)
|
||
(define-key map [remap quit-window] #'transient-resume)
|
||
map)
|
||
"Keymap for `transient-resume-mode'.
|
||
|
||
This keymap remaps every command that would usually just quit the
|
||
documentation buffer to `transient-resume', which additionally
|
||
resumes the suspended transient.")
|
||
|
||
(define-minor-mode transient-resume-mode
|
||
"Auxiliary minor-mode used to resume a transient after viewing help.")
|
||
|
||
(defun transient-toggle-debug ()
|
||
"Toggle debugging statements for transient commands."
|
||
(interactive)
|
||
(setq transient--debug (not transient--debug))
|
||
(message "Debugging transient %s"
|
||
(if transient--debug "enabled" "disabled")))
|
||
|
||
;;; Popup Navigation
|
||
|
||
(defun transient-popup-navigation-help ()
|
||
"Inform the user how to enable popup navigation commands."
|
||
(interactive)
|
||
(message "This command is only available if `%s' is non-nil"
|
||
'transient-enable-popup-navigation))
|
||
|
||
(define-button-type 'transient
|
||
'face nil
|
||
'keymap transient-button-map)
|
||
|
||
(defun transient-backward-button (n)
|
||
"Move to the previous button in the transient popup buffer.
|
||
See `backward-button' for information about N."
|
||
(interactive "p")
|
||
(with-selected-window transient--window
|
||
(backward-button n t)))
|
||
|
||
(defun transient-forward-button (n)
|
||
"Move to the next button in the transient popup buffer.
|
||
See `forward-button' for information about N."
|
||
(interactive "p")
|
||
(with-selected-window transient--window
|
||
(forward-button n t)))
|
||
|
||
(defun transient--goto-button (command)
|
||
(cond
|
||
((stringp command)
|
||
(when (re-search-forward (concat "^" (regexp-quote command)) nil t)
|
||
(goto-char (match-beginning 0))))
|
||
(command
|
||
(while (and (ignore-errors (forward-button 1))
|
||
(not (eq (button-get (button-at (point)) 'command) command))))
|
||
(unless (eq (button-get (button-at (point)) 'command) command)
|
||
(goto-char (point-min))
|
||
(forward-button 1)))))
|
||
|
||
(defun transient--heading-at-point ()
|
||
(and (eq (get-text-property (point) 'face) 'transient-heading)
|
||
(let ((beg (line-beginning-position)))
|
||
(buffer-substring-no-properties
|
||
beg (next-single-property-change
|
||
beg 'face nil (line-end-position))))))
|
||
|
||
;;; Compatibility
|
||
;;;; Popup Isearch
|
||
|
||
(defvar transient--isearch-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(set-keymap-parent map isearch-mode-map)
|
||
(define-key map [remap isearch-exit] #'transient-isearch-exit)
|
||
(define-key map [remap isearch-cancel] #'transient-isearch-cancel)
|
||
(define-key map [remap isearch-abort] #'transient-isearch-abort)
|
||
map))
|
||
|
||
(defun transient-isearch-backward (&optional regexp-p)
|
||
"Do incremental search backward.
|
||
With a prefix argument, do an incremental regular expression
|
||
search instead."
|
||
(interactive "P")
|
||
(transient--isearch-setup)
|
||
(let ((isearch-mode-map transient--isearch-mode-map))
|
||
(isearch-mode nil regexp-p)))
|
||
|
||
(defun transient-isearch-forward (&optional regexp-p)
|
||
"Do incremental search forward.
|
||
With a prefix argument, do an incremental regular expression
|
||
search instead."
|
||
(interactive "P")
|
||
(transient--isearch-setup)
|
||
(let ((isearch-mode-map transient--isearch-mode-map))
|
||
(isearch-mode t regexp-p)))
|
||
|
||
(defun transient-isearch-exit ()
|
||
"Like `isearch-exit' but adapted for `transient'."
|
||
(interactive)
|
||
(isearch-exit)
|
||
(transient--isearch-exit))
|
||
|
||
(defun transient-isearch-cancel ()
|
||
"Like `isearch-cancel' but adapted for `transient'."
|
||
(interactive)
|
||
(condition-case nil (isearch-cancel) (quit))
|
||
(transient--isearch-exit))
|
||
|
||
(defun transient-isearch-abort ()
|
||
"Like `isearch-abort' but adapted for `transient'."
|
||
(interactive)
|
||
(condition-case nil (isearch-abort) (quit))
|
||
(transient--isearch-exit))
|
||
|
||
(defun transient--isearch-setup ()
|
||
(select-window transient--window)
|
||
(transient--suspend-override t))
|
||
|
||
(defun transient--isearch-exit ()
|
||
(select-window transient--original-window)
|
||
(transient--resume-override))
|
||
|
||
;;;; Hydra Color Emulation
|
||
|
||
(defun transient--semantic-coloring-p ()
|
||
(and transient-semantic-coloring
|
||
(not transient--helpp)
|
||
(not transient--editp)))
|
||
|
||
(defun transient--suffix-color (command)
|
||
(or (get command 'transient-color)
|
||
(get (transient--get-predicate-for command) 'transient-color)))
|
||
|
||
(defun transient--prefix-color (command)
|
||
(let* ((nonsuf (or (oref command transient-non-suffix)
|
||
'transient--do-warn))
|
||
(nonsuf (if (memq nonsuf '(transient--do-noop transient--do-warn))
|
||
'disallow
|
||
(get nonsuf 'transient-color)))
|
||
(suffix (if-let ((pred (oref command transient-suffix)))
|
||
(get pred 'transient-color)
|
||
(if (eq nonsuf 'transient-red)
|
||
'transient-red
|
||
'transient-blue))))
|
||
(pcase (list suffix nonsuf)
|
||
(`(transient-purple ,_) 'transient-purple)
|
||
('(transient-red disallow) 'transient-amaranth)
|
||
('(transient-blue disallow) 'transient-teal)
|
||
('(transient-red transient-red) 'transient-pink)
|
||
('(transient-red transient-blue) 'transient-red)
|
||
('(transient-blue transient-blue) 'transient-blue))))
|
||
|
||
;;;; Edebug
|
||
|
||
(defun transient--edebug--recursive-edit (fn arg-mode)
|
||
(transient--debug 'edebug--recursive-edit)
|
||
(if (not transient--prefix)
|
||
(funcall fn arg-mode)
|
||
(transient--suspend-override t)
|
||
(funcall fn arg-mode)
|
||
(transient--resume-override)))
|
||
|
||
(advice-add 'edebug--recursive-edit :around #'transient--edebug--recursive-edit)
|
||
|
||
(defun transient--abort-edebug ()
|
||
(when (bound-and-true-p edebug-active)
|
||
(transient--emergency-exit)))
|
||
|
||
(advice-add 'abort-recursive-edit :before #'transient--abort-edebug)
|
||
(advice-add 'top-level :before #'transient--abort-edebug)
|
||
|
||
(defun transient--edebug-command-p ()
|
||
(and (bound-and-true-p edebug-active)
|
||
(or (memq this-command '(top-level abort-recursive-edit))
|
||
(string-prefix-p "edebug" (symbol-name this-command)))))
|
||
|
||
;;;; Miscellaneous
|
||
|
||
(cl-pushnew (list nil (concat "^\\s-*("
|
||
(eval-when-compile
|
||
(regexp-opt
|
||
'("transient-define-prefix"
|
||
"transient-define-suffix"
|
||
"transient-define-infix"
|
||
"transient-define-argument")
|
||
t))
|
||
"\\s-+\\(" lisp-mode-symbol-regexp "\\)")
|
||
2)
|
||
lisp-imenu-generic-expression :test #'equal)
|
||
|
||
(declare-function which-key-mode "which-key" (&optional arg))
|
||
|
||
(defun transient--suspend-which-key-mode ()
|
||
(when (bound-and-true-p which-key-mode)
|
||
(which-key-mode -1)
|
||
(add-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
|
||
|
||
(defun transient--resume-which-key-mode ()
|
||
(unless transient--prefix
|
||
(which-key-mode 1)
|
||
(remove-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
|
||
|
||
(defun transient-bind-q-to-quit ()
|
||
"Modify some keymaps to bind \"q\" to the appropriate quit command.
|
||
|
||
\"C-g\" is the default binding for such commands now, but Transient's
|
||
predecessor Magit-Popup used \"q\" instead. If you would like to get
|
||
that binding back, then call this function in your init file like so:
|
||
|
||
(with-eval-after-load \\='transient
|
||
(transient-bind-q-to-quit))
|
||
|
||
Individual transients may already bind \"q\" to something else
|
||
and such a binding would shadow the quit binding. If that is the
|
||
case then \"Q\" is bound to whatever \"q\" would have been bound
|
||
to by setting `transient-substitute-key-function' to a function
|
||
that does that. Of course \"Q\" may already be bound to something
|
||
else, so that function binds \"M-q\" to that command instead.
|
||
Of course \"M-q\" may already be bound to something else, but
|
||
we stop there."
|
||
(define-key transient-base-map "q" #'transient-quit-one)
|
||
(define-key transient-sticky-map "q" #'transient-quit-seq)
|
||
(setq transient-substitute-key-function
|
||
#'transient-rebind-quit-commands))
|
||
|
||
(defun transient-rebind-quit-commands (obj)
|
||
"See `transient-bind-q-to-quit'."
|
||
(let ((key (oref obj key)))
|
||
(cond ((string-equal key "q") "Q")
|
||
((string-equal key "Q") "M-q")
|
||
(t key))))
|
||
|
||
(defun transient--force-fixed-pitch ()
|
||
(require 'face-remap)
|
||
(face-remap-reset-base 'default)
|
||
(face-remap-add-relative 'default 'fixed-pitch))
|
||
|
||
;;;; Missing from Emacs
|
||
|
||
(defun transient--seq-reductions-from (function sequence initial-value)
|
||
(let ((acc (list initial-value)))
|
||
(seq-doseq (elt sequence)
|
||
(push (funcall function (car acc) elt) acc))
|
||
(nreverse acc)))
|
||
|
||
(defun transient-plist-to-alist (plist)
|
||
(let (alist)
|
||
(while plist
|
||
(push (cons (let* ((symbol (pop plist))
|
||
(name (symbol-name symbol)))
|
||
(if (eq (aref name 0) ?:)
|
||
(intern (substring name 1))
|
||
symbol))
|
||
(pop plist))
|
||
alist))
|
||
(nreverse alist)))
|
||
|
||
;;; Font-Lock
|
||
|
||
(defconst transient-font-lock-keywords
|
||
(eval-when-compile
|
||
`((,(concat "("
|
||
(regexp-opt (list "transient-define-prefix"
|
||
"transient-define-infix"
|
||
"transient-define-argument"
|
||
"transient-define-suffix")
|
||
t)
|
||
"\\_>[ \t'(]*"
|
||
"\\(\\(?:\\sw\\|\\s_\\)+\\)?")
|
||
(1 'font-lock-keyword-face)
|
||
(2 'font-lock-function-name-face nil t)))))
|
||
|
||
(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords)
|
||
|
||
;;; Auxiliary Classes
|
||
;;;; `transient-lisp-variable'
|
||
|
||
(defclass transient-lisp-variable (transient-variable)
|
||
((reader :initform #'transient-lisp-variable--reader)
|
||
(always-read :initform t)
|
||
(set-value :initarg :set-value :initform #'set))
|
||
"[Experimental] Class used for Lisp variables.")
|
||
|
||
(cl-defmethod transient-init-value ((obj transient-lisp-variable))
|
||
(oset obj value (symbol-value (oref obj variable))))
|
||
|
||
(cl-defmethod transient-infix-set ((obj transient-lisp-variable) value)
|
||
(funcall (oref obj set-value)
|
||
(oref obj variable)
|
||
(oset obj value value)))
|
||
|
||
(cl-defmethod transient-format-description ((obj transient-lisp-variable))
|
||
(or (cl-call-next-method obj)
|
||
(symbol-name (oref obj variable))))
|
||
|
||
(cl-defmethod transient-format-value ((obj transient-lisp-variable))
|
||
(propertize (prin1-to-string (oref obj value))
|
||
'face 'transient-value))
|
||
|
||
(cl-defmethod transient-prompt ((obj transient-lisp-variable))
|
||
(format "Set %s: " (oref obj variable)))
|
||
|
||
(defun transient-lisp-variable--reader (prompt initial-input _history)
|
||
(read--expression prompt initial-input))
|
||
|
||
;;; _
|
||
(provide 'transient)
|
||
;; Local Variables:
|
||
;; indent-tabs-mode: nil
|
||
;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode")
|
||
;; End:
|
||
;;; transient.el ends here
|