3453 lines
131 KiB
EmacsLisp
3453 lines
131 KiB
EmacsLisp
|
;;; transient.el --- Transient commands -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
|
||
|
|
|
||
|
|
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||
|
|
;; Homepage: https://github.com/magit/transient
|
||
|
|
;; Package-Requires: ((emacs "25.1"))
|
||
|
|
;; Keywords: bindings
|
||
|
|
|
||
|
|
;; 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 'eieio)
|
||
|
|
(require 'format-spec)
|
||
|
|
(require 'seq)
|
||
|
|
|
||
|
|
(eval-when-compile
|
||
|
|
(require 'subr-x))
|
||
|
|
|
||
|
|
(and (require 'async-bytecomp nil t)
|
||
|
|
(let ((pkgs (bound-and-true-p async-bytecomp-allowed-packages)))
|
||
|
|
(if (consp pkgs)
|
||
|
|
(cl-intersection '(all magit transient) pkgs)
|
||
|
|
(memq pkgs '(all t))))
|
||
|
|
(fboundp 'async-bytecomp-package-mode)
|
||
|
|
(async-bytecomp-package-mode 1))
|
||
|
|
|
||
|
|
(declare-function info 'info)
|
||
|
|
(declare-function Man-find-section 'man)
|
||
|
|
(declare-function Man-next-section 'man)
|
||
|
|
(declare-function Man-getpage-in-background 'man)
|
||
|
|
|
||
|
|
(defvar Man-notify-method)
|
||
|
|
|
||
|
|
(define-obsolete-function-alias 'define-transient-command
|
||
|
|
'transient-define-prefix "Transient 0.3.0")
|
||
|
|
(define-obsolete-function-alias 'define-suffix-command
|
||
|
|
'transient-define-suffix "Transient 0.3.0")
|
||
|
|
(define-obsolete-function-alias 'define-infix-command
|
||
|
|
'transient-define-infix "Transient 0.3.0")
|
||
|
|
(define-obsolete-function-alias 'define-infix-argument
|
||
|
|
'transient-define-argument "Transient 0.3.0")
|
||
|
|
|
||
|
|
(define-obsolete-variable-alias 'current-transient-prefix
|
||
|
|
'transient-current-prefix "Transient 0.3.0")
|
||
|
|
(define-obsolete-variable-alias 'current-transient-command
|
||
|
|
'transient-current-command "Transient 0.3.0")
|
||
|
|
(define-obsolete-variable-alias 'current-transient-suffixes
|
||
|
|
'transient-current-suffixes "Transient 0.3.0")
|
||
|
|
(define-obsolete-variable-alias 'post-transient-hook
|
||
|
|
'transient-exit-hook "Transient 0.3.0")
|
||
|
|
|
||
|
|
(defmacro transient--with-emergency-exit (&rest body)
|
||
|
|
(declare (indent defun))
|
||
|
|
`(condition-case err
|
||
|
|
,(macroexp-progn body)
|
||
|
|
(error (transient--emergency-exit err))))
|
||
|
|
|
||
|
|
;;; Options
|
||
|
|
|
||
|
|
(defgroup transient nil
|
||
|
|
"Transient commands."
|
||
|
|
:group 'extensions)
|
||
|
|
|
||
|
|
(defcustom transient-show-popup t
|
||
|
|
"Whether to show the current transient in a popup buffer.
|
||
|
|
|
||
|
|
- 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 an incomplete prefix key sequence.
|
||
|
|
|
||
|
|
- 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
|
||
|
|
an incomplete prefix key sequence. 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 nil
|
||
|
|
"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 non-nil, then the following
|
||
|
|
features are available:
|
||
|
|
|
||
|
|
- \"<up>\" moves the cursor to the previous suffix.
|
||
|
|
\"<down>\" moves the cursor to the next suffix.
|
||
|
|
\"RET\" invokes the suffix the cursor is on.
|
||
|
|
- \"<mouse-1>\" invokes the clicked on suffix.
|
||
|
|
- \"C-s\" and \"C-r\" start isearch in the popup buffer."
|
||
|
|
:package-version '(transient . "0.2.0")
|
||
|
|
:group 'transient
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defcustom transient-display-buffer-action
|
||
|
|
'(display-buffer-in-side-window
|
||
|
|
(side . bottom)
|
||
|
|
(inhibit-same-window . t))
|
||
|
|
"The action used to display the transient popup buffer.
|
||
|
|
|
||
|
|
The transient popup buffer is displayed in a window using
|
||
|
|
|
||
|
|
\(display-buffer buf 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 `display-buffer' for
|
||
|
|
details.
|
||
|
|
|
||
|
|
The default is (display-buffer-in-side-window (side . bottom)).
|
||
|
|
This displays the window at the bottom of the selected frame.
|
||
|
|
Another useful value is (display-buffer-below-selected). This
|
||
|
|
is what `magit-popup' used by default. For more alternatives
|
||
|
|
see info node `(elisp)Display Action Functions'.
|
||
|
|
|
||
|
|
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 it doesn't work.
|
||
|
|
|
||
|
|
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 highlighed differently.
|
||
|
|
|
||
|
|
The highlighting is done using using `transient-mismatched-key'
|
||
|
|
and `transient-nonstandard-key'."
|
||
|
|
:package-version '(transient . "0.1.0")
|
||
|
|
: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-force-fixed-pitch nil
|
||
|
|
"Whether to force used of monospaced font in 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."
|
||
|
|
:package-version '(transient . "0.2.0")
|
||
|
|
:group 'transient
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defcustom transient-default-level 4
|
||
|
|
"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 (convert-standard-filename "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 (convert-standard-filename "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 (convert-standard-filename "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 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-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)
|
||
|
|
|
||
|
|
;;; 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 (object file)
|
||
|
|
(make-directory (file-name-directory file) t)
|
||
|
|
(setq object (cl-sort object #'string< :key #'car))
|
||
|
|
(with-temp-file file
|
||
|
|
(let ((print-level nil)
|
||
|
|
(print-length nil))
|
||
|
|
(pp object (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)
|
||
|
|
(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)
|
||
|
|
(man-page :initarg :man-page :initform nil)
|
||
|
|
(info-manual :initarg :info-manual :initform nil)
|
||
|
|
(transient-suffix :initarg :transient-suffix :initform nil)
|
||
|
|
(transient-non-suffix :initarg :transient-non-suffix :initform nil)
|
||
|
|
(incompatible :initarg :incompatible :initform nil))
|
||
|
|
"Transient prefix command.
|
||
|
|
|
||
|
|
Each transient prefix command consists of a command, which is
|
||
|
|
stored in a symbol's function slot and an object, which is
|
||
|
|
stored in the `transient--prefix' property of the same symbol.
|
||
|
|
|
||
|
|
When a transient prefix command is invoked, then a clone of that
|
||
|
|
object is stored in the global variable `transient--prefix' and
|
||
|
|
the prototype is stored in the clone's `prototype' slot.")
|
||
|
|
|
||
|
|
;;;; Suffix
|
||
|
|
|
||
|
|
(defclass transient-child ()
|
||
|
|
((level
|
||
|
|
:initarg :level
|
||
|
|
:initform 1
|
||
|
|
: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 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)
|
||
|
|
(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)
|
||
|
|
(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-infix) ()
|
||
|
|
"Class used for the \"--\" argument.
|
||
|
|
All remaining arguments are treated as files.
|
||
|
|
They become the value of this this argument.")
|
||
|
|
|
||
|
|
;;;; Group
|
||
|
|
|
||
|
|
(defclass transient-group (transient-child)
|
||
|
|
((suffixes :initarg :suffixes :initform nil)
|
||
|
|
(hide :initarg :hide :initform nil)
|
||
|
|
(description :initarg :description :initform nil))
|
||
|
|
"Abstract superclass of all group classes."
|
||
|
|
:abstract t)
|
||
|
|
|
||
|
|
(defclass transient-column (transient-group) ()
|
||
|
|
"Group class that displays each element on a separate line.")
|
||
|
|
|
||
|
|
(defclass transient-row (transient-group) ()
|
||
|
|
"Group class that displays all elements on a single line.")
|
||
|
|
|
||
|
|
(defclass transient-columns (transient-group) ()
|
||
|
|
"Group class that displays elements organized in columns.
|
||
|
|
Direct elements have to be groups whose elements have to be
|
||
|
|
commands or string. Each subgroup represents a column. This
|
||
|
|
class takes care of inserting the subgroups' elements.")
|
||
|
|
|
||
|
|
(defclass transient-subgroups (transient-group) ()
|
||
|
|
"Group class that wraps other groups.
|
||
|
|
|
||
|
|
Direct elements have to be groups whose elements have to be
|
||
|
|
commands or strings. This group inserts an empty line between
|
||
|
|
subgroups. The subgroups are responsible for displaying their
|
||
|
|
elements themselves.")
|
||
|
|
|
||
|
|
;;; Define
|
||
|
|
|
||
|
|
(defmacro transient-define-prefix (name arglist &rest args)
|
||
|
|
"Define NAME as a transient prefix command.
|
||
|
|
|
||
|
|
ARGLIST are the arguments that command takes.
|
||
|
|
DOCSTRING is the documentation string and is optional.
|
||
|
|
|
||
|
|
These arguments can optionally be followed by key-value pairs.
|
||
|
|
Each key has to be a keyword symbol, either `:class' or a keyword
|
||
|
|
argument supported by the constructor of that class. The
|
||
|
|
`transient-prefix' class is used if the class is not specified
|
||
|
|
explicitly.
|
||
|
|
|
||
|
|
GROUPs add key bindings for infix and suffix commands and specify
|
||
|
|
how these bindings are presented in the popup buffer. At least
|
||
|
|
one GROUP has to be specified. See info node `(transient)Binding
|
||
|
|
Suffix and Infix Commands'.
|
||
|
|
|
||
|
|
The BODY is optional. If it is omitted, then ARGLIST is also
|
||
|
|
ignored and the function definition becomes:
|
||
|
|
|
||
|
|
(lambda ()
|
||
|
|
(interactive)
|
||
|
|
(transient-setup \\='NAME))
|
||
|
|
|
||
|
|
If BODY is specified, then it must begin with an `interactive'
|
||
|
|
form that matches ARGLIST, and it must call `transient-setup'.
|
||
|
|
It may however call that function only when some condition is
|
||
|
|
satisfied; that is one of the reason why you might want to use
|
||
|
|
an explicit BODY.
|
||
|
|
|
||
|
|
All transients have a (possibly nil) value, which is exported
|
||
|
|
when suffix commands are called, so that they can consume that
|
||
|
|
value. For some transients it might be necessary to have a sort
|
||
|
|
of secondary value, called a scope. Such a scope would usually
|
||
|
|
be set in the commands `interactive' form and has to be passed
|
||
|
|
to the setup function:
|
||
|
|
|
||
|
|
(transient-setup \\='NAME nil nil :scope SCOPE)
|
||
|
|
|
||
|
|
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
|
||
|
|
(declare (debug (&define name lambda-list
|
||
|
|
[&optional lambda-doc]
|
||
|
|
[&rest keywordp sexp]
|
||
|
|
[&rest vectorp]
|
||
|
|
[&optional ("interactive" interactive) def-body]))
|
||
|
|
(indent defun)
|
||
|
|
(doc-string 3))
|
||
|
|
(pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
|
||
|
|
(transient--expand-define-args args)))
|
||
|
|
`(progn
|
||
|
|
(defalias ',name
|
||
|
|
,(if body
|
||
|
|
`(lambda ,arglist ,@body)
|
||
|
|
`(lambda ()
|
||
|
|
(interactive)
|
||
|
|
(transient-setup ',name))))
|
||
|
|
(put ',name 'interactive-only t)
|
||
|
|
(put ',name 'function-documentation ,docstr)
|
||
|
|
(put ',name 'transient--prefix
|
||
|
|
(,(or class 'transient-prefix) :command ',name ,@slots))
|
||
|
|
(put ',name 'transient--layout
|
||
|
|
',(cl-mapcan (lambda (s) (transient--parse-child name s))
|
||
|
|
suffixes)))))
|
||
|
|
|
||
|
|
(defmacro transient-define-suffix (name arglist &rest args)
|
||
|
|
"Define NAME as a transient suffix command.
|
||
|
|
|
||
|
|
ARGLIST are the arguments that the command takes.
|
||
|
|
DOCSTRING is the documentation string and is optional.
|
||
|
|
|
||
|
|
These arguments can optionally be followed by key-value pairs.
|
||
|
|
Each key has to be a keyword symbol, either `:class' or a
|
||
|
|
keyword argument supported by the constructor of that class.
|
||
|
|
The `transient-suffix' class is used if the class is not
|
||
|
|
specified explicitly.
|
||
|
|
|
||
|
|
The BODY must begin with an `interactive' form that matches
|
||
|
|
ARGLIST. The infix arguments are usually accessed by using
|
||
|
|
`transient-args' inside `interactive'.
|
||
|
|
|
||
|
|
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
|
||
|
|
(declare (debug (&define name lambda-list
|
||
|
|
[&optional lambda-doc]
|
||
|
|
[&rest keywordp sexp]
|
||
|
|
("interactive" interactive)
|
||
|
|
def-body))
|
||
|
|
(indent defun)
|
||
|
|
(doc-string 3))
|
||
|
|
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
|
||
|
|
(transient--expand-define-args args)))
|
||
|
|
`(progn
|
||
|
|
(defalias ',name (lambda ,arglist ,@body))
|
||
|
|
(put ',name 'interactive-only t)
|
||
|
|
(put ',name 'function-documentation ,docstr)
|
||
|
|
(put ',name 'transient--suffix
|
||
|
|
(,(or class 'transient-suffix) :command ',name ,@slots)))))
|
||
|
|
|
||
|
|
(defmacro transient-define-infix (name _arglist &rest args)
|
||
|
|
"Define NAME as a transient infix command.
|
||
|
|
|
||
|
|
ARGLIST is always ignored and reserved for future use.
|
||
|
|
DOCSTRING is the documentation string and is optional.
|
||
|
|
|
||
|
|
The key-value pairs are mandatory. All transient infix commands
|
||
|
|
are equal to each other (but not eq), so it is meaningless to
|
||
|
|
define an infix command without also setting at least `:class'
|
||
|
|
and one other keyword (which it is depends on the used class,
|
||
|
|
usually `:argument' or `:variable').
|
||
|
|
|
||
|
|
Each key has to be a keyword symbol, either `:class' or a keyword
|
||
|
|
argument supported by the constructor of that class. The
|
||
|
|
`transient-switch' class is used if the class is not specified
|
||
|
|
explicitly.
|
||
|
|
|
||
|
|
The function definitions is always:
|
||
|
|
|
||
|
|
(lambda ()
|
||
|
|
(interactive)
|
||
|
|
(let ((obj (transient-suffix-object)))
|
||
|
|
(transient-infix-set obj (transient-infix-read obj)))
|
||
|
|
(transient--show))
|
||
|
|
|
||
|
|
`transient-infix-read' and `transient-infix-set' are generic
|
||
|
|
functions. Different infix commands behave differently because
|
||
|
|
the concrete methods are different for different infix command
|
||
|
|
classes. In rare case the above command function might not be
|
||
|
|
suitable, even if you define your own infix command class. In
|
||
|
|
that case you have to use `transient-suffix-command' to define
|
||
|
|
the infix command and use t as the value of the `:transient'
|
||
|
|
keyword.
|
||
|
|
|
||
|
|
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
|
||
|
|
(declare (debug (&define name lambda-list
|
||
|
|
[&optional lambda-doc]
|
||
|
|
[&rest keywordp sexp]))
|
||
|
|
(indent defun)
|
||
|
|
(doc-string 3))
|
||
|
|
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
|
||
|
|
(transient--expand-define-args args)))
|
||
|
|
`(progn
|
||
|
|
(defalias ',name ,(transient--default-infix-command))
|
||
|
|
(put ',name 'interactive-only t)
|
||
|
|
(put ',name 'function-documentation ,docstr)
|
||
|
|
(put ',name 'transient--suffix
|
||
|
|
(,(or class 'transient-switch) :command ',name ,@slots)))))
|
||
|
|
|
||
|
|
(defalias 'transient-define-argument 'define-infix-command
|
||
|
|
"Define NAME as a transient infix command.
|
||
|
|
|
||
|
|
Only use this alias to define an infix command that actually
|
||
|
|
sets an infix argument. To define a infix command that, for
|
||
|
|
example, sets a variable use `transient-define-infix' instead.
|
||
|
|
|
||
|
|
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
|
||
|
|
|
||
|
|
(defun transient--expand-define-args (args)
|
||
|
|
(let (class keys suffixes docstr)
|
||
|
|
(when (stringp (car args))
|
||
|
|
(setq docstr (pop args)))
|
||
|
|
(while (keywordp (car args))
|
||
|
|
(let ((k (pop args))
|
||
|
|
(v (pop args)))
|
||
|
|
(if (eq k :class)
|
||
|
|
(setq class v)
|
||
|
|
(push k keys)
|
||
|
|
(push v keys))))
|
||
|
|
(while (vectorp (car args))
|
||
|
|
(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
|
||
|
|
(vector (when-let ((c (transient--parse-group prefix spec))) (list c)))
|
||
|
|
(list (when-let ((c (transient--parse-suffix prefix spec))) (list c)))
|
||
|
|
(string (list spec))))
|
||
|
|
|
||
|
|
(defun transient--parse-group (prefix spec)
|
||
|
|
(setq spec (append spec nil))
|
||
|
|
(cl-symbol-macrolet
|
||
|
|
((car (car spec))
|
||
|
|
(pop (pop spec)))
|
||
|
|
(let (level class args)
|
||
|
|
(when (integerp car)
|
||
|
|
(setq level pop))
|
||
|
|
(when (stringp car)
|
||
|
|
(setq args (plist-put args :description pop)))
|
||
|
|
(while (keywordp car)
|
||
|
|
(let ((k pop))
|
||
|
|
(if (eq k :class)
|
||
|
|
(setq class pop)
|
||
|
|
(setq args (plist-put args k pop)))))
|
||
|
|
(vector (or level (oref-default 'transient-child level))
|
||
|
|
(or class
|
||
|
|
(if (vectorp car)
|
||
|
|
'transient-columns
|
||
|
|
'transient-column))
|
||
|
|
args
|
||
|
|
(cl-mapcan (lambda (s) (transient--parse-child prefix s)) spec)))))
|
||
|
|
|
||
|
|
(defun transient--parse-suffix (prefix spec)
|
||
|
|
(let (level class args)
|
||
|
|
(cl-symbol-macrolet
|
||
|
|
((car (car spec))
|
||
|
|
(pop (pop spec)))
|
||
|
|
(when (integerp car)
|
||
|
|
(setq level pop))
|
||
|
|
(when (or (stringp car)
|
||
|
|
(vectorp car))
|
||
|
|
(setq args (plist-put args :key pop)))
|
||
|
|
(when (or (stringp car)
|
||
|
|
(eq (car-safe car) 'lambda)
|
||
|
|
(and (symbolp car)
|
||
|
|
(not (commandp car))
|
||
|
|
(commandp (cadr spec))))
|
||
|
|
(setq args (plist-put args :description pop)))
|
||
|
|
(cond
|
||
|
|
((keywordp car)
|
||
|
|
(error "Need command, got %S" car))
|
||
|
|
((symbolp car)
|
||
|
|
(setq args (plist-put args :command pop)))
|
||
|
|
((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
|
||
|
|
(intern (format "transient:%s:%s"
|
||
|
|
prefix arg))))
|
||
|
|
(cond ((and car (not (keywordp car)))
|
||
|
|
(setq class 'transient-option)
|
||
|
|
(setq args (plist-put args :reader pop)))
|
||
|
|
((not (string-suffix-p "=" arg))
|
||
|
|
(setq class 'transient-switch))
|
||
|
|
(t
|
||
|
|
(setq class 'transient-option)
|
||
|
|
(setq args (plist-put args :reader 'read-string))))))
|
||
|
|
(t
|
||
|
|
(error "Needed command or argument, got %S" car)))
|
||
|
|
(while (keywordp car)
|
||
|
|
(let ((k pop))
|
||
|
|
(cl-case k
|
||
|
|
(:class (setq class pop))
|
||
|
|
(:level (setq level pop))
|
||
|
|
(t (setq args (plist-put args k pop)))))))
|
||
|
|
(unless (plist-get args :key)
|
||
|
|
(when-let ((shortarg (plist-get args :shortarg)))
|
||
|
|
(setq args (plist-put args :key shortarg))))
|
||
|
|
(list (or level (oref-default 'transient-child level))
|
||
|
|
(or class 'transient-suffix)
|
||
|
|
args)))
|
||
|
|
|
||
|
|
(defun transient--default-infix-command ()
|
||
|
|
(cons 'lambda
|
||
|
|
'(()
|
||
|
|
(interactive)
|
||
|
|
(let ((obj (transient-suffix-object)))
|
||
|
|
(transient-infix-set obj (transient-infix-read obj)))
|
||
|
|
(transient--show))))
|
||
|
|
|
||
|
|
(defun transient--ensure-infix-command (obj)
|
||
|
|
(let ((cmd (oref obj command)))
|
||
|
|
(unless (or (commandp cmd)
|
||
|
|
(get cmd 'transient--infix-command))
|
||
|
|
(if (or (cl-typep obj 'transient-switch)
|
||
|
|
(cl-typep obj 'transient-option))
|
||
|
|
(put cmd 'transient--infix-command
|
||
|
|
(transient--default-infix-command))
|
||
|
|
;; This is not an anonymous infix argument.
|
||
|
|
(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))))
|
||
|
|
|
||
|
|
;;; Edit
|
||
|
|
|
||
|
|
(defun transient--insert-suffix (prefix loc suffix action)
|
||
|
|
(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)))
|
||
|
|
(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 (and (listp suffix)
|
||
|
|
(listp elt))
|
||
|
|
(let ((key (transient--spec-key suf)))
|
||
|
|
(if (equal (transient--kbd key)
|
||
|
|
(transient--kbd (transient--spec-key elt)))
|
||
|
|
(setq action 'replace)
|
||
|
|
(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)
|
||
|
|
"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).
|
||
|
|
See info node `(transient)Modifying Existing Transients'."
|
||
|
|
(declare (indent defun))
|
||
|
|
(transient--insert-suffix prefix loc suffix 'insert))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun transient-append-suffix (prefix loc suffix)
|
||
|
|
"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).
|
||
|
|
See info node `(transient)Modifying Existing Transients'."
|
||
|
|
(declare (indent defun))
|
||
|
|
(transient--insert-suffix prefix loc suffix 'append))
|
||
|
|
|
||
|
|
;;;###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)
|
||
|
|
(when-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
|
||
|
|
`current-transient-object' 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--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.")
|
||
|
|
|
||
|
|
(define-obsolete-variable-alias 'transient--source-buffer
|
||
|
|
'transient--original-buffer "Transient 0.2.0")
|
||
|
|
|
||
|
|
(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 transient--prefix
|
||
|
|
(cl-find-if (lambda (obj)
|
||
|
|
(eq (transient--suffix-command obj)
|
||
|
|
(or command this-original-command)))
|
||
|
|
transient--suffixes)
|
||
|
|
(when-let ((obj (get (or command this-command) 'transient--suffix))
|
||
|
|
(obj (clone obj)))
|
||
|
|
(transient-init-scope obj)
|
||
|
|
(transient-init-value obj)
|
||
|
|
obj)))
|
||
|
|
|
||
|
|
(defun transient--suffix-command (object)
|
||
|
|
"Return the command represented by OBJECT.
|
||
|
|
|
||
|
|
If the value of OBJECT's `command' slot is a command, then return
|
||
|
|
that. Otherwise it is a symbol whose `transient--infix-command'
|
||
|
|
property holds an anonymous command, which is returned instead."
|
||
|
|
(cl-check-type object transient-suffix)
|
||
|
|
(let ((sym (oref object command)))
|
||
|
|
(if (commandp sym)
|
||
|
|
sym
|
||
|
|
(get sym 'transient--infix-command))))
|
||
|
|
|
||
|
|
(defun transient--suffix-symbol (arg)
|
||
|
|
"Return a symbol representing ARG.
|
||
|
|
|
||
|
|
ARG must be a command and/or a symbol. If it is a symbol,
|
||
|
|
then just return it. Otherwise return the symbol whose
|
||
|
|
`transient--infix-command' property's value is ARG."
|
||
|
|
(or (cl-typep arg 'command)
|
||
|
|
(cl-typep arg 'symbol)
|
||
|
|
(signal 'wrong-type-argument `((command symbol) ,arg)))
|
||
|
|
(if (symbolp arg)
|
||
|
|
arg
|
||
|
|
(let* ((obj (transient-suffix-object))
|
||
|
|
(sym (oref obj command)))
|
||
|
|
(if (eq (get sym 'transient--infix-command) arg)
|
||
|
|
sym
|
||
|
|
(catch 'found
|
||
|
|
(mapatoms (lambda (sym)
|
||
|
|
(when (eq (get sym 'transient--infix-command) arg)
|
||
|
|
(throw 'found sym)))))))))
|
||
|
|
|
||
|
|
;;; Keymaps
|
||
|
|
|
||
|
|
(defvar transient-base-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map (kbd "ESC ESC ESC") 'transient-quit-all)
|
||
|
|
(define-key map (kbd "C-g") 'transient-quit-one)
|
||
|
|
(define-key map (kbd "C-q") 'transient-quit-all)
|
||
|
|
(define-key map (kbd "C-z") 'transient-suspend)
|
||
|
|
(define-key map (kbd "C-v") 'transient-scroll-up)
|
||
|
|
(define-key map (kbd "M-v") 'transient-scroll-down)
|
||
|
|
(define-key map [next] 'transient-scroll-up)
|
||
|
|
(define-key map [prior] 'transient-scroll-down)
|
||
|
|
map)
|
||
|
|
"Parent of other keymaps used by Transient.
|
||
|
|
|
||
|
|
This is the parent keymap of all the keymaps that are used in
|
||
|
|
all transients: `transient-map' (which in turn is the parent
|
||
|
|
of the transient-specific keymaps), `transient-edit-map' and
|
||
|
|
`transient-sticky-map'.
|
||
|
|
|
||
|
|
If you change a binding here, then you might also have to edit
|
||
|
|
`transient-sticky-map' and `transient-common-commands'. While
|
||
|
|
the latter isn't a proper transient prefix command, it can be
|
||
|
|
edited using the same functions as used for transients.")
|
||
|
|
|
||
|
|
(defvar transient-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map transient-base-map)
|
||
|
|
(define-key map (kbd "C-p") 'universal-argument)
|
||
|
|
(define-key map (kbd "C--") 'negative-argument)
|
||
|
|
(define-key map (kbd "C-t") 'transient-show)
|
||
|
|
(define-key map (kbd "?") 'transient-help)
|
||
|
|
(define-key map (kbd "C-h") 'transient-help)
|
||
|
|
(define-key map (kbd "M-p") 'transient-history-prev)
|
||
|
|
(define-key map (kbd "M-n") 'transient-history-next)
|
||
|
|
map)
|
||
|
|
"Top-level keymap used by all transients.")
|
||
|
|
|
||
|
|
(defvar transient-edit-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map transient-base-map)
|
||
|
|
(define-key map (kbd "?") 'transient-help)
|
||
|
|
(define-key map (kbd "C-h") 'transient-help)
|
||
|
|
(define-key map (kbd "C-x l") 'transient-set-level)
|
||
|
|
map)
|
||
|
|
"Keymap that is active while a transient in is in \"edit mode\".")
|
||
|
|
|
||
|
|
(defvar transient-sticky-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map transient-base-map)
|
||
|
|
(define-key map (kbd "C-g") 'transient-quit-seq)
|
||
|
|
map)
|
||
|
|
"Keymap that is active while an incomplete key sequence is active.")
|
||
|
|
|
||
|
|
(defvar transient--common-command-prefixes '(?\C-x))
|
||
|
|
|
||
|
|
(put 'transient-common-commands
|
||
|
|
'transient--layout
|
||
|
|
(cl-mapcan
|
||
|
|
(lambda (s) (transient--parse-child 'transient-common-commands s))
|
||
|
|
'([:hide (lambda ()
|
||
|
|
(and (not (memq (car transient--redisplay-key)
|
||
|
|
transient--common-command-prefixes))
|
||
|
|
(not transient-show-common-commands)))
|
||
|
|
["Value commands"
|
||
|
|
("C-x s " "Set" transient-set)
|
||
|
|
("C-x C-s" "Save" transient-save)
|
||
|
|
("M-p " "Previous value" transient-history-prev)
|
||
|
|
("M-n " "Next value" transient-history-next)]
|
||
|
|
["Sticky commands"
|
||
|
|
;; Like `transient-sticky-map' except that
|
||
|
|
;; "C-g" has to be bound to a different command.
|
||
|
|
("C-g" "Quit prefix or transient" transient-quit-one)
|
||
|
|
("C-q" "Quit transient stack" transient-quit-all)
|
||
|
|
("C-z" "Suspend transient stack" transient-suspend)]
|
||
|
|
["Customize"
|
||
|
|
("C-x t" transient-toggle-common
|
||
|
|
:description (lambda ()
|
||
|
|
(if transient-show-common-commands
|
||
|
|
"Hide common commands"
|
||
|
|
"Show common permanently")))
|
||
|
|
("C-x l" "Show/hide suffixes" transient-set-level)]])))
|
||
|
|
|
||
|
|
(defvar transient-predicate-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map [handle-switch-frame] 'transient--do-suspend)
|
||
|
|
(define-key map [transient-suspend] 'transient--do-suspend)
|
||
|
|
(define-key map [transient-help] 'transient--do-stay)
|
||
|
|
(define-key map [transient-set-level] 'transient--do-stay)
|
||
|
|
(define-key map [transient-history-prev] 'transient--do-stay)
|
||
|
|
(define-key map [transient-history-next] 'transient--do-stay)
|
||
|
|
(define-key map [universal-argument] 'transient--do-stay)
|
||
|
|
(define-key map [negative-argument] 'transient--do-stay)
|
||
|
|
(define-key map [digit-argument] 'transient--do-stay)
|
||
|
|
(define-key map [transient-quit-all] 'transient--do-quit-all)
|
||
|
|
(define-key map [transient-quit-one] 'transient--do-quit-one)
|
||
|
|
(define-key map [transient-quit-seq] 'transient--do-stay)
|
||
|
|
(define-key map [transient-show] 'transient--do-stay)
|
||
|
|
(define-key map [transient-update] 'transient--do-stay)
|
||
|
|
(define-key map [transient-toggle-common] 'transient--do-stay)
|
||
|
|
(define-key map [transient-set] 'transient--do-call)
|
||
|
|
(define-key map [transient-save] 'transient--do-call)
|
||
|
|
(define-key map [describe-key-briefly] 'transient--do-stay)
|
||
|
|
(define-key map [describe-key] 'transient--do-stay)
|
||
|
|
(define-key map [transient-scroll-up] 'transient--do-stay)
|
||
|
|
(define-key map [transient-scroll-down] 'transient--do-stay)
|
||
|
|
(define-key map [mwheel-scroll] 'transient--do-stay)
|
||
|
|
(define-key map [scroll-bar-toolkit-scroll] 'transient--do-stay)
|
||
|
|
(define-key map [transient-noop] 'transient--do-noop)
|
||
|
|
(define-key map [transient-mouse-push-button] 'transient--do-move)
|
||
|
|
(define-key map [transient-push-button] 'transient--do-move)
|
||
|
|
(define-key map [transient-backward-button] 'transient--do-move)
|
||
|
|
(define-key map [transient-forward-button] 'transient--do-move)
|
||
|
|
(define-key map [transient-isearch-backward] 'transient--do-move)
|
||
|
|
(define-key map [transient-isearch-forward] 'transient--do-move)
|
||
|
|
map)
|
||
|
|
"Base keymap used to map common commands to their transient behavior.
|
||
|
|
|
||
|
|
The \"transient behavior\" of a command controls, among other
|
||
|
|
things, whether invoking the command causes the transient to be
|
||
|
|
exited or not and whether infix arguments are exported before
|
||
|
|
doing so.
|
||
|
|
|
||
|
|
Each \"key\" is a command that is common to all transients and
|
||
|
|
that is bound in `transient-map', `transient-edit-map',
|
||
|
|
`transient-sticky-map' and/or `transient-common-command'.
|
||
|
|
|
||
|
|
Each binding is a \"pre-command\", a function that controls the
|
||
|
|
transient behavior of the respective command.
|
||
|
|
|
||
|
|
For transient commands that are bound in individual transients,
|
||
|
|
the transient behavior is specified using the `:transient' slot
|
||
|
|
of the corresponding object.")
|
||
|
|
|
||
|
|
(defvar transient-popup-navigation-map)
|
||
|
|
|
||
|
|
(defvar transient--transient-map nil)
|
||
|
|
(defvar transient--predicate-map nil)
|
||
|
|
(defvar transient--redisplay-map nil)
|
||
|
|
(defvar transient--redisplay-key nil)
|
||
|
|
|
||
|
|
(defun transient--push-keymap (map)
|
||
|
|
(transient--debug " push %s%s" map (if (symbol-value map) "" " VOID"))
|
||
|
|
(with-demoted-errors "transient--push-keymap: %S"
|
||
|
|
(internal-push-keymap (symbol-value map) 'overriding-terminal-local-map)))
|
||
|
|
|
||
|
|
(defun transient--pop-keymap (map)
|
||
|
|
(transient--debug " pop %s%s" map (if (symbol-value map) "" " VOID"))
|
||
|
|
(with-demoted-errors "transient--pop-keymap: %S"
|
||
|
|
(internal-pop-keymap (symbol-value 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)
|
||
|
|
(transient--emergency-exit)
|
||
|
|
(error "Cannot bind %S to %s and also %s"
|
||
|
|
(string-trim key)
|
||
|
|
cmd conflict)))
|
||
|
|
(define-key map kbd cmd))))
|
||
|
|
(when transient-enable-popup-navigation
|
||
|
|
(setq map
|
||
|
|
(make-composed-keymap (list map transient-popup-navigation-map))))
|
||
|
|
map))
|
||
|
|
|
||
|
|
(defun transient--make-predicate-map ()
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map transient-predicate-map)
|
||
|
|
(dolist (obj transient--suffixes)
|
||
|
|
(let* ((cmd (oref obj command))
|
||
|
|
(sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix)))
|
||
|
|
(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 do
|
||
|
|
(`t (if sub-prefix
|
||
|
|
'transient--do-replace
|
||
|
|
'transient--do-stay))
|
||
|
|
(`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
|
||
|
|
(lookup-key transient--transient-map (vconcat transient--redisplay-key))
|
||
|
|
transient--transient-map))
|
||
|
|
topmap))
|
||
|
|
|
||
|
|
;;; Setup
|
||
|
|
|
||
|
|
(defun transient-setup (&optional name layout edit &rest params)
|
||
|
|
"Setup the transient specified by NAME.
|
||
|
|
|
||
|
|
This function is called by transient prefix commands to setup the
|
||
|
|
transient. In that case NAME is mandatory, LAYOUT and EDIT must
|
||
|
|
be nil and PARAMS may be (but usually is not) used to set e.g. the
|
||
|
|
\"scope\" of the transient (see `transient-define-prefix').
|
||
|
|
|
||
|
|
This function is also called internally in which case LAYOUT and
|
||
|
|
EDIT may be non-nil."
|
||
|
|
(transient--debug 'setup)
|
||
|
|
(when (and (>= (minibuffer-depth) 1) transient--prefix)
|
||
|
|
(error "Cannot invoke %s while minibuffer is active %s"
|
||
|
|
this-command "on behalf of another prefix command"))
|
||
|
|
(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))))
|
||
|
|
((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))
|
||
|
|
(transient--redisplay)
|
||
|
|
(transient--init-transient)
|
||
|
|
(transient--suspend-which-key-mode)))
|
||
|
|
|
||
|
|
(defun transient--init-objects (name layout params)
|
||
|
|
(setq transient--prefix
|
||
|
|
(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-init-value transient--prefix)
|
||
|
|
(setq transient--layout
|
||
|
|
(or layout
|
||
|
|
(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)))))))
|
||
|
|
(setq transient--suffixes
|
||
|
|
(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 transient--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 (transient--use-level-p level)
|
||
|
|
(let ((obj (apply class :level level args)))
|
||
|
|
(when (transient--use-suffix-p obj)
|
||
|
|
(when-let ((suffixes
|
||
|
|
(cl-mapcan (lambda (c) (transient--init-child levels c))
|
||
|
|
children)))
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
;;; 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 'minibuffer-setup-hook #'transient--minibuffer-setup)
|
||
|
|
(add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
|
||
|
|
(add-hook 'post-command-hook #'transient--post-command)
|
||
|
|
(advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)
|
||
|
|
(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)
|
||
|
|
(cond
|
||
|
|
((memq this-command '(transient-update transient-quit-seq))
|
||
|
|
(transient--pop-keymap 'transient--redisplay-map))
|
||
|
|
((and transient--helpp
|
||
|
|
(not (memq this-command '(transient-quit-one
|
||
|
|
transient-quit-all))))
|
||
|
|
(cond
|
||
|
|
((transient-help)
|
||
|
|
(transient--do-suspend)
|
||
|
|
(setq this-command 'transient-suspend)
|
||
|
|
(transient--pre-exit))
|
||
|
|
((not (transient--edebug-command-p))
|
||
|
|
(setq this-command 'transient-undefined))))
|
||
|
|
((and transient--editp
|
||
|
|
(transient-suffix-object)
|
||
|
|
(not (memq this-command '(transient-quit-one
|
||
|
|
transient-quit-all
|
||
|
|
transient-help))))
|
||
|
|
(setq this-command 'transient-set-level))
|
||
|
|
(t
|
||
|
|
(setq transient--exitp nil)
|
||
|
|
(when (eq (if-let ((fn (transient--get-predicate-for
|
||
|
|
this-original-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)
|
||
|
|
transient--exit)
|
||
|
|
(transient--pre-exit)))))
|
||
|
|
|
||
|
|
(defun transient--get-predicate-for (cmd)
|
||
|
|
(or (lookup-key transient--predicate-map
|
||
|
|
(vector (transient--suffix-symbol cmd)))
|
||
|
|
(oref transient--prefix transient-non-suffix)))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
(remove-hook 'pre-command-hook #'transient--pre-command)
|
||
|
|
(unless transient--showp
|
||
|
|
(message ""))
|
||
|
|
(setq transient--transient-map nil)
|
||
|
|
(setq transient--predicate-map nil)
|
||
|
|
(setq transient--redisplay-map nil)
|
||
|
|
(setq transient--redisplay-key nil)
|
||
|
|
(setq transient--showp 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 ((buf (window-buffer transient--window)))
|
||
|
|
(with-demoted-errors "Error while exiting transient: %S"
|
||
|
|
(delete-window transient--window))
|
||
|
|
(kill-buffer buf))))
|
||
|
|
|
||
|
|
(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--minibuffer-setup ()
|
||
|
|
(transient--debug 'minibuffer-setup)
|
||
|
|
(unless (> (minibuffer-depth) 1)
|
||
|
|
(unless transient--exitp
|
||
|
|
(transient--pop-keymap 'transient--transient-map)
|
||
|
|
(transient--pop-keymap 'transient--redisplay-map)
|
||
|
|
(remove-hook 'pre-command-hook #'transient--pre-command))
|
||
|
|
(remove-hook 'post-command-hook #'transient--post-command)))
|
||
|
|
|
||
|
|
(defun transient--minibuffer-exit ()
|
||
|
|
(transient--debug 'minibuffer-exit)
|
||
|
|
(unless (> (minibuffer-depth) 1)
|
||
|
|
(unless transient--exitp
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(defun transient--suspend-override (&optional minibuffer-hooks)
|
||
|
|
(transient--debug 'suspend-override)
|
||
|
|
(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)
|
||
|
|
(when minibuffer-hooks
|
||
|
|
(remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
|
||
|
|
(remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
|
||
|
|
(advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)))
|
||
|
|
|
||
|
|
(defun transient--resume-override (&optional minibuffer-hooks)
|
||
|
|
(transient--debug 'resume-override)
|
||
|
|
(transient--push-keymap 'transient--transient-map)
|
||
|
|
(transient--push-keymap 'transient--redisplay-map)
|
||
|
|
(add-hook 'pre-command-hook #'transient--pre-command)
|
||
|
|
(add-hook 'post-command-hook #'transient--post-command)
|
||
|
|
(when minibuffer-hooks
|
||
|
|
(add-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
|
||
|
|
(add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
|
||
|
|
(advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)))
|
||
|
|
|
||
|
|
(defun transient--post-command ()
|
||
|
|
(transient--debug 'post-command)
|
||
|
|
(if transient--exitp
|
||
|
|
(progn
|
||
|
|
(unless (and (eq transient--exitp 'replace)
|
||
|
|
(or transient--prefix
|
||
|
|
;; The current command could act as a prefix,
|
||
|
|
;; but decided not to call `transient-setup'.
|
||
|
|
(prog1 nil (transient--stack-zap))))
|
||
|
|
(remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
|
||
|
|
(remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
|
||
|
|
(advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)
|
||
|
|
(remove-hook 'post-command-hook #'transient--post-command))
|
||
|
|
(setq transient-current-prefix nil)
|
||
|
|
(setq transient-current-command nil)
|
||
|
|
(setq transient-current-suffixes nil)
|
||
|
|
(let ((resume (and transient--stack
|
||
|
|
(not (memq transient--exitp '(replace suspend))))))
|
||
|
|
(setq transient--exitp nil)
|
||
|
|
(setq transient--helpp nil)
|
||
|
|
(setq transient--editp nil)
|
||
|
|
(run-hooks 'transient-exit-hook)
|
||
|
|
(when resume
|
||
|
|
(transient--stack-pop))))
|
||
|
|
(transient--pop-keymap 'transient--redisplay-map)
|
||
|
|
(setq transient--redisplay-map (transient--make-redisplay-map))
|
||
|
|
(transient--push-keymap 'transient--redisplay-map)
|
||
|
|
(unless (eq this-command (oref transient--prefix command))
|
||
|
|
(transient--redisplay))))
|
||
|
|
|
||
|
|
(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 (memq this-command transient--scroll-commands)
|
||
|
|
(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
|
||
|
|
(if (symbolp arg)
|
||
|
|
(message "-- %-16s (cmd: %s, exit: %s)"
|
||
|
|
arg this-command transient--exitp)
|
||
|
|
(apply #'message arg args))))
|
||
|
|
|
||
|
|
(defun transient--emergency-exit (&optional err)
|
||
|
|
"Exit the current transient command after an error occurred.
|
||
|
|
|
||
|
|
Beside being used with `condition-case', this function also has
|
||
|
|
to be a member of `debugger-mode-hook', else the debugger would
|
||
|
|
be unusable and exiting it by pressing \"q\" would fail because
|
||
|
|
the transient command would still be active and that key would
|
||
|
|
either be unbound or do something else.
|
||
|
|
|
||
|
|
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-command)
|
||
|
|
(when err
|
||
|
|
(signal (car err) (cdr err)))))
|
||
|
|
|
||
|
|
(add-hook 'debugger-mode-hook 'transient--emergency-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-exit ()
|
||
|
|
"Call the command after exporting variables and exit the transient."
|
||
|
|
(transient--export)
|
||
|
|
(transient--stack-zap)
|
||
|
|
transient--exit)
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(put 'transient--do-stay 'transient-color 'transient-blue)
|
||
|
|
(put 'transient--do-noop 'transient-color 'transient-blue)
|
||
|
|
(put 'transient--do-warn 'transient-color 'transient-blue)
|
||
|
|
(put 'transient--do-warn-inapt 'transient-color 'transient-blue)
|
||
|
|
(put 'transient--do-call 'transient-color 'transient-blue)
|
||
|
|
(put 'transient--do-exit 'transient-color 'transient-red)
|
||
|
|
(put 'transient--do-replace 'transient-color 'transient-red)
|
||
|
|
(put 'transient--do-suspend 'transient-color 'transient-red)
|
||
|
|
(put 'transient--do-quit-one 'transient-color 'transient-red)
|
||
|
|
(put 'transient--do-quit-all 'transient-color 'transient-red)
|
||
|
|
(put 'transient--do-move 'transient-color 'transient-blue)
|
||
|
|
|
||
|
|
;;; Commands
|
||
|
|
|
||
|
|
(defun transient-noop ()
|
||
|
|
"Do nothing at all."
|
||
|
|
(interactive))
|
||
|
|
|
||
|
|
(defun transient-undefined ()
|
||
|
|
"Warn the user that the pressed key is not bound to any suffix."
|
||
|
|
(interactive)
|
||
|
|
(transient--invalid "Unbound suffix"))
|
||
|
|
|
||
|
|
(defun transient-inapt ()
|
||
|
|
"Warn the user that the invoked command is inapt."
|
||
|
|
(interactive)
|
||
|
|
(transient--invalid "Inapt command"))
|
||
|
|
|
||
|
|
(defun transient--invalid (msg)
|
||
|
|
(ding)
|
||
|
|
(message "%s: `%s' (Use `%s' to abort, `%s' for help) [%s]"
|
||
|
|
msg
|
||
|
|
(propertize (key-description (this-single-command-keys))
|
||
|
|
'face 'font-lock-warning-face)
|
||
|
|
(propertize "C-g" 'face 'transient-key)
|
||
|
|
(propertize "?" 'face 'transient-key)
|
||
|
|
(propertize (symbol-name (transient--suffix-symbol
|
||
|
|
this-original-command))
|
||
|
|
'face 'font-lock-warning-face)))
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(defun transient-show ()
|
||
|
|
"Show the transient's state in the popup buffer."
|
||
|
|
(interactive)
|
||
|
|
(setq transient--showp t))
|
||
|
|
|
||
|
|
(defvar-local transient--restore-winconf nil)
|
||
|
|
|
||
|
|
(defvar transient-resume-mode)
|
||
|
|
|
||
|
|
(defun transient-help ()
|
||
|
|
"Show help for the active transient or one of its suffixes."
|
||
|
|
(interactive)
|
||
|
|
(if (called-interactively-p 'any)
|
||
|
|
(setq transient--helpp t)
|
||
|
|
(with-demoted-errors "transient-help: %S"
|
||
|
|
(when (lookup-key transient--transient-map
|
||
|
|
(this-single-command-raw-keys))
|
||
|
|
(setq transient--helpp nil)
|
||
|
|
(let ((winconf (current-window-configuration)))
|
||
|
|
(transient-show-help
|
||
|
|
(if (eq this-original-command 'transient-help)
|
||
|
|
transient--prefix
|
||
|
|
(or (transient-suffix-object)
|
||
|
|
this-original-command)))
|
||
|
|
(setq transient--restore-winconf winconf))
|
||
|
|
(fit-window-to-buffer nil (frame-height) (window-height))
|
||
|
|
(transient-resume-mode)
|
||
|
|
(message "Type \"q\" to resume transient command.")
|
||
|
|
t))))
|
||
|
|
|
||
|
|
(defun transient-set-level (&optional command level)
|
||
|
|
"Set the level of the transient or one of its suffix commands."
|
||
|
|
(interactive
|
||
|
|
(let ((command this-original-command)
|
||
|
|
(prefix (oref transient--prefix command)))
|
||
|
|
(and (or (not (eq command 'transient-set-level))
|
||
|
|
(and transient--editp
|
||
|
|
(setq command prefix)))
|
||
|
|
(list command
|
||
|
|
(let ((keys (this-single-command-raw-keys)))
|
||
|
|
(and (lookup-key transient--transient-map keys)
|
||
|
|
(string-to-number
|
||
|
|
(let ((transient--active-infix
|
||
|
|
(transient-suffix-object command)))
|
||
|
|
(transient--show)
|
||
|
|
(transient--read-number-N
|
||
|
|
(format "Set level for `%s': "
|
||
|
|
(transient--suffix-symbol command))
|
||
|
|
nil nil (not (eq command prefix)))))))))))
|
||
|
|
(cond
|
||
|
|
((not command)
|
||
|
|
(setq transient--editp t)
|
||
|
|
(transient-setup))
|
||
|
|
(level
|
||
|
|
(let* ((prefix (oref transient--prefix command))
|
||
|
|
(alist (alist-get prefix transient-levels))
|
||
|
|
(sym (transient--suffix-symbol command)))
|
||
|
|
(if (eq command prefix)
|
||
|
|
(progn (oset transient--prefix level level)
|
||
|
|
(setq sym t))
|
||
|
|
(oset (transient-suffix-object command) level level))
|
||
|
|
(setf (alist-get sym alist) level)
|
||
|
|
(setf (alist-get prefix transient-levels) alist))
|
||
|
|
(transient-save-levels))
|
||
|
|
(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-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-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 ((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)
|
||
|
|
(if-let ((default (and (slot-boundp obj 'default-value)
|
||
|
|
(oref obj default-value))))
|
||
|
|
(if (functionp default)
|
||
|
|
(funcall default)
|
||
|
|
default)
|
||
|
|
nil)))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-init-value ((obj transient-switch))
|
||
|
|
(oset obj value
|
||
|
|
(car (member (oref obj argument)
|
||
|
|
(oref transient--prefix value)))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-init-value ((obj transient-option))
|
||
|
|
(oset obj value
|
||
|
|
(transient--value-match (format "\\`%s\\(.*\\)" (oref obj argument)))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-init-value ((obj transient-switches))
|
||
|
|
(oset obj value
|
||
|
|
(transient--value-match (oref obj argument-regexp))))
|
||
|
|
|
||
|
|
(defun transient--value-match (re)
|
||
|
|
(when-let ((match (cl-find-if (lambda (v)
|
||
|
|
(and (stringp v)
|
||
|
|
(string-match re v)))
|
||
|
|
(oref transient--prefix value))))
|
||
|
|
(match-string 1 match)))
|
||
|
|
|
||
|
|
(cl-defmethod transient-init-value ((obj transient-files))
|
||
|
|
(oset obj value
|
||
|
|
(cdr (assoc "--" (oref transient--prefix value)))))
|
||
|
|
|
||
|
|
;;;; 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.
|
||
|
|
|
||
|
|
Also arrange 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."
|
||
|
|
(let ((transient--active-infix obj))
|
||
|
|
(transient--show))
|
||
|
|
(transient--with-emergency-exit
|
||
|
|
(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* ((overriding-terminal-local-map nil)
|
||
|
|
(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 (bound-and-true-p ivy-mode)
|
||
|
|
(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-directory (prompt _initial-input _history)
|
||
|
|
"Read a directory."
|
||
|
|
(expand-file-name (read-directory-name prompt)))
|
||
|
|
|
||
|
|
(defun transient-read-existing-directory (prompt _initial-input _history)
|
||
|
|
"Read an existing directory."
|
||
|
|
(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)))
|
||
|
|
(cond ((string-equal str "")
|
||
|
|
(cl-return nil))
|
||
|
|
((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 (when-let ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
|
||
|
|
(if (and (stringp arg) (string-suffix-p "=" arg))
|
||
|
|
arg
|
||
|
|
(concat arg ": ")))
|
||
|
|
(when-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.
|
||
|
|
|
||
|
|
This implementation should be suitable for almost all infix
|
||
|
|
commands."
|
||
|
|
(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 (remove arg (cl-find-if (lambda (elt) (member arg elt)) spec))))
|
||
|
|
(progn
|
||
|
|
(cl-call-next-method obj value)
|
||
|
|
(dolist (arg incomp)
|
||
|
|
(when-let ((obj (cl-find-if (lambda (obj)
|
||
|
|
(and (slot-boundp obj 'argument)
|
||
|
|
(equal (oref obj argument) arg)))
|
||
|
|
transient--suffixes)))
|
||
|
|
(let ((transient--unset-incompatible nil))
|
||
|
|
(transient-infix-set obj nil)))))
|
||
|
|
(cl-call-next-method obj value))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-set-value ((obj transient-prefix))
|
||
|
|
(oset (oref obj prototype) value (transient-get-value))
|
||
|
|
(transient--history-push obj))
|
||
|
|
|
||
|
|
;;;; Save
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
;;;; 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."
|
||
|
|
(if (eq transient-current-command prefix)
|
||
|
|
(delq nil (mapcar 'transient-infix-value transient-current-suffixes))
|
||
|
|
(let ((transient--prefix nil)
|
||
|
|
(transient--layout nil)
|
||
|
|
(transient--suffixes nil))
|
||
|
|
(transient--init-objects prefix nil nil)
|
||
|
|
(delq nil (mapcar 'transient-infix-value transient--suffixes)))))
|
||
|
|
|
||
|
|
(defun transient-get-value ()
|
||
|
|
(delq nil (mapcar 'transient-infix-value transient-current-suffixes)))
|
||
|
|
|
||
|
|
(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 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 (concat ARGUMENT VALUE) or nil.
|
||
|
|
|
||
|
|
ARGUMENT and VALUE are the values of the respective slots of OBJ.
|
||
|
|
If VALUE is nil, then return nil. VALUE may be the empty string,
|
||
|
|
which is not the same as nil."
|
||
|
|
(when-let ((value (oref obj value)))
|
||
|
|
(concat (oref obj argument) 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)
|
||
|
|
|
||
|
|
(cl-defmethod transient-infix-value ((obj transient-files))
|
||
|
|
"Return (concat ARGUMENT VALUE) or nil.
|
||
|
|
|
||
|
|
ARGUMENT and VALUE are the values of the respective slots of OBJ.
|
||
|
|
If VALUE is nil, then return nil. VALUE may be the empty string,
|
||
|
|
which is not the same as nil."
|
||
|
|
(when-let ((value (oref obj value)))
|
||
|
|
(cons (oref obj argument) value)))
|
||
|
|
|
||
|
|
;;; 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))
|
||
|
|
(unless (window-live-p transient--window)
|
||
|
|
(setq transient--window
|
||
|
|
(display-buffer buf transient-display-buffer-action)))
|
||
|
|
(with-selected-window transient--window
|
||
|
|
(when transient-enable-popup-navigation
|
||
|
|
(setq focus (button-get (point) 'command)))
|
||
|
|
(erase-buffer)
|
||
|
|
(set-window-hscroll transient--window 0)
|
||
|
|
(set-window-dedicated-p transient--window t)
|
||
|
|
(set-window-parameter transient--window 'no-other-window t)
|
||
|
|
(setq window-size-fixed t)
|
||
|
|
(when (bound-and-true-p tab-line-format)
|
||
|
|
(setq tab-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))))
|
||
|
|
(let ((window-resize-pixelwise t)
|
||
|
|
(window-size-fixed nil))
|
||
|
|
(fit-window-to-buffer nil nil 1))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(when transient-force-fixed-pitch
|
||
|
|
(transient--force-fixed-pitch))
|
||
|
|
(when transient-enable-popup-navigation
|
||
|
|
(transient--goto-button focus)))))
|
||
|
|
|
||
|
|
(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)))))
|
||
|
|
|
||
|
|
(cl-defgeneric transient--insert-group (group)
|
||
|
|
"Format GROUP and its elements and insert the result.")
|
||
|
|
|
||
|
|
(cl-defmethod transient--insert-group :before ((group transient-group))
|
||
|
|
"Insert GROUP's description, if any."
|
||
|
|
(when-let ((desc (transient-format-description group)))
|
||
|
|
(insert desc ?\n)))
|
||
|
|
|
||
|
|
(cl-defmethod transient--insert-group ((group transient-row))
|
||
|
|
(dolist (suffix (oref group suffixes))
|
||
|
|
(insert (transient-format suffix))
|
||
|
|
(insert " "))
|
||
|
|
(insert ?\n))
|
||
|
|
|
||
|
|
(cl-defmethod transient--insert-group ((group transient-column))
|
||
|
|
(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)
|
||
|
|
(let ((rows (mapcar 'transient-format (oref column suffixes))))
|
||
|
|
(when-let ((desc (transient-format-description column)))
|
||
|
|
(push desc rows))
|
||
|
|
rows))
|
||
|
|
(oref group suffixes)))
|
||
|
|
(rs (apply #'max (mapcar #'length columns)))
|
||
|
|
(cs (length columns))
|
||
|
|
(cw (mapcar (lambda (col) (apply #'max (mapcar #'length col)))
|
||
|
|
columns))
|
||
|
|
(cc (transient--seq-reductions-from (apply-partially #'+ 3) cw 0)))
|
||
|
|
(dotimes (r rs)
|
||
|
|
(dotimes (c cs)
|
||
|
|
(insert (make-string (- (nth c cc) (current-column)) ?\s))
|
||
|
|
(when-let ((cell (nth r (nth c columns))))
|
||
|
|
(insert cell))
|
||
|
|
(when (= c (1- cs))
|
||
|
|
(insert ?\n))))))
|
||
|
|
|
||
|
|
(cl-defmethod transient--insert-group ((group transient-subgroups))
|
||
|
|
(let* ((subgroups (oref group suffixes))
|
||
|
|
(n (length subgroups)))
|
||
|
|
(dotimes (s n)
|
||
|
|
(transient--insert-group (nth s subgroups))
|
||
|
|
(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)
|
||
|
|
(set-text-properties 0 (length str)
|
||
|
|
(list 'face 'transient-inapt-suffix)
|
||
|
|
str))
|
||
|
|
(if transient-enable-popup-navigation
|
||
|
|
(make-text-button str nil
|
||
|
|
'type 'transient-button
|
||
|
|
'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
|
||
|
|
((equal (seq-take seq len) transient--redisplay-key)
|
||
|
|
(let ((pre (key-description (vconcat (seq-take seq len))))
|
||
|
|
(suf (key-description (vconcat (seq-drop seq len)))))
|
||
|
|
(setq pre (replace-regexp-in-string "RET" "C-m" pre t))
|
||
|
|
(setq pre (replace-regexp-in-string "TAB" "C-i" pre t))
|
||
|
|
(setq suf (replace-regexp-in-string "RET" "C-m" suf t))
|
||
|
|
(setq suf (replace-regexp-in-string "TAB" "C-i" suf t))
|
||
|
|
;; 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-match-p " " key)
|
||
|
|
(setq pre (replace-regexp-in-string " " "" pre))
|
||
|
|
(setq suf (replace-regexp-in-string " " "" suf)))
|
||
|
|
(concat (propertize pre 'face 'default)
|
||
|
|
(and (string-prefix-p (concat pre " ") key) " ")
|
||
|
|
(transient--colorize-key suf cmd)
|
||
|
|
(save-excursion
|
||
|
|
(when (string-match " +\\'" key)
|
||
|
|
(match-string 0 key))))))
|
||
|
|
((transient--lookup-key transient-sticky-map (kbd key))
|
||
|
|
(transient--colorize-key key cmd))
|
||
|
|
(t
|
||
|
|
(propertize key 'face 'transient-unreachable-key))))
|
||
|
|
(transient--colorize-key key cmd))))
|
||
|
|
|
||
|
|
(defun transient--colorize-key (key command)
|
||
|
|
(propertize key 'face
|
||
|
|
(or (and (transient--semantic-coloring-p)
|
||
|
|
(transient--suffix-color command))
|
||
|
|
'transient-key)))
|
||
|
|
|
||
|
|
(cl-defmethod transient-format-key :around ((obj transient-argument))
|
||
|
|
(let ((key (cl-call-next-method obj)))
|
||
|
|
(cond ((not transient-highlight-mismatched-keys))
|
||
|
|
((not (slot-boundp obj 'shortarg))
|
||
|
|
(add-face-text-property
|
||
|
|
0 (length key) 'transient-nonstandard-key nil key))
|
||
|
|
((not (string-equal key (oref obj shortarg)))
|
||
|
|
(add-face-text-property
|
||
|
|
0 (length key) 'transient-mismatched-key nil key)))
|
||
|
|
key))
|
||
|
|
|
||
|
|
(cl-defgeneric transient-format-description (obj)
|
||
|
|
"Format OBJ's `description' for display and return the result.")
|
||
|
|
|
||
|
|
(cl-defmethod transient-format-description ((obj transient-child))
|
||
|
|
"The `description' slot may be a function, in which case that is
|
||
|
|
called inside the correct buffer (see `transient-insert-group')
|
||
|
|
and its value is returned to the caller."
|
||
|
|
(when-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."
|
||
|
|
(when-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)
|
||
|
|
(propertize "(BUG: no description)" 'face 'error))))
|
||
|
|
(if (transient--key-unreachable-p obj)
|
||
|
|
(propertize desc 'face 'transient-unreachable)
|
||
|
|
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 ((value (oref obj value)))
|
||
|
|
(propertize (concat (oref obj argument)
|
||
|
|
(if (listp value)
|
||
|
|
(mapconcat #'identity value ",")
|
||
|
|
value))
|
||
|
|
'face (if value
|
||
|
|
'transient-value
|
||
|
|
'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)))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-format-value ((obj transient-files))
|
||
|
|
(let ((argument (oref obj argument)))
|
||
|
|
(if-let ((value (oref obj value)))
|
||
|
|
(propertize (concat argument " "
|
||
|
|
(mapconcat (lambda (f) (format "%S" f))
|
||
|
|
(oref obj value) " "))
|
||
|
|
'face 'transient-argument)
|
||
|
|
(propertize argument 'face 'transient-inactive-argument))))
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
;;; Help
|
||
|
|
|
||
|
|
(cl-defgeneric transient-show-help (obj)
|
||
|
|
"Show help for OBJ's command.")
|
||
|
|
|
||
|
|
(cl-defmethod transient-show-help ((obj transient-prefix))
|
||
|
|
"Show the info manual, manpage or command doc-string.
|
||
|
|
Show the first one that is specified."
|
||
|
|
(if-let ((manual (oref obj info-manual)))
|
||
|
|
(info manual)
|
||
|
|
(if-let ((manpage (oref obj man-page)))
|
||
|
|
(transient--show-manpage manpage)
|
||
|
|
(transient--describe-function (oref obj command)))))
|
||
|
|
|
||
|
|
(cl-defmethod transient-show-help ((_ transient-suffix))
|
||
|
|
"Show the command doc-string."
|
||
|
|
(if (eq this-original-command 'transient-help)
|
||
|
|
(if-let ((manpage (oref transient--prefix man-page)))
|
||
|
|
(transient--show-manpage manpage)
|
||
|
|
(transient--describe-function (oref transient--prefix command)))
|
||
|
|
(transient--describe-function this-original-command)))
|
||
|
|
|
||
|
|
(cl-defmethod transient-show-help ((obj transient-infix))
|
||
|
|
"Show the manpage if defined or the command doc-string.
|
||
|
|
If the manpage is specified, then try to jump to the correct
|
||
|
|
location."
|
||
|
|
(if-let ((manpage (oref transient--prefix man-page)))
|
||
|
|
(transient--show-manpage manpage (ignore-errors (oref obj argument)))
|
||
|
|
(transient--describe-function this-original-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--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--describe-function (fn)
|
||
|
|
(describe-function fn)
|
||
|
|
(select-window (get-buffer-window (help-buffer))))
|
||
|
|
|
||
|
|
(defun transient--goto-argument-description (arg)
|
||
|
|
(goto-char (point-min))
|
||
|
|
(let ((case-fold-search nil)
|
||
|
|
;; This matches preceding/proceeding options. Options
|
||
|
|
;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>"
|
||
|
|
;; are matched by this regex without the shy group.
|
||
|
|
;; The ". " in the shy group is for options such as
|
||
|
|
;; "-m parent-number", and the "-[^[:space:]]+ " is
|
||
|
|
;; for options such as "--mainline parent-number"
|
||
|
|
(others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
|
||
|
|
(when (re-search-forward
|
||
|
|
(if (equal arg "--")
|
||
|
|
;; Special case.
|
||
|
|
"^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)"
|
||
|
|
;; Should start with whitespace and may have
|
||
|
|
;; any number of options before and/or after.
|
||
|
|
(format
|
||
|
|
"^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
|
||
|
|
others
|
||
|
|
;; Options don't necessarily end in an "="
|
||
|
|
;; (e.g., "--gpg-sign[=<keyid>]")
|
||
|
|
(string-remove-suffix "=" arg)
|
||
|
|
;; Simple options don't end in an "=". Splitting this
|
||
|
|
;; into 2 cases should make getting false positives
|
||
|
|
;; less likely.
|
||
|
|
(if (string-suffix-p "=" arg)
|
||
|
|
;; "[^[:space:]]*[^.[:space:]]" matches the option
|
||
|
|
;; value, which is usually after the option name
|
||
|
|
;; and either '=' or '[='. The value can't end in
|
||
|
|
;; a period, as that means it's being used at the
|
||
|
|
;; end of a sentence. The space is for options
|
||
|
|
;; such as '--mainline parent-number'.
|
||
|
|
"\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
|
||
|
|
;; Either this doesn't match anything (e.g., "-a"),
|
||
|
|
;; or the option is followed by a value delimited
|
||
|
|
;; by a "[", "<", or ":". A space might appear
|
||
|
|
;; before this value, as in "-f <file>". The
|
||
|
|
;; space alternative is for options such as
|
||
|
|
;; "-m parent-number".
|
||
|
|
"\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
|
||
|
|
others))
|
||
|
|
nil t)
|
||
|
|
(goto-char (match-beginning 1)))))
|
||
|
|
|
||
|
|
(defun transient--insert-help ()
|
||
|
|
(unless (looking-back "\n\n" 2)
|
||
|
|
(insert "\n"))
|
||
|
|
(when transient--helpp
|
||
|
|
(insert
|
||
|
|
(format (propertize "\
|
||
|
|
Type a %s to show help for that suffix command, or %s to show manual.
|
||
|
|
Type %s to exit help.\n"
|
||
|
|
'face 'transient-heading)
|
||
|
|
(propertize "<KEY>" 'face 'transient-key)
|
||
|
|
(propertize "?" 'face 'transient-key)
|
||
|
|
(propertize "C-g" 'face 'transient-key))))
|
||
|
|
(when transient--editp
|
||
|
|
(unless transient--helpp
|
||
|
|
(insert
|
||
|
|
(format (propertize "\
|
||
|
|
Type a %s to set level for that suffix command.
|
||
|
|
Type %s to set what levels are available for this prefix command.\n"
|
||
|
|
'face 'transient-heading)
|
||
|
|
(propertize "<KEY>" 'face 'transient-key)
|
||
|
|
(propertize "C-x l" 'face 'transient-key))))
|
||
|
|
(with-slots (level) transient--prefix
|
||
|
|
(insert
|
||
|
|
(format (propertize "
|
||
|
|
Suffixes on levels %s are available.
|
||
|
|
Suffixes on levels %s and %s are unavailable.\n"
|
||
|
|
'face 'transient-heading)
|
||
|
|
(propertize (format "1-%s" level)
|
||
|
|
'face 'transient-enabled-suffix)
|
||
|
|
(propertize " 0 "
|
||
|
|
'face 'transient-disabled-suffix)
|
||
|
|
(propertize (format ">=%s" (1+ level))
|
||
|
|
'face 'transient-disabled-suffix))))))
|
||
|
|
|
||
|
|
(defvar transient-resume-mode-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map [remap Man-quit] 'transient-resume)
|
||
|
|
(define-key map [remap Info-exit] 'transient-resume)
|
||
|
|
(define-key map [remap quit-window] 'transient-resume)
|
||
|
|
map)
|
||
|
|
"Keymap for `transient-resume-mode'.
|
||
|
|
|
||
|
|
This keymap remaps every command that would usually just quit the
|
||
|
|
documentation buffer to `transient-resume', which additionally
|
||
|
|
resumes the suspended transient.")
|
||
|
|
|
||
|
|
(define-minor-mode transient-resume-mode
|
||
|
|
"Auxiliary minor-mode used to resume a transient after viewing help.")
|
||
|
|
|
||
|
|
;;; Compatibility
|
||
|
|
;;;; 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-button
|
||
|
|
'face nil
|
||
|
|
'action (lambda (button)
|
||
|
|
(let ((command (button-get button 'command)))
|
||
|
|
;; Yes, I know that this is wrong(tm).
|
||
|
|
;; Unfortunately it is also necessary.
|
||
|
|
(setq this-original-command command)
|
||
|
|
(call-interactively command))))
|
||
|
|
|
||
|
|
(defvar transient-popup-navigation-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map (kbd "<down-mouse-1>") 'transient-noop)
|
||
|
|
(define-key map (kbd "<mouse-1>") 'transient-mouse-push-button)
|
||
|
|
(define-key map (kbd "RET") 'transient-push-button)
|
||
|
|
(define-key map (kbd "<up>") 'transient-backward-button)
|
||
|
|
(define-key map (kbd "C-p") 'transient-backward-button)
|
||
|
|
(define-key map (kbd "<down>") 'transient-forward-button)
|
||
|
|
(define-key map (kbd "C-n") 'transient-forward-button)
|
||
|
|
(define-key map (kbd "C-r") 'transient-isearch-backward)
|
||
|
|
(define-key map (kbd "C-s") 'transient-isearch-forward)
|
||
|
|
map))
|
||
|
|
|
||
|
|
(defun transient-mouse-push-button (&optional pos)
|
||
|
|
"Invoke the suffix the user clicks on."
|
||
|
|
(interactive (list last-command-event))
|
||
|
|
(push-button pos))
|
||
|
|
|
||
|
|
(defun transient-push-button ()
|
||
|
|
"Invoke the selected suffix command."
|
||
|
|
(interactive)
|
||
|
|
(with-selected-window transient--window
|
||
|
|
(push-button)))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
(if (not command)
|
||
|
|
(forward-button 1)
|
||
|
|
(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))))
|
||
|
|
|
||
|
|
;;;; Popup Isearch
|
||
|
|
|
||
|
|
(defvar transient--isearch-mode-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map isearch-mode-map)
|
||
|
|
(define-key map [remap isearch-exit] 'transient-isearch-exit)
|
||
|
|
(define-key map [remap isearch-cancel] 'transient-isearch-cancel)
|
||
|
|
(define-key map [remap isearch-abort] 'transient-isearch-abort)
|
||
|
|
map))
|
||
|
|
|
||
|
|
(defun transient-isearch-backward (&optional regexp-p)
|
||
|
|
"Do incremental search backward.
|
||
|
|
With a prefix argument, do an incremental regular expression
|
||
|
|
search instead."
|
||
|
|
(interactive "P")
|
||
|
|
(transient--isearch-setup)
|
||
|
|
(let ((isearch-mode-map transient--isearch-mode-map))
|
||
|
|
(isearch-mode nil regexp-p)))
|
||
|
|
|
||
|
|
(defun transient-isearch-forward (&optional regexp-p)
|
||
|
|
"Do incremental search forward.
|
||
|
|
With a prefix argument, do an incremental regular expression
|
||
|
|
search instead."
|
||
|
|
(interactive "P")
|
||
|
|
(transient--isearch-setup)
|
||
|
|
(let ((isearch-mode-map transient--isearch-mode-map))
|
||
|
|
(isearch-mode t regexp-p)))
|
||
|
|
|
||
|
|
(defun transient-isearch-exit ()
|
||
|
|
"Like `isearch-exit' but adapted for `transient'."
|
||
|
|
(interactive)
|
||
|
|
(isearch-exit)
|
||
|
|
(transient--isearch-exit))
|
||
|
|
|
||
|
|
(defun transient-isearch-cancel ()
|
||
|
|
"Like `isearch-cancel' but adapted for `transient'."
|
||
|
|
(interactive)
|
||
|
|
(condition-case nil (isearch-cancel) (quit))
|
||
|
|
(transient--isearch-exit))
|
||
|
|
|
||
|
|
(defun transient-isearch-abort ()
|
||
|
|
"Like `isearch-abort' but adapted for `transient'."
|
||
|
|
(interactive)
|
||
|
|
(condition-case nil (isearch-abort) (quit))
|
||
|
|
(transient--isearch-exit))
|
||
|
|
|
||
|
|
(defun transient--isearch-setup ()
|
||
|
|
(select-window transient--window)
|
||
|
|
(transient--suspend-override))
|
||
|
|
|
||
|
|
(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-red disallow) 'transient-amaranth)
|
||
|
|
(`(transient-blue disallow) 'transient-teal)
|
||
|
|
(`(transient-red transient-red) 'transient-pink)
|
||
|
|
(`(transient-red transient-blue) 'transient-red)
|
||
|
|
(`(transient-blue transient-blue) 'transient-blue))))
|
||
|
|
|
||
|
|
;;;; Edebug
|
||
|
|
|
||
|
|
(defun transient--edebug--recursive-edit (fn arg-mode)
|
||
|
|
(transient--debug 'edebug--recursive-edit)
|
||
|
|
(if (not transient--prefix)
|
||
|
|
(funcall fn arg-mode)
|
||
|
|
(transient--suspend-override t)
|
||
|
|
(funcall fn arg-mode)
|
||
|
|
(transient--resume-override t)))
|
||
|
|
|
||
|
|
(advice-add 'edebug--recursive-edit :around 'transient--edebug--recursive-edit)
|
||
|
|
|
||
|
|
(defun transient--abort-edebug ()
|
||
|
|
(when (bound-and-true-p edebug-active)
|
||
|
|
(transient--emergency-exit)))
|
||
|
|
|
||
|
|
(advice-add 'abort-recursive-edit :before 'transient--abort-edebug)
|
||
|
|
(advice-add 'top-level :before 'transient--abort-edebug)
|
||
|
|
|
||
|
|
(defun transient--edebug-command-p ()
|
||
|
|
(and (bound-and-true-p edebug-active)
|
||
|
|
(or (memq this-command '(top-level abort-recursive-edit))
|
||
|
|
(string-prefix-p "edebug" (symbol-name this-command)))))
|
||
|
|
|
||
|
|
;;;; Miscellaneous
|
||
|
|
|
||
|
|
(declare-function which-key-mode "which-key" (&optional arg))
|
||
|
|
|
||
|
|
(defun transient--suspend-which-key-mode ()
|
||
|
|
(when (bound-and-true-p which-key-mode)
|
||
|
|
(which-key-mode -1)
|
||
|
|
(add-hook 'transient-exit-hook 'transient--resume-which-key-mode)))
|
||
|
|
|
||
|
|
(defun transient--resume-which-key-mode ()
|
||
|
|
(unless transient--prefix
|
||
|
|
(which-key-mode 1)
|
||
|
|
(remove-hook 'transient-exit-hook 'transient--resume-which-key-mode)))
|
||
|
|
|
||
|
|
(defun transient-bind-q-to-quit ()
|
||
|
|
"Modify some keymaps to bind \"q\" to the appropriate quit command.
|
||
|
|
|
||
|
|
\"C-g\" is the default binding for such commands now, but Transient's
|
||
|
|
predecessor Magit-Popup used \"q\" instead. If you would like to get
|
||
|
|
that binding back, then call this function in your init file like so:
|
||
|
|
|
||
|
|
(with-eval-after-load \\='transient
|
||
|
|
(transient-bind-q-to-quit))
|
||
|
|
|
||
|
|
Individual transients may already bind \"q\" to something else
|
||
|
|
and such a binding would shadow the quit binding. If that is the
|
||
|
|
case then \"Q\" is bound to whatever \"q\" would have been bound
|
||
|
|
to by setting `transient-substitute-key-function' to a function
|
||
|
|
that does that. Of course \"Q\" may already be bound to something
|
||
|
|
else, so that function binds \"M-q\" to that command instead.
|
||
|
|
Of course \"M-q\" may already be bound to something else, but
|
||
|
|
we stop there."
|
||
|
|
(define-key transient-base-map "q" 'transient-quit-one)
|
||
|
|
(define-key transient-sticky-map "q" 'transient-quit-seq)
|
||
|
|
(setq transient-substitute-key-function
|
||
|
|
'transient-rebind-quit-commands))
|
||
|
|
|
||
|
|
(defun transient-rebind-quit-commands (obj)
|
||
|
|
"See `transient-bind-q-to-quit'."
|
||
|
|
(let ((key (oref obj key)))
|
||
|
|
(cond ((string-equal key "q") "Q")
|
||
|
|
((string-equal key "Q") "M-q")
|
||
|
|
(t key))))
|
||
|
|
|
||
|
|
(defun transient--force-fixed-pitch ()
|
||
|
|
(require 'face-remap)
|
||
|
|
(face-remap-reset-base 'default)
|
||
|
|
(face-remap-add-relative 'default 'fixed-pitch))
|
||
|
|
|
||
|
|
;;;; Missing from Emacs
|
||
|
|
|
||
|
|
(defun transient--seq-reductions-from (function sequence initial-value)
|
||
|
|
(let ((acc (list initial-value)))
|
||
|
|
(seq-doseq (elt sequence)
|
||
|
|
(push (funcall function (car acc) elt) acc))
|
||
|
|
(nreverse acc)))
|
||
|
|
|
||
|
|
;;; Font-Lock
|
||
|
|
|
||
|
|
(defconst transient-font-lock-keywords
|
||
|
|
(eval-when-compile
|
||
|
|
`((,(concat "("
|
||
|
|
(regexp-opt (list "transient-define-prefix"
|
||
|
|
"transient-define-infix"
|
||
|
|
"transient-define-argument"
|
||
|
|
"transient-define-suffix")
|
||
|
|
t)
|
||
|
|
"\\_>[ \t'\(]*"
|
||
|
|
"\\(\\(?:\\sw\\|\\s_\\)+\\)?")
|
||
|
|
(1 'font-lock-keyword-face)
|
||
|
|
(2 'font-lock-function-name-face nil t)))))
|
||
|
|
|
||
|
|
(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords)
|
||
|
|
|
||
|
|
;;; Auxiliary Classes
|
||
|
|
;;;; `transient-lisp-variable'
|
||
|
|
|
||
|
|
(defclass transient-lisp-variable (transient-variable)
|
||
|
|
((reader :initform transient-lisp-variable--reader)
|
||
|
|
(always-read :initform t))
|
||
|
|
"[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)
|
||
|
|
(set (oref obj variable)
|
||
|
|
(oset obj value value)))
|
||
|
|
|
||
|
|
(cl-defmethod transient-format-description ((obj transient-lisp-variable))
|
||
|
|
(or (oref obj description)
|
||
|
|
(oref obj variable)))
|
||
|
|
|
||
|
|
(cl-defmethod transient-format-value ((obj transient-lisp-variable))
|
||
|
|
(propertize (prin1-to-string (oref obj value))
|
||
|
|
'face 'transient-value))
|
||
|
|
|
||
|
|
(cl-defmethod transient-prompt ((obj transient-lisp-variable))
|
||
|
|
(format "Set %s: " (oref obj variable)))
|
||
|
|
|
||
|
|
(defun transient-lisp-variable--reader (prompt initial-input _history)
|
||
|
|
(read--expression prompt initial-input))
|
||
|
|
|
||
|
|
;;; _
|
||
|
|
(provide 'transient)
|
||
|
|
;; Local Variables:
|
||
|
|
;; indent-tabs-mode: nil
|
||
|
|
;; End:
|
||
|
|
;;; transient.el ends here
|