2022-08-25 15:13:38 +00:00
|
|
|
;;; transient.el --- Transient commands -*- lexical-binding:t -*-
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
;; Copyright (C) 2018-2023 Free Software Foundation, Inc.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
|
|
|
|
;; Homepage: https://github.com/magit/transient
|
|
|
|
|
;; Keywords: extensions
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
;; Package-Version: 0.4.1
|
|
|
|
|
;; Package-Requires: ((emacs "25.1") (compat "29.1.4.1"))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
;; 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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(variable-pitch :initarg :variable-pitch :initform nil)
|
|
|
|
|
(unwind-suffix :documentation "Internal use." :initform nil))
|
2022-08-25 15:13:38 +00:00
|
|
|
"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
|
2023-07-27 19:52:58 +00:00
|
|
|
commands or strings. Each subgroup represents a column.
|
|
|
|
|
This class takes care of inserting the subgroups' elements.")
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(transient--expand-define-args args arglist)))
|
2022-08-25 15:13:38 +00:00
|
|
|
`(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
|
2022-11-08 03:31:08 +00:00
|
|
|
(list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
|
|
|
|
|
suffixes))))))
|
|
|
|
|
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(transient--expand-define-args args arglist)))
|
2022-08-25 15:13:38 +00:00
|
|
|
`(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)))))
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defmacro transient-define-infix (name arglist &rest args)
|
2022-08-25 15:13:38 +00:00
|
|
|
"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 ,_)
|
2023-07-27 19:52:58 +00:00
|
|
|
(transient--expand-define-args args arglist)))
|
2022-08-25 15:13:38 +00:00
|
|
|
`(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
|
2023-07-27 19:52:58 +00:00
|
|
|
example, sets a variable, use `transient-define-infix' instead.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient--expand-define-args (args &optional arglist)
|
|
|
|
|
(unless (listp arglist)
|
|
|
|
|
(error "Mandatory ARGLIST is missing"))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)))
|
2022-11-08 03:31:08 +00:00
|
|
|
(or (vectorp arg)
|
|
|
|
|
(and arg (symbolp arg))))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2022-11-08 03:31:08 +00:00
|
|
|
(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))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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)))
|
2022-11-08 03:31:08 +00:00
|
|
|
(cond
|
|
|
|
|
((or (stringp car)
|
2023-07-27 19:52:58 +00:00
|
|
|
(and (eq (car-safe car) 'lambda)
|
|
|
|
|
(not (commandp car))))
|
2022-08-25 15:13:38 +00:00
|
|
|
(setq args (plist-put args :description pop)))
|
2022-11-08 03:31:08 +00:00
|
|
|
((and (symbolp car)
|
2023-07-27 19:52:58 +00:00
|
|
|
(not (keywordp car))
|
2022-11-08 03:31:08 +00:00
|
|
|
(not (commandp car))
|
|
|
|
|
(commandp (cadr spec)))
|
|
|
|
|
(setq args (plist-put args :description (macroexp-quote pop)))))
|
2022-08-25 15:13:38 +00:00
|
|
|
(cond
|
|
|
|
|
((keywordp car)
|
2023-07-27 19:52:58 +00:00
|
|
|
(error "Need command, got `%s'" car))
|
2022-08-25 15:13:38 +00:00
|
|
|
((symbolp car)
|
2022-11-08 03:31:08 +00:00
|
|
|
(setq args (plist-put args :command (macroexp-quote pop))))
|
2022-08-25 15:13:38 +00:00
|
|
|
((and (commandp car)
|
|
|
|
|
(not (stringp car)))
|
|
|
|
|
(let ((cmd pop)
|
2023-07-27 19:52:58 +00:00
|
|
|
(sym (intern
|
|
|
|
|
(format "transient:%s:%s"
|
|
|
|
|
prefix
|
|
|
|
|
(let ((desc (plist-get args :description)))
|
|
|
|
|
(if (and desc (or (stringp desc) (symbolp desc)))
|
|
|
|
|
desc
|
|
|
|
|
(plist-get args :key)))))))
|
|
|
|
|
(setq args (plist-put args :command
|
|
|
|
|
`(defalias ',sym ,(macroexp-quote cmd))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
((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
|
2022-11-08 03:31:08 +00:00
|
|
|
(list 'quote (intern (format "transient:%s:%s"
|
|
|
|
|
prefix arg)))))
|
2022-08-25 15:13:38 +00:00
|
|
|
(cond ((and car (not (keywordp car)))
|
|
|
|
|
(setq class 'transient-option)
|
2022-11-08 03:31:08 +00:00
|
|
|
(setq args (plist-put args :reader (macroexp-quote pop))))
|
2022-08-25 15:13:38 +00:00
|
|
|
((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)
|
2022-11-08 03:31:08 +00:00
|
|
|
(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)))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
(unless (plist-get args :key)
|
|
|
|
|
(when-let ((shortarg (plist-get args :shortarg)))
|
|
|
|
|
(setq args (plist-put args :key shortarg))))
|
2022-11-08 03:31:08 +00:00
|
|
|
(list 'list
|
|
|
|
|
(or level transient--default-child-level)
|
|
|
|
|
(macroexp-quote (or class 'transient-suffix))
|
|
|
|
|
(cons 'list args))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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))))
|
|
|
|
|
|
2022-11-08 03:31:08 +00:00
|
|
|
(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').
|
2023-07-27 19:52:58 +00:00
|
|
|
Intended for use in a group's `:setup-children' function."
|
2022-11-08 03:31:08 +00:00
|
|
|
(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').
|
2023-07-27 19:52:58 +00:00
|
|
|
Intended for use in a group's `:setup-children' function."
|
2022-11-08 03:31:08 +00:00
|
|
|
(mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
|
|
|
|
|
|
2022-08-25 15:13:38 +00:00
|
|
|
;;; 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)))
|
2022-11-08 03:31:08 +00:00
|
|
|
(setq suf (eval suf))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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--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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(let ((suffixes
|
|
|
|
|
(cl-remove-if-not
|
|
|
|
|
(lambda (obj)
|
|
|
|
|
(eq (transient--suffix-command obj)
|
|
|
|
|
(or command
|
|
|
|
|
(if (eq this-command 'transient-set-level)
|
|
|
|
|
;; This is how it can look up for which
|
|
|
|
|
;; command it is setting the level.
|
|
|
|
|
this-original-command
|
|
|
|
|
this-command))))
|
|
|
|
|
(or transient--suffixes
|
|
|
|
|
transient-current-suffixes))))
|
|
|
|
|
(or (and (cdr suffixes)
|
|
|
|
|
(cl-find-if
|
|
|
|
|
(lambda (obj)
|
|
|
|
|
(equal (listify-key-sequence (transient--kbd (oref obj key)))
|
|
|
|
|
(listify-key-sequence (this-command-keys))))
|
|
|
|
|
suffixes))
|
|
|
|
|
(car suffixes)))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defvar-keymap transient-base-map
|
|
|
|
|
:doc "Parent of other keymaps used by Transient.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
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
|
2023-07-27 19:52:58 +00:00
|
|
|
to `transient-predicate-map'."
|
|
|
|
|
"ESC ESC ESC" #'transient-quit-all
|
|
|
|
|
"C-g" #'transient-quit-one
|
|
|
|
|
"C-q" #'transient-quit-all
|
|
|
|
|
"C-z" #'transient-suspend
|
|
|
|
|
"C-v" #'transient-scroll-up
|
|
|
|
|
"C-M-v" #'transient-scroll-down
|
|
|
|
|
"<next>" #'transient-scroll-up
|
|
|
|
|
"<prior>" #'transient-scroll-down)
|
|
|
|
|
|
|
|
|
|
(defvar-keymap transient-map
|
|
|
|
|
:doc "Top-level keymap used by all transients.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
If you add a new command here, then you must also add a binding
|
2023-07-27 19:52:58 +00:00
|
|
|
to `transient-predicate-map'. Also see `transient-base-map'."
|
|
|
|
|
:parent transient-base-map
|
|
|
|
|
"C-u" #'universal-argument
|
|
|
|
|
"C--" #'negative-argument
|
|
|
|
|
"C-t" #'transient-show
|
|
|
|
|
"?" #'transient-help
|
|
|
|
|
"C-h" #'transient-help
|
|
|
|
|
;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
|
|
|
|
|
"C-M-p" #'transient-history-prev
|
|
|
|
|
"C-M-n" #'transient-history-next)
|
|
|
|
|
|
|
|
|
|
(defvar-keymap transient-edit-map
|
|
|
|
|
:doc "Keymap that is active while a transient in is in \"edit mode\"."
|
|
|
|
|
:parent transient-base-map
|
|
|
|
|
"?" #'transient-help
|
|
|
|
|
"C-h" #'transient-help
|
|
|
|
|
"C-x l" #'transient-set-level)
|
|
|
|
|
|
|
|
|
|
(defvar-keymap transient-sticky-map
|
|
|
|
|
:doc "Keymap that is active while an incomplete key sequence is active."
|
|
|
|
|
:parent transient-base-map
|
|
|
|
|
"C-g" #'transient-quit-seq)
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(defvar transient--common-command-prefixes '(?\C-x))
|
|
|
|
|
|
|
|
|
|
(put 'transient-common-commands
|
|
|
|
|
'transient--layout
|
2022-11-08 03:31:08 +00:00
|
|
|
(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))))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defvar-keymap transient-popup-navigation-map
|
|
|
|
|
:doc "One of the keymaps used when popup navigation is enabled.
|
|
|
|
|
See `transient-enable-popup-navigation'."
|
|
|
|
|
"<down-mouse-1>" #'transient-noop
|
|
|
|
|
"<up>" #'transient-backward-button
|
|
|
|
|
"<down>" #'transient-forward-button
|
|
|
|
|
"C-r" #'transient-isearch-backward
|
|
|
|
|
"C-s" #'transient-isearch-forward
|
|
|
|
|
"M-RET" #'transient-push-button)
|
|
|
|
|
|
|
|
|
|
(defvar-keymap transient-button-map
|
|
|
|
|
:doc "One of the keymaps used when popup navigation is enabled.
|
|
|
|
|
See `transient-enable-popup-navigation'."
|
|
|
|
|
"<mouse-1>" #'transient-push-button
|
|
|
|
|
"<mouse-2>" #'transient-push-button)
|
|
|
|
|
|
|
|
|
|
(defvar-keymap transient-predicate-map
|
|
|
|
|
:doc "Base keymap used to map common commands to their transient behavior.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
The \"transient behavior\" of a command controls, among other
|
|
|
|
|
things, whether invoking the command causes the transient to be
|
2023-07-27 19:52:58 +00:00
|
|
|
exited or not, and whether infix arguments are exported before
|
2022-08-25 15:13:38 +00:00
|
|
|
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
|
2023-07-27 19:52:58 +00:00
|
|
|
of the corresponding object."
|
|
|
|
|
"<transient-suspend>" #'transient--do-suspend
|
|
|
|
|
"<transient-help>" #'transient--do-stay
|
|
|
|
|
"<transient-set-level>" #'transient--do-stay
|
|
|
|
|
"<transient-history-prev>" #'transient--do-stay
|
|
|
|
|
"<transient-history-next>" #'transient--do-stay
|
|
|
|
|
"<universal-argument>" #'transient--do-stay
|
|
|
|
|
"<universal-argument-more>" #'transient--do-stay
|
|
|
|
|
"<negative-argument>" #'transient--do-minus
|
|
|
|
|
"<digit-argument>" #'transient--do-stay
|
|
|
|
|
"<top-level>" #'transient--do-quit-all
|
|
|
|
|
"<transient-quit-all>" #'transient--do-quit-all
|
|
|
|
|
"<transient-quit-one>" #'transient--do-quit-one
|
|
|
|
|
"<transient-quit-seq>" #'transient--do-stay
|
|
|
|
|
"<transient-show>" #'transient--do-stay
|
|
|
|
|
"<transient-update>" #'transient--do-stay
|
|
|
|
|
"<transient-toggle-common>" #'transient--do-stay
|
|
|
|
|
"<transient-set>" #'transient--do-call
|
|
|
|
|
"<transient-save>" #'transient--do-call
|
|
|
|
|
"<transient-reset>" #'transient--do-call
|
|
|
|
|
"<describe-key-briefly>" #'transient--do-stay
|
|
|
|
|
"<describe-key>" #'transient--do-stay
|
|
|
|
|
"<transient-scroll-up>" #'transient--do-stay
|
|
|
|
|
"<transient-scroll-down>" #'transient--do-stay
|
|
|
|
|
"<mwheel-scroll>" #'transient--do-stay
|
|
|
|
|
"<scroll-bar-toolkit-scroll>" #'transient--do-stay
|
|
|
|
|
"<transient-noop>" #'transient--do-noop
|
|
|
|
|
"<transient-mouse-push-button>" #'transient--do-move
|
|
|
|
|
"<transient-push-button>" #'transient--do-push-button
|
|
|
|
|
"<transient-backward-button>" #'transient--do-move
|
|
|
|
|
"<transient-forward-button>" #'transient--do-move
|
|
|
|
|
"<transient-isearch-backward>" #'transient--do-move
|
|
|
|
|
"<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.
|
|
|
|
|
"<nil>" #'transient--do-warn)
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
(when map
|
2023-07-27 19:52:58 +00:00
|
|
|
(transient--debug " pop %s" var)
|
2022-08-25 15:13:38 +00:00
|
|
|
(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))))
|
2023-07-27 19:52:58 +00:00
|
|
|
(when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b))
|
|
|
|
|
(when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b))
|
|
|
|
|
(when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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))
|
2023-07-27 19:52:58 +00:00
|
|
|
(keymap-set map "<handle-switch-frame>" #'transient--do-suspend))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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
|
2023-07-27 19:52:58 +00:00
|
|
|
be nil and PARAMS may be (but usually is not) used to set, e.g.,
|
|
|
|
|
the \"scope\" of the transient (see `transient-define-prefix').
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(advice-add 'recursive-edit :around #'transient--recursive-edit)
|
2022-08-25 15:13:38 +00:00
|
|
|
(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))))
|
2023-07-27 19:52:58 +00:00
|
|
|
(setq this-command 'transient-set-level)
|
|
|
|
|
(transient--wrap-command))
|
2022-08-25 15:13:38 +00:00
|
|
|
(t
|
|
|
|
|
(setq transient--exitp nil)
|
2023-07-27 19:52:58 +00:00
|
|
|
(let ((exitp (eq (transient--do-pre-command) transient--exit)))
|
|
|
|
|
(transient--wrap-command)
|
|
|
|
|
(when exitp
|
|
|
|
|
(transient--pre-exit)))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient--resume-override (&optional _ignore)
|
2022-08-25 15:13:38 +00:00
|
|
|
(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))
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient--recursive-edit (fn)
|
|
|
|
|
(transient--debug 'recursive-edit)
|
|
|
|
|
(if (not transient--prefix)
|
|
|
|
|
(funcall fn)
|
|
|
|
|
(transient--suspend-override (bound-and-true-p edebug-active))
|
|
|
|
|
(funcall fn) ; Already unwind protected.
|
|
|
|
|
(cond ((memq this-command '(top-level abort-recursive-edit))
|
|
|
|
|
(setq transient--exitp t)
|
|
|
|
|
(transient--post-exit)
|
|
|
|
|
(transient--delete-window))
|
|
|
|
|
(transient--prefix
|
|
|
|
|
(transient--resume-override)))))
|
|
|
|
|
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)))
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient--wrap-command ()
|
|
|
|
|
(let* ((prefix transient--prefix)
|
|
|
|
|
(suffix this-command)
|
|
|
|
|
(advice nil)
|
|
|
|
|
(advice-interactive
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(let ((abort t))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(prog1 (advice-eval-interactive-spec spec)
|
|
|
|
|
(setq abort nil))
|
|
|
|
|
(when abort
|
|
|
|
|
(when-let ((unwind (oref prefix unwind-suffix)))
|
|
|
|
|
(transient--debug 'unwind-interactive)
|
|
|
|
|
(funcall unwind suffix))
|
|
|
|
|
(if (symbolp suffix)
|
|
|
|
|
(advice-remove suffix advice)
|
|
|
|
|
(remove-function suffix advice))
|
|
|
|
|
(oset prefix unwind-suffix nil))))))
|
|
|
|
|
(advice-body
|
|
|
|
|
(lambda (fn &rest args)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(apply fn args)
|
|
|
|
|
(when-let ((unwind (oref prefix unwind-suffix)))
|
|
|
|
|
(transient--debug 'unwind-command)
|
|
|
|
|
(funcall unwind suffix))
|
|
|
|
|
(if (symbolp suffix)
|
|
|
|
|
(advice-remove suffix advice)
|
|
|
|
|
(remove-function suffix advice))
|
|
|
|
|
(oset prefix unwind-suffix nil)))))
|
|
|
|
|
(setq advice `(lambda (fn &rest args)
|
|
|
|
|
(interactive ,advice-interactive)
|
|
|
|
|
(apply ',advice-body fn args)))
|
|
|
|
|
(if (symbolp suffix)
|
|
|
|
|
(advice-add suffix :around advice '((depth . -99)))
|
|
|
|
|
(add-function :around (var suffix) advice '((depth . -99))))))
|
|
|
|
|
|
|
|
|
|
(defun transient--premature-post-command ()
|
|
|
|
|
(and (equal (this-command-keys-vector) [])
|
|
|
|
|
(= (minibuffer-depth)
|
|
|
|
|
(1+ transient--minibuffer-depth))
|
|
|
|
|
(progn
|
|
|
|
|
(transient--debug 'premature-post-command)
|
|
|
|
|
(transient--suspend-override)
|
|
|
|
|
(oset (or transient--prefix transient-current-prefix)
|
|
|
|
|
unwind-suffix
|
|
|
|
|
(if transient--exitp
|
|
|
|
|
#'transient--post-exit
|
|
|
|
|
#'transient--resume-override))
|
|
|
|
|
t)))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(defun transient--post-command ()
|
2023-07-27 19:52:58 +00:00
|
|
|
(unless (transient--premature-post-command)
|
|
|
|
|
(transient--debug 'post-command)
|
|
|
|
|
(transient--with-emergency-exit
|
|
|
|
|
(cond (transient--exitp (transient--post-exit))
|
|
|
|
|
((eq this-command (oref transient--prefix command)))
|
|
|
|
|
((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)))))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(remove-hook 'post-command-hook #'transient--post-command)
|
|
|
|
|
(advice-remove 'recursive-edit #'transient--recursive-edit))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
|
2022-08-25 15:13:38 +00:00
|
|
|
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)
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient--do-leave ()
|
|
|
|
|
"Call the command without exporting variables and exit the transient."
|
|
|
|
|
transient--stay)
|
|
|
|
|
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(message "%s: `%s' (Use `%s' to abort, `%s' for help)%s"
|
2022-08-25 15:13:38 +00:00
|
|
|
msg
|
|
|
|
|
(propertize (key-description (this-single-command-keys))
|
|
|
|
|
'face 'font-lock-warning-face)
|
|
|
|
|
(propertize "C-g" 'face 'transient-key)
|
|
|
|
|
(propertize "?" 'face 'transient-key)
|
2023-07-27 19:52:58 +00:00
|
|
|
;; `this-command' is `transient-undefined' or `transient-inapt'.
|
|
|
|
|
;; Show the command (`this-original-command') the user actually
|
|
|
|
|
;; tried to invoke. For an anonymous inapt command that is a
|
|
|
|
|
;; lambda expression, which cannot be mapped to a symbol, so
|
|
|
|
|
;; forgo displaying the command.
|
|
|
|
|
(if-let ((cmd (ignore-errors
|
|
|
|
|
(symbol-name (transient--suffix-symbol
|
|
|
|
|
this-original-command)))))
|
|
|
|
|
(format " [%s]" (propertize cmd 'face 'font-lock-warning-face))
|
|
|
|
|
""))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defun transient-help (&optional interactive)
|
|
|
|
|
"Show help for the active transient or one of its suffixes.\n\n(fn)"
|
|
|
|
|
(interactive (list t))
|
|
|
|
|
(if interactive
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(when-let ((obj (cl-find-if
|
|
|
|
|
(lambda (obj)
|
|
|
|
|
(and (slot-exists-p obj 'argument)
|
|
|
|
|
(slot-boundp obj 'argument)
|
|
|
|
|
(equal (oref obj argument) arg)))
|
|
|
|
|
transient--suffixes)))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(and (not (bobp))
|
|
|
|
|
(button-get (1- (point)) 'command))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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)))))))
|
2023-07-27 19:52:58 +00:00
|
|
|
(when (> c 0)
|
|
|
|
|
(insert (make-string (max 1 (- (nth c cc) (current-column)))
|
|
|
|
|
?\s)))
|
2022-08-25 15:13:38 +00:00
|
|
|
(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
|
2022-11-08 03:31:08 +00:00
|
|
|
called inside the correct buffer (see `transient--insert-group')
|
2022-08-25 15:13:38 +00:00
|
|
|
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))
|
2022-11-08 03:31:08 +00:00
|
|
|
(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))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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))))))
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defvar-keymap transient-resume-mode-map
|
|
|
|
|
:doc "Keymap for `transient-resume-mode'.
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
This keymap remaps every command that would usually just quit the
|
|
|
|
|
documentation buffer to `transient-resume', which additionally
|
2023-07-27 19:52:58 +00:00
|
|
|
resumes the suspended transient."
|
|
|
|
|
"<remap> <Man-quit>" #'transient-resume
|
|
|
|
|
"<remap> <Info-exit>" #'transient-resume
|
|
|
|
|
"<remap> <quit-window>" #'transient-resume)
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
|
2023-07-27 19:52:58 +00:00
|
|
|
(defvar-keymap transient--isearch-mode-map
|
|
|
|
|
:parent isearch-mode-map
|
|
|
|
|
"<remap> <isearch-exit>" #'transient-isearch-exit
|
|
|
|
|
"<remap> <isearch-cancel>" #'transient-isearch-cancel
|
|
|
|
|
"<remap> <isearch-abort>" #'transient-isearch-abort)
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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)
|
2023-07-27 19:52:58 +00:00
|
|
|
(let ((around (lambda (fn)
|
|
|
|
|
(condition-case nil (funcall fn) (quit))
|
|
|
|
|
(transient--isearch-exit))))
|
|
|
|
|
(advice-add 'isearch-cancel :around around)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(isearch-abort)
|
|
|
|
|
(advice-remove 'isearch-cancel around))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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-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."
|
2023-07-27 19:52:58 +00:00
|
|
|
(keymap-set transient-base-map "q" #'transient-quit-one)
|
|
|
|
|
(keymap-set transient-sticky-map "q" #'transient-quit-seq)
|
2022-08-25 15:13:38 +00:00
|
|
|
(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"
|
2023-07-27 19:52:58 +00:00
|
|
|
"transient-define-suffix"
|
|
|
|
|
"transient-define-groups")
|
2022-08-25 15:13:38 +00:00
|
|
|
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))
|
2023-07-27 19:52:58 +00:00
|
|
|
(if (and (slot-boundp obj 'prompt)
|
|
|
|
|
(oref obj prompt))
|
|
|
|
|
(cl-call-next-method obj)
|
|
|
|
|
(format "Set %s: " (oref obj variable))))
|
2022-08-25 15:13:38 +00:00
|
|
|
|
|
|
|
|
(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
|
