kemonine/emacs
Archived
1
0
Fork 0
Code Activity
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/elpa/transient-20221028.1430/transient.el

4134 lines
160 KiB
EmacsLisp
Raw Normal View History

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