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