dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

embark.el (191551B)


      1 ;;; embark.el --- Conveniently act on minibuffer completions   -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2021-2023  Free Software Foundation, Inc.
      4 
      5 ;; Author: Omar Antolín Camarena <omar@matem.unam.mx>
      6 ;; Maintainer: Omar Antolín Camarena <omar@matem.unam.mx>
      7 ;; Keywords: convenience
      8 ;; Version: 1.0
      9 ;; Homepage: https://github.com/oantolin/embark
     10 ;; Package-Requires: ((emacs "27.1") (compat "29.1.4.0"))
     11 
     12 ;; This file is part of GNU Emacs.
     13 
     14 ;; This program is free software; you can redistribute it and/or modify
     15 ;; it under the terms of the GNU General Public License as published by
     16 ;; the Free Software Foundation, either version 3 of the License, or
     17 ;; (at your option) any later version.
     18 
     19 ;; This program is distributed in the hope that it will be useful,
     20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     22 ;; GNU General Public License for more details.
     23 
     24 ;; You should have received a copy of the GNU General Public License
     25 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     26 
     27 ;;; Commentary:
     28 
     29 ;; This package provides a sort of right-click contextual menu for
     30 ;; Emacs, accessed through the `embark-act' command (which you should
     31 ;; bind to a convenient key), offering you relevant actions to use on
     32 ;; a target determined by the context:
     33 
     34 ;; - In the minibuffer, the target is the current best completion
     35 ;;  candidate.
     36 ;; - In the `*Completions*' buffer the target is the completion at point.
     37 ;; - In a regular buffer, the target is the region if active, or else the
     38 ;;  file, symbol or url at point.
     39 
     40 ;; The type of actions offered depend on the type of the target:
     41 
     42 ;; - For files you get offered actions like deleting, copying,
     43 ;;  renaming, visiting in another window, running a shell command on the
     44 ;;  file, etc.
     45 ;; - For buffers the actions include switching to or killing the buffer.
     46 ;; - For package names the actions include installing, removing or
     47 ;;  visiting the homepage.
     48 
     49 ;; Everything is easily configurable: determining the current target,
     50 ;; classifying it, and deciding with actions are offered for each type
     51 ;; in the classification.  The above introduction just mentions part of
     52 ;; the default configuration.
     53 
     54 ;; Configuring which actions are offered for a type is particularly
     55 ;; easy and requires no programming: the `embark-keymap-alist'
     56 ;; variable associates target types with variable containing keymaps,
     57 ;; and those keymaps containing binds for the actions.  For example,
     58 ;; in the default configuration the type `file' is associated with the
     59 ;; symbol `embark-file-map'.  That symbol names a keymap with
     60 ;; single-letter key bindings for common Emacs file commands, for
     61 ;; instance `c' is bound to `copy-file'.  This means that if while you
     62 ;; are in the minibuffer after running a command that prompts for a
     63 ;; file, such as `find-file' or `rename-file', you can copy a file by
     64 ;; running `embark-act' and then pressing `c'.
     65 
     66 ;; These action keymaps are very convenient but not strictly necessary
     67 ;; when using `embark-act': you can use any command that reads from the
     68 ;; minibuffer as an action and the target of the action will be inserted
     69 ;; at the first minibuffer prompt.  After running `embark-act' all of your
     70 ;; key bindings and even `execute-extended-command' can be used to run a
     71 ;; command.  The action keymaps are normal Emacs keymaps and you should
     72 ;; feel free to bind in them whatever commands you find useful as actions.
     73 
     74 ;; The actions in `embark-general-map' are available no matter what
     75 ;; type of completion you are in the middle of.  By default this
     76 ;; includes bindings to save the current candidate in the kill ring
     77 ;; and to insert the current candidate in the previously selected
     78 ;; buffer (the buffer that was current when you executed a command
     79 ;; that opened up the minibuffer).
     80 
     81 ;; You can read about the Embark GitHub project wiki:
     82 ;; https://github.com/oantolin/embark/wiki/Default-Actions
     83 
     84 ;; Besides acting individually on targets, Embark lets you work
     85 ;; collectively on a set of target candidates.  For example, while
     86 ;; you are in the minibuffer the candidates are simply the possible
     87 ;; completions of your input.  Embark provides three commands to work
     88 ;; on candidate sets:
     89 
     90 ;; - The `embark-act-all' command runs the same action on each of the
     91 ;;   current candidates.  It is just like using `embark-act' on each
     92 ;;   candidate in turn.
     93 
     94 ;; - The `embark-collect' command produces a buffer listing all
     95 ;;   candidates, for you to peruse and run actions on at your leisure.
     96 ;;   The candidates are displayed as a list showing additional
     97 ;;   annotations.
     98 
     99 ;; - The `embark-export' command tries to open a buffer in an
    100 ;;   appropriate major mode for the set of candidates.  If the
    101 ;;   candidates are files export produces a Dired buffer; if they are
    102 ;;   buffers, you get an Ibuffer buffer; and if they are packages you
    103 ;;   get a buffer in package menu mode.
    104 
    105 ;; These are always available as "actions" (although they do not act
    106 ;; on just the current target but on all candidates) for embark-act
    107 ;; and are bound to A, S (for "snapshot") and E, respectively, in
    108 ;; embark-general-map.  This means that you do not have to bind your
    109 ;; own key bindings for these (although you can, of course), just a
    110 ;; key binding for `embark-act'.
    111 
    112 ;;; Code:
    113 
    114 (require 'compat)
    115 (eval-when-compile (require 'subr-x))
    116 
    117 (require 'ffap) ; used to recognize file and url targets
    118 
    119 ;;; User facing options
    120 
    121 (defgroup embark nil
    122   "Emacs Mini-Buffer Actions Rooted in Keymaps."
    123   :link '(info-link :tag "Info Manual" "(embark)")
    124   :link '(url-link :tag "Homepage" "https://github.com/oantolin/embark")
    125   :link '(emacs-library-link :tag "Library Source" "embark.el")
    126   :group 'minibuffer
    127   :prefix "embark-")
    128 
    129 (defcustom embark-keymap-alist
    130   '((file embark-file-map)
    131     (library embark-library-map)
    132     (environment-variables embark-file-map) ; they come up in file completion
    133     (url embark-url-map)
    134     (email embark-email-map)
    135     (buffer embark-buffer-map)
    136     (tab embark-tab-map)
    137     (expression embark-expression-map)
    138     (identifier embark-identifier-map)
    139     (defun embark-defun-map)
    140     (symbol embark-symbol-map)
    141     (face embark-face-map)
    142     (command embark-command-map)
    143     (variable embark-variable-map)
    144     (function embark-function-map)
    145     (minor-mode embark-command-map)
    146     (unicode-name embark-unicode-name-map)
    147     (package embark-package-map)
    148     (bookmark embark-bookmark-map)
    149     (region embark-region-map)
    150     (sentence embark-sentence-map)
    151     (paragraph embark-paragraph-map)
    152     (kill-ring embark-kill-ring-map)
    153     (heading embark-heading-map)
    154     (flymake embark-flymake-map)
    155     (smerge smerge-basic-map embark-general-map)
    156     (t embark-general-map))
    157   "Alist of action types and corresponding keymaps.
    158 The special key t is associated with the default keymap to use.
    159 Each value can be either a single symbol whose value is a keymap,
    160 or a list of such symbols."
    161   :type '(alist :key-type (symbol :tag "Target type")
    162                 :value-type (choice (variable :tag "Keymap")
    163                              (repeat :tag "Keymaps" variable))))
    164 
    165 (defcustom embark-target-finders
    166   '(embark-target-top-minibuffer-candidate
    167     embark-target-active-region
    168     embark-target-collect-candidate
    169     embark-target-completion-list-candidate
    170     embark-target-text-heading-at-point
    171     embark-target-bug-reference-at-point
    172     embark-target-flymake-at-point
    173     embark-target-smerge-at-point
    174     embark-target-package-at-point
    175     embark-target-email-at-point
    176     embark-target-url-at-point
    177     embark-target-file-at-point
    178     embark-target-custom-variable-at-point
    179     embark-target-identifier-at-point
    180     embark-target-guess-file-at-point
    181     embark-target-expression-at-point
    182     embark-target-sentence-at-point
    183     embark-target-paragraph-at-point
    184     embark-target-defun-at-point
    185     embark-target-prog-heading-at-point)
    186   "List of functions to determine the target in current context.
    187 Each function should take no arguments and return one of:
    188 
    189 1. a cons (TYPE . TARGET) where TARGET is a string and TYPE is a
    190    symbol (which is looked up in `embark-keymap-alist' to
    191    determine which additional keybindings for actions to setup);
    192 
    193 2. a dotted list of the form (TYPE TARGET START . END), where
    194    START and END are the buffer positions bounding TARGET, used
    195    for highlighting; or
    196 
    197 3. a possibly empty list of targets, each of type 1 or 2 (in
    198    particular if a target finder does not find any targets, it
    199    should return nil)."
    200   :type 'hook)
    201 
    202 (defcustom embark-transformer-alist
    203   '((minor-mode . embark--lookup-lighter-minor-mode)
    204     (embark-keybinding . embark--keybinding-command)
    205     (project-file . embark--project-file-full-path)
    206     (package . embark--remove-package-version)
    207     (multi-category . embark--refine-multi-category)
    208     (file . embark--simplify-path))
    209   "Alist associating type to functions for transforming targets.
    210 Each function should take a type and a target string and return a
    211 pair of the form a `cons' of the new type and the new target."
    212   :type '(alist :key-type symbol :value-type function))
    213 
    214 (defcustom embark-become-keymaps
    215   '(embark-become-help-map
    216     embark-become-file+buffer-map
    217     embark-become-shell-command-map
    218     embark-become-match-map)
    219   "List of keymaps for `embark-become'.
    220 Each keymap groups a set of related commands that can
    221 conveniently become one another."
    222   :type '(repeat variable))
    223 
    224 (defcustom embark-prompter 'embark-keymap-prompter
    225   "Function used to prompt the user for actions.
    226 This should be set to a function that prompts the use for an
    227 action and returns the symbol naming the action command.  The
    228 default value, `embark-keymap-prompter' activates the type
    229 specific action keymap given in `embark-keymap-alist'.
    230 There is also `embark-completing-read-prompter' which
    231 prompts for an action with completion."
    232   :type '(choice (const :tag "Use action keymaps" embark-keymap-prompter)
    233                  (const :tag "Read action with completion"
    234                         embark-completing-read-prompter)
    235                  (function :tag "Other")))
    236 
    237 (defcustom embark-keymap-prompter-key "@"
    238   "Key to switch to the keymap prompter from `embark-completing-read-prompter'.
    239 
    240 The key must be either nil or a string.  The
    241 string must be accepted by `key-valid-p'."
    242   :type '(choice key (const :tag "None" nil)))
    243 
    244 (defcustom embark-cycle-key nil
    245   "Key used for `embark-cycle'.
    246 
    247 If the key is set to nil it defaults to the global binding of
    248 `embark-act'.  The key must be a string which is accepted by
    249 `key-valid-p'."
    250   :type '(choice key (const :tag "Use embark-act key" nil)))
    251 
    252 (defcustom embark-help-key "C-h"
    253   "Key used for help.
    254 
    255 The key must be either nil or a string.  The
    256 string must be accepted by `key-valid-p'."
    257   :type '(choice (const "C-h")
    258                  (const "?")
    259                  (const :tag "None" nil)
    260                  key))
    261 
    262 (defcustom embark-keybinding-repeat
    263   (propertize "*" 'face 'embark-keybinding-repeat)
    264   "Indicator string for repeatable keybindings.
    265 Keybindings are formatted by the `completing-read' prompter and
    266 the verbose indicator."
    267   :type 'string)
    268 
    269 (defface embark-keybinding-repeat
    270   '((t :inherit font-lock-builtin-face))
    271   "Face used to indicate keybindings as repeatable.")
    272 
    273 (defface embark-keybinding '((t :inherit success))
    274   "Face used to display key bindings.
    275 Used by `embark-completing-read-prompter' and `embark-keymap-help'.")
    276 
    277 (defface embark-keymap '((t :slant italic))
    278   "Face used to display keymaps.
    279 Used by `embark-completing-read-prompter' and `embark-keymap-help'.")
    280 
    281 (defface embark-target '((t :inherit highlight))
    282   "Face used to highlight the target at point during `embark-act'.")
    283 
    284 (defcustom embark-quit-after-action t
    285   "Should `embark-act' quit the minibuffer?
    286 This controls whether calling `embark-act' without a prefix
    287 argument quits the minibuffer or not.  You can always get the
    288 opposite behavior to that indicated by this variable by calling
    289 `embark-act' with \\[universal-argument].
    290 
    291 Note that `embark-act' can also be called from outside the
    292 minibuffer and this variable is irrelevant in that case.
    293 
    294 In addition to t or nil this variable can also be set to an
    295 alist to specify the minibuffer quitting behavior per command.
    296 In the alist case one can additionally use the key t to
    297 prescribe a default for commands not used as alist keys."
    298   :type '(choice (const :tag "Always quit" t)
    299                  (const :tag "Never quit" nil)
    300                  (alist :tag "Configure per action"
    301                         :key-type (choice (function :tag "Action")
    302                                           (const :tag "All other actions" t))
    303                         :value-type (choice (const :tag "Quit" t)
    304                                             (const :tag "Do not quit" nil)))))
    305 
    306 (defcustom embark-confirm-act-all t
    307   "Should `embark-act-all' prompt the user for confirmation?
    308 Even if this variable is nil you may still be prompted to confirm
    309 some uses of `embark-act-all', namely, for those actions whose
    310 entry in `embark-pre-action-hooks' includes `embark--confirm'."
    311   :type 'boolean)
    312 
    313 (defcustom embark-default-action-overrides nil
    314   "Alist associating target types with overriding default actions.
    315 When the source of a target is minibuffer completion, the default
    316 action for it is usually the command that opened the minibuffer
    317 in the first place but this can be overridden for a given type by
    318 an entry in this list.
    319 
    320 For example, if you run `delete-file' the default action for its
    321 completion candidates is `delete-file' itself.  You may prefer to
    322 make `find-file' the default action for all files, even if they
    323 were obtained from a `delete-file' prompt.  In that case you can
    324 configure that by adding an entry to this variable pairing `file'
    325 with `find-file'.
    326 
    327 In addition to target types, you can also use as keys in this alist,
    328 pairs of a target type and a command name.  Such a pair indicates that
    329 the override only applies if the target was obtained from minibuffer
    330 completion from that command.  For example adding an
    331 entry (cons (cons \\='file \\='delete-file) \\='find-file) to this alist would
    332 indicate that for files at the prompt of the `delete-file' command,
    333 `find-file' should be used as the default action."
    334   :type '(alist :key-type (choice (symbol :tag "Type")
    335                                   (cons (symbol :tag "Type")
    336                                         (symbol :tag "Command")))
    337                 :value-type (function :tag "Default action")))
    338 
    339 (defcustom embark-target-injection-hooks
    340   '((async-shell-command embark--allow-edit embark--shell-prep)
    341     (shell-command embark--allow-edit embark--shell-prep)
    342     (pp-eval-expression embark--eval-prep)
    343     (eval-expression embark--eval-prep)
    344     (package-delete embark--force-complete)
    345     ;; commands evaluating code found in the buffer, which may in turn prompt
    346     (embark-pp-eval-defun embark--ignore-target)
    347     (eval-defun embark--ignore-target)
    348     (eval-last-sexp embark--ignore-target)
    349     (embark-eval-replace embark--ignore-target)
    350     ;; commands which prompt for something that is *not* the target
    351     (write-region embark--ignore-target)
    352     (append-to-file embark--ignore-target)
    353     (append-to-buffer embark--ignore-target)
    354     (shell-command-on-region embark--ignore-target)
    355     (format-encode-region embark--ignore-target)
    356     (format-decode-region embark--ignore-target)
    357     (xref-find-definitions embark--ignore-target)
    358     (xref-find-references embark--ignore-target)
    359     (sort-regexp-fields embark--ignore-target)
    360     (align-regexp embark--ignore-target))
    361   "Alist associating commands with post-injection setup hooks.
    362 For commands appearing as keys in this alist, run the
    363 corresponding value as a setup hook after injecting the target
    364 into in the minibuffer and before acting on it.  The hooks must
    365 accept arbitrary keyword arguments.  The :action command, the
    366 :target string and target :type are always present.  For actions
    367 at point the target :bounds are passed too.  The default pre-action
    368 hook is specified by the entry with key t.  Furthermore, hooks with
    369 the key :always are executed always."
    370   :type '(alist :key-type
    371                 (choice symbol
    372                         (const :tag "Default" t)
    373                         (const :tag "Always" :always))
    374                 :value-type hook))
    375 
    376 (defcustom embark-pre-action-hooks
    377   `(;; commands that need to position point at the beginning or end
    378     (eval-last-sexp embark--end-of-target)
    379     (indent-pp-sexp embark--beginning-of-target)
    380     (backward-up-list embark--beginning-of-target)
    381     (backward-list embark--beginning-of-target)
    382     (forward-list embark--end-of-target)
    383     (forward-sexp embark--end-of-target)
    384     (backward-sexp embark--beginning-of-target)
    385     (raise-sexp embark--beginning-of-target)
    386     (kill-sexp embark--beginning-of-target)
    387     (mark-sexp embark--beginning-of-target)
    388     (transpose-sexps embark--end-of-target)
    389     (transpose-sentences embark--end-of-target)
    390     (transpose-paragraphs embark--end-of-target)
    391     (forward-sentence embark--end-of-target)
    392     (backward-sentence embark--beginning-of-target)
    393     (backward-paragraph embark--beginning-of-target)
    394     (embark-insert embark--end-of-target)
    395     ;; commands we want to be able to jump back from
    396     ;; (embark-find-definition achieves this by calling
    397     ;; xref-find-definitions which pushes the markers itself)
    398     (find-library embark--xref-push-marker)
    399     ;; commands which prompt the user for confirmation before running
    400     (delete-file embark--confirm)
    401     (delete-directory embark--confirm)
    402     (kill-buffer embark--confirm)
    403     (embark-kill-buffer-and-window embark--confirm)
    404     (bookmark-delete embark--confirm)
    405     (package-delete embark--confirm)
    406     (,'tab-bar-close-tab-by-name embark--confirm) ;; Avoid package-lint warning
    407     ;; search for region contents outside said region
    408     (embark-isearch-forward embark--unmark-target)
    409     (embark-isearch-backward embark--unmark-target)
    410     (occur embark--unmark-target)
    411     (query-replace embark--beginning-of-target embark--unmark-target)
    412     (query-replace-regexp embark--beginning-of-target embark--unmark-target)
    413     (replace-string embark--beginning-of-target embark--unmark-target)
    414     (replace-regexp embark--beginning-of-target embark--unmark-target)
    415     ;; mark pseudo-action
    416     (mark embark--mark-target)
    417     ;; shells in new buffers
    418     (shell embark--universal-argument)
    419     (eshell embark--universal-argument))
    420   "Alist associating commands with pre-action hooks.
    421 The hooks are run right before an action is embarked upon.  See
    422 `embark-target-injection-hooks' for information about the hook
    423 arguments and more details."
    424   :type '(alist :key-type
    425                 (choice symbol
    426                         (const :tag "Default" t)
    427                         (const :tag "Always" :always))
    428                 :value-type hook))
    429 
    430 (defcustom embark-post-action-hooks
    431   `((bookmark-delete embark--restart)
    432     (bookmark-rename embark--restart)
    433     (delete-file embark--restart)
    434     (embark-kill-ring-remove embark--restart)
    435     (embark-recentf-remove embark--restart)
    436     (embark-history-remove embark--restart)
    437     (rename-file embark--restart)
    438     (copy-file embark--restart)
    439     (delete-directory embark--restart)
    440     (make-directory embark--restart)
    441     (kill-buffer embark--restart)
    442     (embark-rename-buffer embark--restart)
    443     (,'tab-bar-rename-tab-by-name embark--restart) ;; Avoid package-lint warning
    444     (,'tab-bar-close-tab-by-name embark--restart)
    445     (package-delete embark--restart))
    446   "Alist associating commands with post-action hooks.
    447 The hooks are run after an embarked upon action concludes.  See
    448 `embark-target-injection-hooks' for information about the hook
    449 arguments and more details."
    450   :type '(alist :key-type
    451                 (choice symbol
    452                         (const :tag "Default" t)
    453                         (const :tag "Always" :always))
    454                 :value-type hook))
    455 
    456 (defcustom embark-around-action-hooks
    457   '(;; use directory of target as default-directory
    458     (shell embark--cd)
    459     (eshell embark--cd)
    460     ;; mark the target preserving point and previous mark
    461     (kill-region embark--mark-target)
    462     (kill-ring-save embark--mark-target)
    463     (indent-region embark--mark-target)
    464     (ispell-region embark--mark-target)
    465     (fill-region embark--mark-target)
    466     (upcase-region embark--mark-target)
    467     (downcase-region embark--mark-target)
    468     (capitalize-region embark--mark-target)
    469     (count-words-region embark--mark-target)
    470     (count-words embark--mark-target)
    471     (delete-duplicate-lines embark--mark-target)
    472     (shell-command-on-region embark--mark-target)
    473     (delete-region embark--mark-target)
    474     (format-encode-region embark--mark-target)
    475     (format-decode-region embark--mark-target)
    476     (write-region embark--mark-target)
    477     (append-to-file embark--mark-target)
    478     (append-to-buffer embark--mark-target)
    479     (shell-command-on-region embark--mark-target)
    480     (embark-eval-replace embark--mark-target)
    481     (delete-indentation embark--mark-target)
    482     (comment-dwim embark--mark-target)
    483     (insert-parentheses embark--mark-target)
    484     (insert-pair embark--mark-target)
    485     (org-emphasize embark--mark-target)
    486     ;; do the actual work of selecting & deselecting targets
    487     (embark-select embark--select))
    488   "Alist associating commands with post-action hooks.
    489 The hooks are run instead of the embarked upon action.  The hook
    490 can decide whether or not to run the action or it can run it
    491 in some special environment, like inside a let-binding or inside
    492 `save-excursion'.  Each hook is called with keyword argument :run
    493 providing a function encapsulating the following around hooks and
    494 the action; the hook additionally receives the keyword arguments
    495 used for other types of action hooks, for more details see
    496 `embark-target-injection-hooks'."
    497   :type '(alist :key-type
    498                 (choice symbol
    499                         (const :tag "Default" t)
    500                         (const :tag "Always" :always))
    501                 :value-type hook))
    502 
    503 (when (version-list-< (version-to-list emacs-version) '(29 1))
    504   ;; narrow to target for duration of action
    505   (setf (alist-get 'repunctuate-sentences embark-around-action-hooks)
    506         '(embark--narrow-to-target)))
    507 
    508 (defcustom embark-multitarget-actions '(embark-insert embark-copy-as-kill)
    509   "Commands for which `embark-act-all' should pass a list of targets.
    510 Normally `embark-act-all' runs the same action on each candidate
    511 separately, but when a command included in this variable's value
    512 is used as an action, `embark-act-all' will instead call it
    513 non-interactively with a single argument: the list of all
    514 candidates.  For commands on this list `embark-act' behaves
    515 similarly: it calls them non-interactively with a single
    516 argument: a one element list containing the target."
    517   :type '(repeat function))
    518 
    519 (defcustom embark-repeat-actions
    520   '((mark . region)
    521     ;; outline commands
    522     outline-next-visible-heading outline-previous-visible-heading
    523     outline-forward-same-level outline-backward-same-level
    524     outline-demote outline-promote
    525     outline-show-subtree (outline-mark-subtree . region)
    526     outline-move-subtree-up outline-move-subtree-down
    527     outline-up-heading outline-hide-subtree outline-cycle
    528     ;; org commands (remapped outline commands)
    529     org-forward-heading-same-level org-backward-heading-same-level
    530     org-next-visible-heading org-previous-visible-heading
    531     org-demote-subtree org-promote-subtree
    532     org-show-subtree (org-mark-subtree . region)
    533     org-move-subtree-up org-move-subtree-down
    534     ;; transpose commands
    535     transpose-sexps transpose-sentences transpose-paragraphs
    536     ;; navigation commands
    537     flymake-goto-next-error flymake-goto-prev-error
    538     embark-next-symbol embark-previous-symbol
    539     backward-up-list backward-list forward-list forward-sexp
    540     backward-sexp forward-sentence backward-sentence
    541     forward-paragraph backward-paragraph
    542     ;; smerge commands
    543     smerge-refine smerge-combine-with-next smerge-prev smerge-next)
    544   "List of repeatable actions.
    545 When you use a command on this list as an Embark action from
    546 outside the minibuffer, `embark-act' does not exit but instead
    547 lets you act again on the possibly new target you reach.
    548 
    549 By default, after using one of these actions, when `embark-act'
    550 looks for targets again, it will start the target cycle at the
    551 same type as the previously acted upon target; that is, you
    552 \"don't loose your place in the target cycle\".
    553 
    554 Sometimes, however, you'll want to prioritize a different type of
    555 target to continue acting on.  The main example of this that if
    556 you use a marking command as an action, you almost always want to
    557 act on the region next.  For those cases, in addition to
    558 commands, you can also place on this list a pair of a command and
    559 the desired starting type for the target cycle for the next
    560 action."
    561   :type '(repeat (choice function
    562                          (cons function
    563                                (symbol :tag "Next target type")))))
    564 
    565 ;;; Overlay properties
    566 
    567 ;; high priority to override both bug reference and the lazy
    568 ;; isearch highlights in embark-isearch-highlight-indicator
    569 (put 'embark-target-overlay 'face 'embark-target)
    570 (put 'embark-target-overlay 'priority 1001)
    571 (put 'embark-selected-overlay 'face 'embark-selected)
    572 (put 'embark-selected-overlay 'priority 1001)
    573 
    574 ;;; Stashing information for actions in buffer local variables
    575 
    576 (defvar-local embark--type nil
    577   "Cache for the completion type, meant to be set buffer-locally.")
    578 
    579 (defvar-local embark--target-buffer nil
    580   "Cache for the previous buffer, meant to be set buffer-locally.")
    581 
    582 (defvar-local embark--target-window nil
    583   "Cache for the previous window, meant to be set buffer-locally.
    584 Since windows can be reused to display different buffers, this
    585 window should only be used if it displays the buffer stored in
    586 the variable `embark--target-buffer'.")
    587 
    588 (defvar-local embark--command nil
    589   "Command that started the completion session.")
    590 
    591 (defvar-local embark--toggle-quit nil
    592   "Should we toggle the default quitting behavior for the next action?")
    593 
    594 (defun embark--minibuffer-point ()
    595   "Return length of minibuffer contents."
    596   (max 0 (- (point) (minibuffer-prompt-end))))
    597 
    598 (defun embark--default-directory ()
    599   "Guess a reasonable default directory for the current candidates."
    600   (if (and (minibufferp) minibuffer-completing-file-name)
    601       (let ((end (minibuffer-prompt-end))
    602             (contents (minibuffer-contents)))
    603         (expand-file-name
    604          (substitute-in-file-name
    605           (buffer-substring
    606            end
    607            (+ end
    608               (or (cdr
    609                    (last
    610                     (completion-all-completions
    611                      contents
    612                      minibuffer-completion-table
    613                      minibuffer-completion-predicate
    614                      (embark--minibuffer-point))))
    615                   (cl-position ?/ contents :from-end t)
    616                   0))))))
    617     default-directory))
    618 
    619 (defun embark--target-buffer ()
    620   "Return buffer that should be targeted by Embark actions."
    621   (cond
    622    ((and (minibufferp) minibuffer-completion-table (minibuffer-selected-window))
    623     (window-buffer (minibuffer-selected-window)))
    624    ((and embark--target-buffer (buffer-live-p embark--target-buffer))
    625     embark--target-buffer)
    626    (t (current-buffer))))
    627 
    628 (defun embark--target-window (&optional display)
    629   "Return window which should be selected when Embark actions run.
    630 If DISPLAY is non-nil, call `display-buffer' to produce the
    631 window if necessary."
    632   (cond
    633    ((and (minibufferp) minibuffer-completion-table (minibuffer-selected-window))
    634     (minibuffer-selected-window))
    635    ((and embark--target-window
    636          (window-live-p embark--target-window)
    637          (or (not (buffer-live-p embark--target-buffer))
    638              (eq (window-buffer embark--target-window) embark--target-buffer)))
    639     embark--target-window)
    640    ((and embark--target-buffer (buffer-live-p embark--target-buffer))
    641     (or (get-buffer-window embark--target-buffer)
    642         (when display (display-buffer embark--target-buffer))))
    643    (display (selected-window))))
    644 
    645 (defun embark--cache-info (buffer)
    646   "Cache information needed for actions in variables local to BUFFER.
    647 BUFFER defaults to the current buffer."
    648   (let ((cmd embark--command)
    649         (dir (embark--default-directory))
    650         (target-buffer (embark--target-buffer))
    651         (target-window (embark--target-window)))
    652     (with-current-buffer buffer
    653       (setq embark--command cmd
    654             default-directory dir
    655             embark--target-buffer target-buffer
    656             embark--target-window target-window))))
    657 
    658 (defun embark--cache-info--completion-list ()
    659   "Cache information needed for actions in a *Completions* buffer.
    660 Meant to be be added to `completion-setup-hook'."
    661   ;; when completion-setup-hook hook runs, the *Completions* buffer is
    662   ;; available in the variable standard-output
    663   (embark--cache-info standard-output)
    664   (with-current-buffer standard-output
    665     (when (minibufferp completion-reference-buffer)
    666       (setq embark--type
    667             (completion-metadata-get
    668              (with-current-buffer completion-reference-buffer
    669                (embark--metadata))
    670              'category)))))
    671 
    672 ;; We have to add this *after* completion-setup-function because that's
    673 ;; when the buffer is put in completion-list-mode and turning the mode
    674 ;; on kills all local variables! So we use a depth of 5.
    675 (add-hook 'completion-setup-hook #'embark--cache-info--completion-list 5)
    676 
    677 ;;;###autoload
    678 (progn
    679   (defun embark--record-this-command ()
    680     "Record command which opened the minibuffer.
    681 We record this because it will be the default action.
    682 This function is meant to be added to `minibuffer-setup-hook'."
    683     (setq-local embark--command this-command))
    684   (add-hook 'minibuffer-setup-hook #'embark--record-this-command))
    685 
    686 ;;; Internal variables
    687 
    688 (defvar embark--prompter-history nil
    689   "History used by the `embark-completing-read-prompter'.")
    690 
    691 ;;; Core functionality
    692 
    693 (defconst embark--verbose-indicator-buffer " *Embark Actions*")
    694 
    695 (defvar embark--minimal-indicator-overlay nil)
    696 
    697 (defun embark--metadata ()
    698   "Return current minibuffer completion metadata."
    699   (completion-metadata
    700    (buffer-substring-no-properties
    701     (minibuffer-prompt-end)
    702     (max (minibuffer-prompt-end) (point)))
    703    minibuffer-completion-table
    704    minibuffer-completion-predicate))
    705 
    706 (defun embark-target-active-region ()
    707   "Target the region if active."
    708   (when (use-region-p)
    709     (let ((start (region-beginning))
    710           (end (region-end)))
    711       `(region ,(buffer-substring start end) . (,start . ,end)))))
    712 
    713 (autoload 'dired-get-filename "dired")
    714 (declare-function image-dired-original-file-name "image-dired")
    715 
    716 (defun embark-target-guess-file-at-point ()
    717   "Target the file guessed by `ffap' at point."
    718   (when-let ((tap-file (thing-at-point 'filename))
    719              ((not (ffap-url-p tap-file))) ; no URLs, those have a target finder
    720              (bounds (bounds-of-thing-at-point 'filename))
    721              (file (ffap-file-at-point)))
    722     ;; ffap doesn't make bounds available, so we use
    723     ;; thingatpt bounds, which might be a little off
    724     ;; adjust bounds if thingatpt gobbled punctuation around file
    725     (when (or (string-match (regexp-quote file) tap-file)
    726               (string-match (regexp-quote (file-name-base file)) tap-file))
    727       (setq bounds (cons (+ (car bounds) (match-beginning 0))
    728                          (- (cdr bounds) (- (length tap-file)
    729                                             (match-end 0))))))
    730     `(file ,(abbreviate-file-name (expand-file-name file)) ,@bounds)))
    731 
    732 (defun embark-target-file-at-point ()
    733   "Target file at point.
    734 This function mostly relies on `ffap-file-at-point', with the
    735 following exceptions:
    736 
    737 - In `dired-mode', it uses `dired-get-filename' instead.
    738 
    739 - In `imaged-dired-thumbnail-mode', it uses
    740   `image-dired-original-file-name' instead."
    741   (let (file bounds)
    742     (or (and (derived-mode-p 'dired-mode)
    743              (setq file (dired-get-filename t 'no-error-if-not-filep))
    744              (setq bounds
    745                    (cons
    746                     (save-excursion (dired-move-to-filename) (point))
    747                     (save-excursion (dired-move-to-end-of-filename) (point)))))
    748         (and (derived-mode-p 'image-dired-thumbnail-mode)
    749              (setq file (image-dired-original-file-name))
    750              (setq bounds (cons (point) (1+ (point)))))
    751         (when-let ((tap-file (thing-at-point 'filename))
    752                    ((not (equal (file-name-base tap-file) tap-file)))
    753                    (guess (embark-target-guess-file-at-point)))
    754           (setq file (cadr guess) bounds (cddr guess))))
    755     (when file
    756       `(file ,(abbreviate-file-name (expand-file-name file)) ,@bounds))))
    757 
    758 (defun embark-target-package-at-point ()
    759   "Target the package on the current line in a packages buffer."
    760   (when (derived-mode-p 'package-menu-mode)
    761     (when-let ((pkg (get-text-property (point) 'tabulated-list-id)))
    762       `(package ,(symbol-name (package-desc-name pkg))
    763                 ,(line-beginning-position) . ,(line-end-position)))))
    764 
    765 (defun embark-target-email-at-point ()
    766   "Target the email address at point."
    767   (when-let ((email (thing-at-point 'email)))
    768     (when (string-prefix-p "mailto:" email)
    769       (setq email (string-remove-prefix "mailto:" email)))
    770     `(email ,email . ,(bounds-of-thing-at-point 'email))))
    771 
    772 (defun embark-target-url-at-point ()
    773   "Target the URL at point."
    774   (if-let ((url (or (get-text-property (point) 'shr-url)
    775                     (get-text-property (point) 'image-url))))
    776       `(url ,url
    777             ,(previous-single-property-change
    778               (min (1+ (point)) (point-max)) 'mouse-face nil (point-min))
    779             . ,(next-single-property-change
    780                 (point) 'mouse-face nil (point-max)))
    781     (when-let ((url (thing-at-point 'url)))
    782       `(url ,url . ,(thing-at-point-bounds-of-url-at-point t)))))
    783 
    784 (declare-function widget-at "wid-edit")
    785 
    786 (defun embark-target-custom-variable-at-point ()
    787   "Target the variable corresponding to the customize widget at point."
    788   (when (derived-mode-p 'Custom-mode)
    789     (save-excursion
    790       (beginning-of-line)
    791       (when-let* ((widget (widget-at (point)))
    792                   (var (and (eq (car widget) 'custom-visibility)
    793                             (plist-get (cdr widget) :parent)))
    794                   (sym (and (eq (car var) 'custom-variable)
    795                             (plist-get (cdr var) :value))))
    796         `(variable
    797           ,(symbol-name sym)
    798           ,(point)
    799           . ,(progn
    800                (re-search-forward ":" (line-end-position) 'noerror)
    801                (point)))))))
    802 
    803 ;; NOTE: There is also (thing-at-point 'list), however it does
    804 ;; not work on strings and requires the point to be inside the
    805 ;; parentheses. This version here is slightly more general.
    806 (defun embark-target-expression-at-point ()
    807   "Target expression at point."
    808   (cl-flet ((syntax-p (class &optional (delta 0))
    809               (and (<= (point-min) (+ (point) delta) (point-max))
    810                    (eq (pcase class
    811                          ('open 4) ('close 5) ('prefix 6) ('string 7))
    812                        (syntax-class (syntax-after (+ (point) delta)))))))
    813     (when-let
    814         ((start
    815           (pcase-let ((`(_ ,open _ ,string _ _ _ _ ,start _ _) (syntax-ppss)))
    816             (ignore-errors ; set start=nil if delimiters are unbalanced
    817               (cond
    818                 (string start)
    819                 ((or (syntax-p 'open) (syntax-p 'prefix))
    820                  (save-excursion (backward-prefix-chars) (point)))
    821                 ((syntax-p 'close -1)
    822                  (save-excursion
    823                    (backward-sexp) (backward-prefix-chars) (point)))
    824                 ((syntax-p 'string) (point))
    825                 ((syntax-p 'string -1) (scan-sexps (point) -1))
    826                 (t open)))))
    827          (end (ignore-errors (scan-sexps start 1))))
    828       (unless (eq start (car (bounds-of-thing-at-point 'defun)))
    829       `(expression ,(buffer-substring start end) ,start . ,end)))))
    830 
    831 (defmacro embark-define-overlay-target (name prop &optional pred type target)
    832   "Define a target finder for NAME that targets overlays with property PROP.
    833 The function defined is named embark-target-NAME-at-point and it
    834 returns Embark targets based on the overlays around point.  An
    835 overlay provides a target if its property named PROP is non-nil.
    836 
    837 If the optional PRED argument is given, it should be an
    838 expression and it further restricts the targets to only those
    839 overlays for which PRED evaluates to non-nil.
    840 
    841 The target finder returns target type NAME or optional symbol
    842 TYPE if given.
    843 
    844 The target finder returns the substring of the buffer covered by
    845 the overlay as the target string or the result of evaluating the
    846 optional TARGET expression if given.
    847 
    848 PRED and TARGET are expressions (not functions) and when evaluated the
    849 symbols `%o' and `%p' are bound to the overlay and the overlay's
    850 property respectively."
    851   `(defun ,(intern (format "embark-target-%s-at-point" name)) ()
    852      ,(format "Target %s at point." name)
    853      (when-let ((%o (seq-find
    854                            (lambda (%o)
    855                              (when-let ((%p (overlay-get %o ',prop)))
    856                                (ignore %p)
    857                                ,(or pred t)))
    858                            (overlays-in (max (point-min) (1- (point)))
    859                                         (min (point-max) (1+ (point))))))
    860                 (%p (overlay-get %o ',prop)))
    861        (ignore %p)
    862        (cons ',(or type name)
    863              (cons ,(or target `(buffer-substring-no-properties
    864                                  (overlay-start %o) (overlay-end %o)))
    865                    (cons (overlay-start %o) (overlay-end %o)))))))
    866 
    867 (embark-define-overlay-target flymake flymake-diagnostic)
    868 (embark-define-overlay-target bug-reference bug-reference-url nil url %p)
    869 (embark-define-overlay-target smerge smerge (eq %p 'conflict))
    870 
    871 (defmacro embark-define-thingatpt-target (thing &rest modes)
    872   "Define a target finder for THING using the thingatpt library.
    873 The function defined is named embark-target-NAME-at-point and it
    874 uses (thing-at-point 'THING) to find its targets.
    875 
    876 If any MODES are given, the target finder only applies to buffers
    877 in one of those major modes."
    878   (declare (indent 1))
    879   `(defun ,(intern (format "embark-target-%s-at-point" thing)) ()
    880      ,(format "Target %s at point." thing)
    881      (when ,(if modes `(derived-mode-p ,@(mapcar (lambda (m) `',m) modes)) t)
    882        (when-let (bounds (bounds-of-thing-at-point ',thing))
    883          (cons ',thing (cons
    884                         (buffer-substring (car bounds) (cdr bounds))
    885                         bounds))))))
    886 
    887 (embark-define-thingatpt-target defun)
    888 (embark-define-thingatpt-target sentence
    889   text-mode help-mode Info-mode man-common)
    890 (embark-define-thingatpt-target paragraph
    891   text-mode help-mode Info-mode man-common)
    892 
    893 (defmacro embark-define-regexp-target
    894     (name regexp &optional type target bounds limit)
    895   "Define a target finder for matches of REGEXP around point.
    896 The function defined is named embark-target-NAME-at-point and it
    897 uses (thing-at-point-looking-at REGEXP) to find its targets.
    898 
    899 The target finder returns target type NAME or optional symbol
    900 TYPE if given.
    901 
    902 The target finder returns the substring of the buffer matched by
    903 REGEXP as the target string or the result of evaluating the
    904 optional TARGET expression if given.  In the expression TARGET
    905 you can use `match-string' to recover the match of the REGEXP or
    906 of any sub-expressions it has.
    907 
    908 BOUNDS is an optional expression to compute the bounds of the
    909 target and defaults to (cons (match-beginning 0) (match-end 0)).
    910 
    911 The optional LIMIT is the number of characters before and after
    912 point to limit the search to.  If LIMIT is nil, search a little
    913 more than the current line (more precisely, the smallest interval
    914 centered at point that includes the current line)."
    915   `(defun ,(intern (format "embark-target-%s-at-point" name)) ()
    916      ,(format "Target %s at point." name)
    917      (save-match-data
    918        (when (thing-at-point-looking-at
    919               ,regexp
    920               ,(or limit '(max (- (pos-eol) (point)) (- (point) (pos-bol)))))
    921          (cons ',(or type name)
    922                (cons ,(or target '(match-string 0))
    923                      ,(or bounds
    924                           '(cons (match-beginning 0) (match-end 0)))))))))
    925 
    926 (defun embark--identifier-types (identifier)
    927   "Return list of target types appropriate for IDENTIFIER."
    928   (let ((symbol (intern-soft identifier)))
    929     (if (not
    930          (or (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
    931              (and (not (derived-mode-p 'prog-mode))
    932                   symbol
    933                   (or (boundp symbol) (fboundp symbol) (symbol-plist symbol)))))
    934         '(identifier)
    935       (let* ((library (ffap-el-mode identifier))
    936              (types
    937               (append
    938                (and (commandp symbol) '(command))
    939                (and symbol (boundp symbol) (not (keywordp symbol)) '(variable))
    940                (and (fboundp symbol) (not (commandp symbol)) '(function))
    941                (and (facep symbol) '(face))
    942                (and library '(library))
    943                (and (featurep 'package) (embark--package-desc symbol)
    944                     '(package)))))
    945         (when (and library
    946                    (looking-back "\\(?:require\\|use-package\\).*"
    947                                  (line-beginning-position)))
    948           (setq types (embark--rotate types (cl-position 'library types))))
    949         (or types '(symbol))))))
    950 
    951 (defun embark-target-identifier-at-point ()
    952   "Target identifier at point.
    953 
    954 In Emacs Lisp and IELM buffers the identifier is promoted to a
    955 symbol, for which more actions are available.  Identifiers are
    956 also promoted to symbols if they are interned Emacs Lisp symbols
    957 and found in a buffer in a major mode that is not derived from
    958 `prog-mode' (this is intended for when you might be reading or
    959 writing about Emacs).
    960 
    961 As a convenience, in Org Mode an initial ' or surrounding == or
    962 ~~ are removed."
    963   (when-let (bounds (bounds-of-thing-at-point 'symbol))
    964     (let ((name (buffer-substring (car bounds) (cdr bounds))))
    965       (when (derived-mode-p 'org-mode)
    966         (cond ((string-prefix-p "'" name)
    967                (setq name (substring name 1))
    968                (cl-incf (car bounds)))
    969               ((string-match-p "^\\([=~]\\).*\\1$" name)
    970                (setq name (substring name 1 -1))
    971                (cl-incf (car bounds))
    972                (cl-decf (cdr bounds)))))
    973       (mapcar (lambda (type) `(,type ,name . ,bounds))
    974               (embark--identifier-types name)))))
    975 
    976 (defun embark-target-heading-at-point ()
    977   "Target the outline heading at point."
    978   (let ((beg (line-beginning-position))
    979         (end (line-end-position)))
    980     (when (save-excursion
    981             (goto-char beg)
    982             (and (bolp)
    983                  (looking-at
    984                   ;; default definition from outline.el
    985                   (or (bound-and-true-p outline-regexp) "[*\^L]+"))))
    986       (require 'outline) ;; Ensure that outline commands are available
    987       `(heading ,(buffer-substring beg end) ,beg . ,end))))
    988 
    989 (defun embark-target-text-heading-at-point ()
    990   "Target the outline heading at point in text modes."
    991   (when (derived-mode-p 'text-mode)
    992     (embark-target-heading-at-point)))
    993 
    994 (defun embark-target-prog-heading-at-point ()
    995   "Target the outline heading at point in programming modes."
    996   (when (derived-mode-p 'prog-mode)
    997     (embark-target-heading-at-point)))
    998 
    999 (defun embark-target-top-minibuffer-candidate ()
   1000   "Target the top completion candidate in the minibuffer.
   1001 Return the category metadatum as the type of the target.
   1002 
   1003 This target finder is meant for the default completion UI and
   1004 completion UI highly compatible with it, like Icomplete.
   1005 Many completion UIs can still work with Embark but will need
   1006 their own target finder.  See for example
   1007 `embark--vertico-selected'."
   1008   (when (and (minibufferp) minibuffer-completion-table)
   1009     (pcase-let* ((`(,category . ,candidates) (embark-minibuffer-candidates))
   1010                  (contents (minibuffer-contents))
   1011                  (top (if (test-completion contents
   1012                                            minibuffer-completion-table
   1013                                            minibuffer-completion-predicate)
   1014                           contents
   1015                         (let ((completions (completion-all-sorted-completions)))
   1016                           (if (null completions)
   1017                               contents
   1018                             (concat
   1019                              (substring contents
   1020                                         0 (or (cdr (last completions)) 0))
   1021                              (car completions)))))))
   1022       (cons category (or (car (member top candidates)) top)))))
   1023 
   1024 (defun embark-target-collect-candidate ()
   1025   "Target the collect candidate at point."
   1026   (when (derived-mode-p 'embark-collect-mode)
   1027     (when-let ((button
   1028                 (pcase (get-text-property (point) 'tabulated-list-column-name)
   1029                   ("Candidate" (button-at (point)))
   1030                   ("Annotation" (previous-button (point)))))
   1031                (start (button-start button))
   1032                (end (button-end button))
   1033                (candidate (tabulated-list-get-id)))
   1034       `(,embark--type
   1035         ,(if (eq embark--type 'file)
   1036              (abbreviate-file-name (expand-file-name candidate))
   1037            candidate)
   1038         ,start . ,end))))
   1039 
   1040 (defun embark-target-completion-list-candidate ()
   1041   "Return the completion candidate at point in a completions buffer."
   1042   (when (derived-mode-p 'completion-list-mode)
   1043     (if (not (get-text-property (point) 'mouse-face))
   1044         (user-error "No completion here")
   1045       ;; this fairly delicate logic is taken from `choose-completion'
   1046       (let (beg end)
   1047         (cond
   1048          ((and (not (eobp)) (get-text-property (point) 'mouse-face))
   1049           (setq end (point) beg (1+ (point))))
   1050          ((and (not (bobp))
   1051                (get-text-property (1- (point)) 'mouse-face))
   1052           (setq end (1- (point)) beg (point)))
   1053          (t (user-error "No completion here")))
   1054         (setq beg (previous-single-property-change beg 'mouse-face))
   1055         (setq end (or (next-single-property-change end 'mouse-face)
   1056                       (point-max)))
   1057         (let ((raw (or (get-text-property beg 'completion--string)
   1058                        (buffer-substring beg end))))
   1059           `(,embark--type
   1060             ,(if (eq embark--type 'file)
   1061                  (abbreviate-file-name (expand-file-name raw))
   1062                raw)
   1063             ,beg . ,end))))))
   1064 
   1065 (defun embark--cycle-key ()
   1066   "Return the key to use for `embark-cycle'."
   1067   (if embark-cycle-key
   1068       (if (key-valid-p embark-cycle-key)
   1069           (key-parse embark-cycle-key)
   1070         (error "`embark-cycle-key' is invalid"))
   1071     (car (where-is-internal #'embark-act))))
   1072 
   1073 (defun embark--raw-action-keymap (type)
   1074   "Return raw action map for targets of given TYPE.
   1075 This does not take into account the default action, help key or
   1076 cycling bindings, just what's registered in
   1077 `embark-keymap-alist'."
   1078   (make-composed-keymap
   1079    (mapcar #'symbol-value
   1080            (let ((actions (or (alist-get type embark-keymap-alist)
   1081                               (alist-get t embark-keymap-alist))))
   1082              (ensure-list actions)))))
   1083 
   1084 (defun embark--action-keymap (type cycle)
   1085   "Return action keymap for targets of given TYPE.
   1086 If CYCLE is non-nil bind `embark-cycle'."
   1087   (make-composed-keymap
   1088    (let ((map (make-sparse-keymap))
   1089          (default-action (embark--default-action type)))
   1090      (define-key map [13] default-action)
   1091      (when-let ((cycle-key (and cycle (embark--cycle-key))))
   1092        (define-key map cycle-key #'embark-cycle))
   1093      (when embark-help-key
   1094        (keymap-set map embark-help-key #'embark-keymap-help))
   1095      map)
   1096    (embark--raw-action-keymap type)))
   1097 
   1098 (defun embark--truncate-target (target)
   1099   "Truncate TARGET string."
   1100   (unless (stringp target)
   1101     (setq target (format "%s" target)))
   1102   (if-let (pos (string-match-p "\n" target))
   1103       (concat (car (split-string target "\n" 'omit-nulls "\\s-*")) "…")
   1104     target))
   1105 
   1106 ;;;###autoload
   1107 (defun embark-eldoc-first-target (report &rest _)
   1108   "Eldoc function reporting the first Embark target at point.
   1109 This function uses the eldoc REPORT callback and is meant to be
   1110 added to `eldoc-documentation-functions'."
   1111   (when-let (((not (minibufferp)))
   1112              (target (car (embark--targets))))
   1113     (funcall report
   1114              (format "Embark on %s ‘%s’"
   1115                      (plist-get target :type)
   1116                      (embark--truncate-target (plist-get target :target))))))
   1117 
   1118 ;;;###autoload
   1119 (defun embark-eldoc-target-types (report &rest _)
   1120   "Eldoc function reporting the types of all Embark targets at point.
   1121 This function uses the eldoc REPORT callback and is meant to be
   1122 added to `eldoc-documentation-functions'."
   1123   (when-let (((not (minibufferp)))
   1124              (targets (embark--targets)))
   1125     (funcall report
   1126              (format "Embark target types: %s"
   1127                      (mapconcat
   1128                       (lambda (target) (symbol-name (plist-get target :type)))
   1129                       targets
   1130                       ", ")))))
   1131 
   1132 (defun embark--format-targets (target shadowed-targets rep)
   1133   "Return a formatted string indicating the TARGET of an action.
   1134 
   1135 This is used internally by the minimal indicator and for the
   1136 targets section of the verbose indicator.  The string will also
   1137 mention any SHADOWED-TARGETS.  A non-nil REP indicates we are in
   1138 a repeating sequence of actions."
   1139   (let ((act (propertize
   1140               (cond
   1141                ((plist-get target :multi) "∀ct")
   1142                (rep "Rep")
   1143                (t "Act"))
   1144               'face 'highlight)))
   1145     (cond
   1146      ((eq (plist-get target :type) 'embark-become)
   1147       (propertize "Become" 'face 'highlight))
   1148      ((and (minibufferp)
   1149            (not (eq 'embark-keybinding
   1150                     (completion-metadata-get
   1151                      (embark--metadata)
   1152                      'category))))
   1153       ;; we are in a minibuffer but not from the
   1154       ;; completing-read prompter, use just "Act"
   1155       act)
   1156      ((plist-get target :multi)
   1157       (format "%s on %s %ss"
   1158               act
   1159               (plist-get target :multi)
   1160               (plist-get target :type)))
   1161      (t (format
   1162          "%s on %s%s ‘%s’"
   1163          act
   1164          (plist-get target :type)
   1165          (if shadowed-targets
   1166              (format (propertize "(%s)" 'face 'shadow)
   1167                      (mapconcat
   1168                       (lambda (target) (symbol-name (plist-get target :type)))
   1169                       shadowed-targets
   1170                       ", "))
   1171            "")
   1172          (embark--truncate-target (plist-get target :target)))))))
   1173 
   1174 (defun embark-minimal-indicator ()
   1175   "Minimal indicator, appearing in the minibuffer prompt or echo area.
   1176 This indicator displays a message showing the types of all
   1177 targets, starting with the current target, and the value of the
   1178 current target.  The message is displayed in the echo area, or if
   1179 the minibuffer is open, the message is added to the prompt."
   1180   (lambda (&optional keymap targets _prefix)
   1181     (if (null keymap)
   1182         (when embark--minimal-indicator-overlay
   1183           (delete-overlay embark--minimal-indicator-overlay)
   1184           (setq-local embark--minimal-indicator-overlay nil))
   1185       (let ((indicator (embark--format-targets
   1186                         (car targets) (cdr targets)
   1187                         (eq (lookup-key keymap [13]) #'embark-done))))
   1188         (if (not (minibufferp))
   1189             (message "%s" indicator)
   1190           (unless embark--minimal-indicator-overlay
   1191             (setq-local embark--minimal-indicator-overlay
   1192                         (make-overlay (point-min) (point-min)
   1193                                       (current-buffer) t t)))
   1194           (overlay-put embark--minimal-indicator-overlay
   1195                        'before-string (concat indicator
   1196                                               (if (<= (length indicator)
   1197                                                       (* 0.4 (frame-width)))
   1198                                                   " "
   1199                                                 "\n"))))))))
   1200 
   1201 (defun embark--read-key-sequence (update)
   1202   "Read key sequence, call UPDATE function with prefix keys."
   1203   (let (timer prefix)
   1204     (unwind-protect
   1205         (progn
   1206           (when (functionp update)
   1207             (setq timer (run-at-time
   1208                          0.05 0.05
   1209                          (lambda ()
   1210                            (let ((new-prefix (this-single-command-keys)))
   1211                              (unless (equal prefix new-prefix)
   1212                                (setq prefix new-prefix)
   1213                                (when (/= (length prefix) 0)
   1214                                  (funcall update prefix))))))))
   1215           (read-key-sequence-vector nil nil nil t 'cmd-loop))
   1216       (when timer
   1217         (cancel-timer timer)))))
   1218 
   1219 (defvar embark-indicators) ; forward declaration
   1220 
   1221 (defun embark-keymap-prompter (keymap update)
   1222   "Let the user choose an action using the bindings in KEYMAP.
   1223 Besides the bindings in KEYMAP, the user is free to use all their
   1224 key bindings and even \\[execute-extended-command] to select a command.
   1225 UPDATE is the indicator update function."
   1226   (let* ((keys (let ((overriding-terminal-local-map keymap))
   1227                  (embark--read-key-sequence update)))
   1228          (cmd (let ((overriding-terminal-local-map keymap))
   1229                 (key-binding keys 'accept-default))))
   1230     ;; Set last-command-event as it would be from the command loop.
   1231     ;; Previously we only set it locally for digit-argument and for
   1232     ;; the mouse scroll commands handled in this function. But other
   1233     ;; commands can need it too! For example, electric-pair-mode users
   1234     ;; may wish to bind ( to self-insert-command in embark-region-map.
   1235     ;; Also, as described in issue #402, there are circumstances where
   1236     ;; you might run consult-narrow through the embark-keymap-prompter.
   1237     (setq last-command-event (aref keys (1- (length keys))))
   1238     (pcase cmd
   1239       ((or 'embark-keymap-help
   1240            (and 'nil            ; cmd is nil but last key is help-char
   1241                 (guard (eq help-char (aref keys (1- (length keys)))))))
   1242        (let ((embark-indicators
   1243               (cl-set-difference embark-indicators
   1244                                  '(embark-verbose-indicator
   1245                                    embark-mixed-indicator)))
   1246              (prefix-map
   1247               (if (eq cmd 'embark-keymap-help)
   1248                   keymap
   1249                 (let ((overriding-terminal-local-map keymap))
   1250                   (key-binding (seq-take keys (1- (length keys)))
   1251                                'accept-default))))
   1252              (prefix-arg prefix-arg)) ; preserve prefix arg
   1253          (when-let ((win (get-buffer-window embark--verbose-indicator-buffer
   1254                                             'visible)))
   1255            (quit-window 'kill-buffer win))
   1256          (embark-completing-read-prompter prefix-map update)))
   1257       ((or 'universal-argument 'universal-argument-more
   1258            'negative-argument 'digit-argument 'embark-toggle-quit)
   1259        ;; prevent `digit-argument' from modifying the overriding map
   1260        (let ((overriding-terminal-local-map overriding-terminal-local-map))
   1261          (command-execute cmd))
   1262        (embark-keymap-prompter
   1263         (make-composed-keymap universal-argument-map keymap)
   1264         update))
   1265       ((or 'minibuffer-keyboard-quit 'abort-recursive-edit 'abort-minibuffers)
   1266        nil)
   1267       ((guard (let ((def (lookup-key keymap keys))) ; if directly
   1268                                                     ; bound, then obey
   1269                 (and def (not (numberp def))))) ; number means "invalid prefix"
   1270        cmd)
   1271       ((and (pred symbolp)
   1272             (guard (string-suffix-p "self-insert-command" (symbol-name cmd))))
   1273        (minibuffer-message "Not an action")
   1274        (embark-keymap-prompter keymap update))
   1275       ((or 'scroll-other-window 'scroll-other-window-down)
   1276        (let ((minibuffer-scroll-window
   1277               ;; NOTE: Here we special case the verbose indicator!
   1278               (or (get-buffer-window embark--verbose-indicator-buffer 'visible)
   1279                   minibuffer-scroll-window)))
   1280          (ignore-errors (command-execute cmd)))
   1281        (embark-keymap-prompter keymap update))
   1282       ((or 'scroll-bar-toolkit-scroll 'mwheel-scroll 'mac-mwheel-scroll)
   1283        (funcall cmd last-command-event)
   1284        (embark-keymap-prompter keymap update))
   1285       ('execute-extended-command
   1286        (let ((prefix-arg prefix-arg)) ; preserve prefix arg
   1287          (intern-soft (read-extended-command))))
   1288       ((or 'keyboard-quit 'keyboard-escape-quit)
   1289        nil)
   1290       (_ cmd))))
   1291 
   1292 (defun embark--command-name (cmd)
   1293   "Return an appropriate name for CMD.
   1294 If CMD is a symbol, use its symbol name; for lambdas, use the
   1295 first line of the documentation string; for keyboard macros use
   1296 `key-description'; otherwise use the word \"unnamed\"."
   1297   (concat ; fresh copy, so we can freely add text properties
   1298    (cond
   1299     ((or (stringp cmd) (vectorp cmd)) (key-description cmd))
   1300     ((stringp (car-safe cmd)) (car cmd))
   1301     ((eq (car-safe cmd) 'menu-item) (eval (cadr cmd)))
   1302     ((keymapp cmd)
   1303      (propertize (if (symbolp cmd) (format "+%s" cmd) "<keymap>")
   1304                  'face 'embark-keymap))
   1305     ((symbolp cmd)
   1306      (let ((name (symbol-name cmd)))
   1307        (if (string-prefix-p "embark-action--" name) ; direct action mode
   1308            (format "(%s)" (string-remove-prefix "embark-action--" name))
   1309          name)))
   1310     ((when-let (doc (and (functionp cmd) (ignore-errors (documentation cmd))))
   1311        (save-match-data
   1312          (when (string-match "^\\(.*\\)$" doc)
   1313            (match-string 1 doc)))))
   1314     (t "<unnamed>"))))
   1315 
   1316 ;; Taken from Marginalia, needed by the verbose indicator.
   1317 ;; We cannot use the completion annotators in this case.
   1318 (defconst embark--advice-regexp
   1319   (rx bos
   1320       (1+ (seq (? "This function has ")
   1321                (or ":before" ":after" ":around" ":override"
   1322                    ":before-while" ":before-until" ":after-while"
   1323                    ":after-until" ":filter-args" ":filter-return")
   1324                " advice: " (0+ nonl) "\n"))
   1325       "\n")
   1326   "Regexp to match lines about advice in function documentation strings.")
   1327 
   1328 ;; Taken from Marginalia, needed by the verbose indicator.
   1329 ;; We cannot use the completion annotators in this case.
   1330 (defun embark--function-doc (sym)
   1331   "Documentation string of function SYM."
   1332   (let ((vstr (and (symbolp sym) (keymapp sym) (boundp sym)
   1333                    (eq (symbol-function sym) (symbol-value sym))
   1334                    (documentation-property sym 'variable-documentation))))
   1335     (when-let (str (or (ignore-errors (documentation sym)) vstr))
   1336       ;; Replace standard description with variable documentation
   1337       (when (and vstr (string-match-p "\\`Prefix command" str))
   1338         (setq str vstr))
   1339       (save-match-data
   1340         (if (string-match embark--advice-regexp str)
   1341             (substring str (match-end 0))
   1342           str)))))
   1343 
   1344 (defun embark--action-repeatable-p (action)
   1345   "Is ACTION repeatable?
   1346 When the return value is non-nil it will be the desired starting
   1347 point of the next target cycle or t to indicate the default,
   1348 namely that the target cycle for the next action should begin at
   1349 the type of the current target."
   1350   (or (cdr (assq action embark-repeat-actions))
   1351       (and (memq action embark-repeat-actions) t)))
   1352 
   1353 (defun embark--formatted-bindings (keymap &optional nested)
   1354   "Return the formatted keybinding of KEYMAP.
   1355 The keybindings are returned in their order of appearance.
   1356 If NESTED is non-nil subkeymaps are not flattened."
   1357   (let* ((commands
   1358           (cl-loop for (key . def) in (embark--all-bindings keymap nested)
   1359                    for name = (embark--command-name def)
   1360                    for cmd = (keymap--menu-item-binding def)
   1361                    unless (memq cmd '(nil embark-keymap-help
   1362                                       negative-argument digit-argument))
   1363                    collect (list name cmd key
   1364                                  (concat
   1365                                   (if (eq (car-safe def) 'menu-item)
   1366                                       "menu-item"
   1367                                     (key-description key))))))
   1368          (width (cl-loop for (_name _cmd _key desc) in commands
   1369                          maximize (length desc)))
   1370          (default)
   1371          (candidates
   1372           (cl-loop for item in commands
   1373                    for (name cmd key desc) = item
   1374                    for desc-rep =
   1375                    (concat
   1376                     (propertize desc 'face 'embark-keybinding)
   1377                     (and (embark--action-repeatable-p cmd)
   1378                          embark-keybinding-repeat))
   1379                    for formatted =
   1380                    (propertize
   1381                     (concat desc-rep
   1382                             (make-string (- width (length desc-rep) -1) ?\s)
   1383                             name)
   1384                     'embark-command cmd)
   1385                    when (equal key [13])
   1386                    do (setq default formatted)
   1387                    collect (cons formatted item))))
   1388     (cons candidates default)))
   1389 
   1390 (defun embark--with-category (category candidates)
   1391   "Return completion table for CANDIDATES of CATEGORY with sorting disabled."
   1392   (lambda (string predicate action)
   1393     (if (eq action 'metadata)
   1394         `(metadata (display-sort-function . identity)
   1395                    (cycle-sort-function . identity)
   1396                    (category . ,category))
   1397       (complete-with-action
   1398        action candidates string predicate))))
   1399 
   1400 (defun embark-completing-read-prompter (keymap update &optional no-default)
   1401   "Prompt via completion for a command bound in KEYMAP.
   1402 If NO-DEFAULT is t, no default value is passed to`completing-read'.
   1403 
   1404 UPDATE is the indicator update function.  It is not used directly
   1405 here, but if the user switches to `embark-keymap-prompter', the
   1406 UPDATE function is passed to it."
   1407   (let* ((candidates+def (embark--formatted-bindings keymap))
   1408          (candidates (car candidates+def))
   1409          (def (and (not no-default) (cdr candidates+def)))
   1410          (buf (current-buffer))
   1411          (choice
   1412           (catch 'choice
   1413             (minibuffer-with-setup-hook
   1414                 (lambda ()
   1415                   (let ((map (make-sparse-keymap)))
   1416                     (define-key map "\M-q"
   1417                                 (lambda ()
   1418                                   (interactive)
   1419                                   (with-current-buffer buf
   1420                                     (embark-toggle-quit))))
   1421                     (when-let (cycle (embark--cycle-key))
   1422                       ;; Rebind `embark-cycle' in order allow cycling
   1423                       ;; from the `completing-read' prompter. Additionally
   1424                       ;; `embark-cycle' can be selected via
   1425                       ;; `completing-read'. The downside is that this breaks
   1426                       ;; recursively acting on the candidates of type
   1427                       ;; embark-keybinding in the `completing-read' prompter.
   1428                       (define-key map cycle
   1429                         (cond
   1430                          ((eq (lookup-key keymap cycle) 'embark-cycle)
   1431                           (lambda ()
   1432                             (interactive)
   1433                             (throw 'choice 'embark-cycle)))
   1434                          ((null embark-cycle-key)
   1435                           (lambda ()
   1436                             (interactive)
   1437                             (minibuffer-message
   1438                              "No cycling possible; press `%s' again to act."
   1439                              (key-description cycle))
   1440                             (define-key map cycle #'embark-act))))))
   1441                     (when embark-keymap-prompter-key
   1442                       (keymap-set map embark-keymap-prompter-key
   1443                         (lambda ()
   1444                           (interactive)
   1445                           (message "Press key binding")
   1446                           (let ((cmd (embark-keymap-prompter keymap update)))
   1447                             (if (null cmd)
   1448                                 (user-error "Unknown key")
   1449                               (throw 'choice cmd))))))
   1450                     (use-local-map
   1451                      (make-composed-keymap map (current-local-map)))))
   1452               (completing-read
   1453                "Command: "
   1454                (embark--with-category 'embark-keybinding candidates)
   1455                nil nil nil 'embark--prompter-history def)))))
   1456     (pcase (assoc choice candidates)
   1457       (`(,_formatted ,_name ,cmd ,key ,_desc)
   1458        ;; Set last-command-event as it would be from the command loop.
   1459        (setq last-command-event (aref key (1- (length key))))
   1460        cmd)
   1461       ('nil (intern-soft choice)))))
   1462 
   1463 ;;; Verbose action indicator
   1464 
   1465 (defgroup embark-indicators nil
   1466   "Indicators display information about actions and targets."
   1467   :group 'embark)
   1468 
   1469 (defcustom embark-indicators
   1470   '(embark-mixed-indicator
   1471     embark-highlight-indicator
   1472     embark-isearch-highlight-indicator)
   1473   "Indicator functions to use when acting or becoming.
   1474 The indicator functions are called from both `embark-act' and
   1475 from `embark-become' and should display information about this to
   1476 the user, such as: which of those two commands is running; a
   1477 description of the key bindings that are available for actions or
   1478 commands to become; and, in the case of `embark-act', the type
   1479 and value of the targets, and whether other targets are available
   1480 via `embark-cycle'.  The indicator function is free to display as
   1481 much or as little of this information as desired and can use any
   1482 Emacs interface elements to do so.
   1483 
   1484 Embark comes with five such indicators:
   1485 
   1486 - `embark-minimal-indicator', which does not display any
   1487   information about keybindings, but does display types and
   1488   values of action targets in the echo area or minibuffer prompt,
   1489 
   1490 - `embark-verbose-indicator', which pops up a buffer containing
   1491   detailed information including key bindings and the first line
   1492   of the docstring of the commands they run, and
   1493 
   1494 - `embark-mixed-indicator', which combines the minimal and the
   1495   verbose indicator: the minimal indicator is shown first and the
   1496   verbose popup is shown after `embark-mixed-indicator-delay'
   1497   seconds.
   1498 
   1499 - `embark-highlight-indicator', which highlights the target
   1500   at point.
   1501 
   1502 - `embark-isearch-highlight-indicator', which when the target at
   1503   point is an identifier or symbol, lazily highlights all
   1504   occurrences of it.
   1505 
   1506 The protocol for indicator functions is as follows:
   1507 
   1508 When called from `embark-act', an indicator function is called
   1509 without arguments.  The indicator function should then return a
   1510 closure, which captures the indicator state.  The returned
   1511 closure must accept up to three optional arguments, the action
   1512 keymap, the targets (plists as returned by `embark--targets') and
   1513 the prefix keys typed by the user so far.  The keymap, targets
   1514 and prefix keys may be updated when cycling targets at point
   1515 resulting in multiple calls to the closure.  When called from
   1516 `embark-become', the indicator closure will be called with the
   1517 keymap of commands to become, a fake target list containing a
   1518 single target of type `embark-become' and whose value is the
   1519 minibuffer input, and the prefix set to nil.  Note, in
   1520 particular, that if an indicator function wishes to distinguish
   1521 between `embark-act' and `embark-become' it should check whether
   1522 the `car' of the first target is `embark-become'.
   1523 
   1524 After the action has been performed the indicator closure is
   1525 called without arguments, such that the indicator can perform the
   1526 necessary cleanup work.  For example, if the indicator adds
   1527 overlays, it should remove these overlays.  The indicator should
   1528 be written in a way that it is safe to call it for cleanup more
   1529 than once, in fact, it should be able to handle any sequence of
   1530 update and cleanup calls ending in a call for cleanup.
   1531 
   1532 NOTE: Experience shows that the indicator calling convention may
   1533 change again in order to support more action features.  The
   1534 calling convention should currently be considered unstable.
   1535 Please keep this in mind when writing a custom indicator
   1536 function, or when using the `which-key' indicator function from
   1537 the wiki."
   1538   :type '(repeat
   1539           (choice
   1540            (const :tag "Verbose indicator" embark-verbose-indicator)
   1541            (const :tag "Minimal indicator" embark-minimal-indicator)
   1542            (const :tag "Mixed indicator" embark-mixed-indicator)
   1543            (const :tag "Highlight target" embark-highlight-indicator)
   1544            (const :tag "Highlight all occurrences"
   1545                   embark-isearch-highlight-indicator)
   1546            (function :tag "Other"))))
   1547 
   1548 (defface embark-verbose-indicator-documentation
   1549   '((t :inherit completions-annotations))
   1550   "Face used by the verbose action indicator to display binding descriptions.
   1551 Used by `embark-verbose-indicator'.")
   1552 
   1553 (defface embark-verbose-indicator-title '((t :height 1.1 :weight bold))
   1554   "Face used by the verbose action indicator for the title.
   1555 Used by `embark-verbose-indicator'.")
   1556 
   1557 (defface embark-verbose-indicator-shadowed '((t :inherit shadow))
   1558   "Face used by the verbose action indicator for the shadowed targets.
   1559 Used by `embark-verbose-indicator'.")
   1560 
   1561 (defcustom embark-verbose-indicator-display-action
   1562   '(display-buffer-reuse-window)
   1563   "Parameters added to `display-buffer-alist' to show the actions buffer.
   1564 See the docstring of `display-buffer' for information on what
   1565 display actions and parameters are available."
   1566   :type `(choice
   1567           (const :tag "Reuse some window"
   1568                  (display-buffer-reuse-window))
   1569           (const :tag "Below target buffer"
   1570                  (display-buffer-below-selected
   1571                   (window-height . fit-window-to-buffer)))
   1572           (const :tag "Bottom of frame (fixed-size)"
   1573                  (display-buffer-at-bottom))
   1574           (const :tag "Bottom of frame (resizes during cycling)"
   1575                  (display-buffer-at-bottom
   1576                   (window-height . fit-window-to-buffer)))
   1577           (const :tag "Side window on the right"
   1578                  (display-buffer-in-side-window (side . right)))
   1579           (const :tag "Side window on the left"
   1580                  (display-buffer-in-side-window (side . left)))
   1581           (sexp :tag "Other")))
   1582 
   1583 (defcustom embark-verbose-indicator-excluded-actions nil
   1584   "Commands not displayed by `embark-verbose-indicator'.
   1585 This variable should be set to a list of symbols and regexps.
   1586 The verbose indicator will exclude from its listing any commands
   1587 matching an element of this list."
   1588   :type '(choice
   1589           (const :tag "Exclude nothing" nil)
   1590           (const :tag "Exclude Embark general actions"
   1591                  (embark-collect embark-live embark-export
   1592                   embark-cycle embark-act-all embark-keymap-help
   1593                   embark-become embark-isearch-forward
   1594                   embark-isearch-backward))
   1595           (repeat :tag "Other" (choice regexp symbol))))
   1596 
   1597 (defcustom embark-verbose-indicator-buffer-sections
   1598   `(target "\n" shadowed-targets " " cycle "\n" bindings)
   1599   "List of sections to display in the verbose indicator buffer, in order.
   1600 You can use either a symbol designating a concrete section (one
   1601 of the keywords below, but without the colon), a string literal
   1602 or a function returning a string or list of strings to insert and
   1603 that accepts the following keyword arguments:
   1604 
   1605 - `:target', the target as a cons of type and value,
   1606 - `:shadowed-targets', a list of conses for the other targets,
   1607 - `:bindings' a list returned by `embark--formatted-bindings', and
   1608 - `:cycle', a string describing the key binding of `embark-cycle'."
   1609   :type '(repeat
   1610           (choice (const :tag "Current target name" target)
   1611                   (const :tag "List of other shadowed targets" shadowed-targets)
   1612                   (const :tag "Key bindings" bindings)
   1613                   (const :tag "Cycle indicator" cycle)
   1614                   (string :tag "Literal string")
   1615                   (function :tag "Custom function"))))
   1616 
   1617 (defcustom embark-verbose-indicator-nested t
   1618   "Whether the verbose indicator should use nested keymap navigation.
   1619 When this variable is non-nil the actions buffer displayed by
   1620 `embark-verbose-indicator' will include any prefix keys found in
   1621 the keymap it is displaying, and will update to show what is
   1622 bound under the prefix if the prefix is pressed.  If this
   1623 variable is nil, then the actions buffer will contain a flat list
   1624 of all full key sequences bound in the keymap."
   1625   :type 'boolean)
   1626 
   1627 (defun embark--verbose-indicator-excluded-p (cmd)
   1628   "Return non-nil if CMD should be excluded from the verbose indicator."
   1629   (seq-find (lambda (x)
   1630               (if (symbolp x)
   1631                   (eq cmd x)
   1632                 (string-match-p x (symbol-name cmd))))
   1633             embark-verbose-indicator-excluded-actions))
   1634 
   1635 (cl-defun embark--verbose-indicator-section-target
   1636     (&key targets bindings &allow-other-keys)
   1637   "Format the TARGETS section for the indicator buffer.
   1638 BINDINGS is the formatted list of keybindings."
   1639   (let ((result (embark--format-targets
   1640                  (car targets)
   1641                  nil   ; the shadowed targets section deals with these
   1642                  (cl-find 'embark-done bindings :key #'caddr :test #'eq))))
   1643     (add-face-text-property 0 (length result)
   1644                             'embark-verbose-indicator-title
   1645                             'append
   1646                             result)
   1647     result))
   1648 
   1649 (cl-defun embark--verbose-indicator-section-cycle
   1650     (&key cycle shadowed-targets &allow-other-keys)
   1651   "Format the CYCLE key section for the indicator buffer.
   1652 SHADOWED-TARGETS is the list of other targets."
   1653   (concat
   1654    (and cycle (propertize (format "(%s to cycle)" cycle)
   1655                           'face 'embark-verbose-indicator-shadowed))
   1656    (and shadowed-targets "\n")))
   1657 
   1658 (cl-defun embark--verbose-indicator-section-shadowed-targets
   1659     (&key shadowed-targets &allow-other-keys)
   1660   "Format the SHADOWED-TARGETS section for the indicator buffer."
   1661   (when shadowed-targets
   1662     (propertize (format "Shadowed targets at point: %s"
   1663                         (string-join shadowed-targets ", "))
   1664                 'face 'embark-verbose-indicator-shadowed)))
   1665 
   1666 (cl-defun embark--verbose-indicator-section-bindings
   1667     (&key bindings &allow-other-keys)
   1668   "Format the BINDINGS section for the indicator buffer."
   1669   (let* ((max-width (apply #'max (cons 0 (mapcar (lambda (x)
   1670                                                   (string-width (car x)))
   1671                                                 bindings))))
   1672          (fmt (format "%%-%ds" (1+ max-width)))
   1673          (result nil))
   1674     (dolist (binding bindings (string-join (nreverse result)))
   1675       (let ((cmd (caddr binding)))
   1676         (unless (embark--verbose-indicator-excluded-p cmd)
   1677           (let ((keys (format fmt (car binding)))
   1678                 (doc (embark--function-doc cmd)))
   1679             (push (format "%s%s\n" keys
   1680                           (propertize
   1681                            (car (split-string (or doc "") "\n"))
   1682                            'face 'embark-verbose-indicator-documentation))
   1683                           result)))))))
   1684 
   1685 (defun embark--verbose-indicator-update (keymap targets)
   1686   "Update verbose indicator buffer.
   1687 The arguments are the new KEYMAP and TARGETS."
   1688   (with-current-buffer (get-buffer-create embark--verbose-indicator-buffer)
   1689     (let* ((inhibit-read-only t)
   1690            (bindings
   1691             (embark--formatted-bindings keymap embark-verbose-indicator-nested))
   1692            (bindings (car bindings))
   1693            (shadowed-targets (mapcar
   1694                               (lambda (x) (symbol-name (plist-get x :type)))
   1695                               (cdr targets)))
   1696            (cycle (let ((ck (where-is-internal #'embark-cycle keymap)))
   1697                     (and ck (key-description (car ck))))))
   1698       (setq-local cursor-type nil)
   1699       (setq-local truncate-lines t)
   1700       (setq-local buffer-read-only t)
   1701       (erase-buffer)
   1702       (dolist (section embark-verbose-indicator-buffer-sections)
   1703         (insert
   1704          (if (stringp section)
   1705              section
   1706            (or (funcall
   1707                 (let ((prefixed (intern (format
   1708                                          "embark--verbose-indicator-section-%s"
   1709                                          section))))
   1710                   (cond
   1711                    ((fboundp prefixed) prefixed)
   1712                    ((fboundp section) section)
   1713                    (t (error "Undefined verbose indicator section `%s'"
   1714                              section))))
   1715                 :targets targets :shadowed-targets shadowed-targets
   1716                 :bindings bindings :cycle cycle)
   1717                ""))))
   1718       (goto-char (point-min)))))
   1719 
   1720 (defun embark-verbose-indicator ()
   1721   "Indicator that displays a table of key bindings in a buffer.
   1722 The default display includes the type and value of the current
   1723 target, the list of other target types, and a table of key
   1724 bindings, actions and the first line of their docstrings.
   1725 
   1726 The order and formatting of these items is completely
   1727 configurable through the variable
   1728 `embark-verbose-indicator-buffer-sections'.
   1729 
   1730 If the keymap being shown contains prefix keys, the table of key
   1731 bindings can either show just the prefixes and update once the
   1732 prefix is pressed, or it can contain a flat list of all full key
   1733 sequences bound in the keymap.  This is controlled by the
   1734 variable `embark-verbose-indicator-nested'.
   1735 
   1736 To reduce clutter in the key binding table, one can set the
   1737 variable `embark-verbose-indicator-excluded-actions' to a list
   1738 of symbols and regexps matching commands to exclude from the
   1739 table.
   1740 
   1741 To configure how a window is chosen to display this buffer, see
   1742 the variable `embark-verbose-indicator-display-action'."
   1743   (lambda (&optional keymap targets prefix)
   1744     (if (not keymap)
   1745         (when-let ((win (get-buffer-window embark--verbose-indicator-buffer
   1746                                            'visible)))
   1747           (quit-window 'kill-buffer win))
   1748       (embark--verbose-indicator-update
   1749        (if (and prefix embark-verbose-indicator-nested)
   1750            ;; Lookup prefix keymap globally if not found in action keymap
   1751            (let ((overriding-terminal-local-map keymap))
   1752              (key-binding prefix 'accept-default))
   1753          keymap)
   1754        targets)
   1755       (let ((display-buffer-alist
   1756              `(,@display-buffer-alist
   1757                (,(regexp-quote embark--verbose-indicator-buffer)
   1758                 ,@embark-verbose-indicator-display-action))))
   1759         (display-buffer embark--verbose-indicator-buffer)))))
   1760 
   1761 (defcustom embark-mixed-indicator-delay 0.5
   1762   "Time in seconds after which the verbose indicator is shown.
   1763 The mixed indicator starts by showing the minimal indicator and
   1764 after this delay shows the verbose indicator."
   1765   :type '(choice (const :tag "No delay" 0)
   1766                  (number :tag "Delay in seconds")))
   1767 
   1768 (defcustom embark-mixed-indicator-both nil
   1769   "Show both indicators, even after the verbose indicator appeared."
   1770   :type 'boolean)
   1771 
   1772 (defun embark-mixed-indicator ()
   1773   "Mixed indicator showing keymap and targets.
   1774 The indicator shows the `embark-minimal-indicator' by default.
   1775 After `embark-mixed-indicator-delay' seconds, the
   1776 `embark-verbose-indicator' is shown.  This which-key-like approach
   1777 ensures that Embark stays out of the way for quick actions.  The
   1778 helpful keybinding reminder still pops up automatically without
   1779 further user intervention."
   1780   (let ((vindicator (embark-verbose-indicator))
   1781         (mindicator (embark-minimal-indicator))
   1782         vindicator-active
   1783         vtimer)
   1784     (lambda (&optional keymap targets prefix)
   1785       ;; Always cancel the timer.
   1786       ;; 1. When updating, cancel timer, since the user has pressed
   1787       ;;    a key before the timer elapsed.
   1788       ;; 2. For cleanup, the timer must also be canceled.
   1789       (when vtimer
   1790         (cancel-timer vtimer)
   1791         (setq vtimer nil))
   1792       (if (not keymap)
   1793           (progn
   1794             (funcall vindicator)
   1795             (when mindicator
   1796               (funcall mindicator)))
   1797         (when mindicator
   1798           (funcall mindicator keymap targets prefix))
   1799         (if vindicator-active
   1800             (funcall vindicator keymap targets prefix)
   1801           (setq vtimer
   1802                 (run-at-time
   1803                  embark-mixed-indicator-delay nil
   1804                  (lambda ()
   1805                    (when (and (not embark-mixed-indicator-both) mindicator)
   1806                      (funcall mindicator)
   1807                      (setq mindicator nil))
   1808                    (setq vindicator-active t)
   1809                    (funcall vindicator keymap targets prefix)))))))))
   1810 
   1811 ;;;###autoload
   1812 (defun embark-bindings-in-keymap (keymap)
   1813   "Explore command key bindings in KEYMAP with `completing-read'.
   1814 The selected command will be executed.  Interactively, prompt the
   1815 user for a KEYMAP variable."
   1816   (interactive
   1817    (list
   1818     (symbol-value
   1819      (intern-soft
   1820       (completing-read
   1821        "Keymap: "
   1822        (embark--with-category
   1823         'variable
   1824         (cl-loop for x being the symbols
   1825                  if (and (boundp x) (keymapp (symbol-value x)))
   1826                  collect (symbol-name x)))
   1827        nil t nil 'variable-name-history
   1828        (let ((major-mode-map
   1829               (concat (symbol-name major-mode) "-map")))
   1830          (when (intern-soft major-mode-map) major-mode-map)))))))
   1831   (when-let (command (embark-completing-read-prompter keymap nil 'no-default))
   1832     (call-interactively command)))
   1833 
   1834 ;;;###autoload
   1835 (defun embark-bindings (global)
   1836   "Explore current command key bindings with `completing-read'.
   1837 The selected command will be executed.
   1838 
   1839 This shows key bindings from minor mode maps and the local
   1840 map (usually set by the major mode), but also less common keymaps
   1841 such as those from a text property or overlay, or the overriding
   1842 maps: `overriding-terminal-local-map' and `overriding-local-map'.
   1843 
   1844 Additionally, if GLOBAL is non-nil (interactively, if called with
   1845 a prefix argument), this command includes global key bindings."
   1846   (interactive "P")
   1847   (embark-bindings-in-keymap
   1848    (make-composed-keymap
   1849     (let ((all-maps (current-active-maps t)))
   1850       (if global all-maps (remq global-map all-maps))))))
   1851 
   1852 ;;;###autoload
   1853 (defun embark-bindings-at-point ()
   1854   "Explore all key bindings at point with `completing-read'.
   1855 The selected command will be executed.
   1856 
   1857 This command lists key bindings found in keymaps specified by the
   1858 text properties `keymap' or `local-map', from either buffer text
   1859 or an overlay.  These are not widely used in Emacs, and when they
   1860 are used can be somewhat hard to discover.  Examples of locations
   1861 that have such a keymap are links and images in `eww' buffers,
   1862 attachment links in `gnus' article buffers, and the stash line
   1863 in a `vc-dir' buffer."
   1864   (interactive)
   1865   (if-let ((keymaps (delq nil (list (get-char-property (point) 'keymap)
   1866                                     (get-char-property (point) 'local-map)))))
   1867       (embark-bindings-in-keymap (make-composed-keymap keymaps))
   1868     (user-error "No key bindings found at point")))
   1869 
   1870 ;;;###autoload
   1871 (defun embark-prefix-help-command ()
   1872   "Prompt for and run a command bound in the prefix used for this command.
   1873 The prefix described consists of all but the last event of the
   1874 key sequence that ran this command.  This function is intended to
   1875 be used as a value for `prefix-help-command'.
   1876 
   1877 In addition to using completion to select a command, you can also
   1878 type @ and the key binding (without the prefix)."
   1879   (interactive)
   1880   (when-let ((keys (this-command-keys-vector))
   1881              (prefix (seq-take keys (1- (length keys))))
   1882              (keymap (key-binding prefix 'accept-default)))
   1883     (minibuffer-with-setup-hook
   1884         (lambda ()
   1885           (let ((pt (- (minibuffer-prompt-end) 2)))
   1886             (overlay-put (make-overlay pt pt) 'before-string
   1887                          (format " under %s" (key-description prefix)))))
   1888       (embark-bindings-in-keymap keymap))))
   1889 
   1890 (defun embark--prompt (indicators keymap targets)
   1891   "Call the prompter with KEYMAP and INDICATORS.
   1892 The TARGETS are displayed for actions outside the minibuffer."
   1893   (mapc (lambda (i) (funcall i keymap targets)) indicators)
   1894   (condition-case nil
   1895       (minibuffer-with-setup-hook
   1896           (lambda ()
   1897             ;; if the prompter opens its own minibuffer, show
   1898             ;; the indicator there too
   1899             (let ((inner-indicators (mapcar #'funcall embark-indicators)))
   1900               (mapc (lambda (i) (funcall i keymap targets)) inner-indicators)
   1901               (add-hook 'minibuffer-exit-hook
   1902                         (lambda () (mapc #'funcall inner-indicators))
   1903                         nil t)))
   1904         (let ((enable-recursive-minibuffers t))
   1905           (funcall embark-prompter keymap
   1906                    (lambda (prefix)
   1907                      (mapc (lambda (i) (funcall i keymap targets prefix))
   1908                            indicators)))))
   1909     (quit nil)))
   1910 
   1911 (defvar embark--run-after-command-functions nil
   1912   "Abnormal hook, used by `embark--run-after-command'.")
   1913 
   1914 (defun embark--run-after-command (fn &rest args)
   1915   "Call FN with ARGS after the current commands finishes.
   1916 If multiple functions are queued with this function during the
   1917 same command, they will be called in the order from the one
   1918 queued most recently to the one queued least recently."
   1919   ;; We don't simply add FN to `post-command-hook' because FN may recursively
   1920   ;; call this function.  In that case, FN would modify `post-command-hook'
   1921   ;; from within post-command-hook, which doesn't behave properly in our case.
   1922   ;; We use our own abnormal hook and run it from PCH in a way that it is OK to
   1923   ;; modify it from within its own functions.
   1924   (unless embark--run-after-command-functions
   1925     (let (pch timer has-run)
   1926       (setq pch
   1927             (lambda ()
   1928               (remove-hook 'post-command-hook pch)
   1929               (cancel-timer timer)
   1930               (unless has-run
   1931                 (setq has-run t)
   1932                 (while embark--run-after-command-functions
   1933                   ;; The following funcall may recursively call
   1934                   ;; `embark--run-after-command', modifying
   1935                   ;; `embark--run-after-command-functions'.  This is why this
   1936                   ;; loop has to be implemented carefully.  We have to pop the
   1937                   ;; function off the hook before calling it.  Using `dolist'
   1938                   ;; on the hook would also be incorrect, because it wouldn't
   1939                   ;; take modifications of this hook into account.
   1940                   (with-demoted-errors "embark PCH: %S"
   1941                     (condition-case nil
   1942                         (funcall (pop embark--run-after-command-functions))
   1943                       (quit (message "Quit"))))))))
   1944       (add-hook 'post-command-hook pch 'append)
   1945       ;; Generally we prefer `post-command-hook' because it plays well with
   1946       ;; keyboard macros.  In some cases, `post-command-hook' isn't run after
   1947       ;; exiting a recursive edit, so set up the following timer as a backup.
   1948       (setq timer (run-at-time 0 nil pch))))
   1949 
   1950   ;; Keep the default-directory alive, since this is often overwritten,
   1951   ;; for example by Consult commands.
   1952   ;; TODO it might be necessary to add more dynamically bound variables
   1953   ;; here. What we actually want are functions `capture-dynamic-scope'
   1954   ;; and `eval-in-dynamic-scope', but this does not exist?
   1955   (let ((dir default-directory))
   1956     (push (lambda ()
   1957             (let ((default-directory dir))
   1958               (apply fn args)))
   1959           embark--run-after-command-functions)))
   1960 
   1961 (defun embark--quit-and-run (fn &rest args)
   1962   "Quit the minibuffer and then call FN with ARGS.
   1963 If called outside the minibuffer, simply apply FN to ARGS."
   1964   (if (not (minibufferp))
   1965       (apply fn args)
   1966     (apply #'embark--run-after-command fn args)
   1967     (embark--run-after-command #'set 'ring-bell-function ring-bell-function)
   1968     (setq ring-bell-function #'ignore)
   1969     (if (fboundp 'minibuffer-quit-recursive-edit)
   1970         (minibuffer-quit-recursive-edit)
   1971       (abort-recursive-edit))))
   1972 
   1973 (defun embark--run-action-hooks (hooks action target quit)
   1974   "Run HOOKS for ACTION.
   1975 The HOOKS argument must be alist.  The keys t and :always are
   1976 treated specially.  The :always hooks are executed always and the
   1977 t hooks are the default hooks, for when there are no
   1978 command-specific hooks for ACTION.  The QUIT, ACTION and TARGET
   1979 arguments are passed to the hooks as keyword arguments."
   1980   (mapc (lambda (h) (apply h :action action :quit quit target))
   1981         (or (alist-get action hooks)
   1982             (alist-get t hooks)))
   1983   (mapc (lambda (h) (apply h :action action :quit quit target))
   1984         (alist-get :always hooks)))
   1985 
   1986 (defun embark--run-around-action-hooks
   1987     (action target quit &optional non-interactive)
   1988   "Run the `embark-around-action-hooks' for ACTION.
   1989 All the applicable around hooks are composed in the order they
   1990 are present in `embark-around-action-hooks'.  The keys t and
   1991 :always in `embark-around-action-hooks' are treated specially.
   1992 The :always hooks are executed always (outermost) and the t hooks
   1993 are the default hooks, for when there are no command-specific
   1994 hooks for ACTION.  The QUIT, ACTION and TARGET arguments are
   1995 passed to the hooks as keyword arguments.
   1996 
   1997 The optional argument NON-INTERACTIVE controls whether the action
   1998 is run with `command-execute' or with `funcall' passing the
   1999 target as argument."
   2000   (apply
   2001    (seq-reduce
   2002     (lambda (fn hook)
   2003       (lambda (&rest args) (apply hook (plist-put args :run fn))))
   2004     (let ((hooks embark-around-action-hooks))
   2005       (reverse
   2006        (append (or (alist-get action hooks) (alist-get t hooks))
   2007                (alist-get :always hooks))))
   2008     (if non-interactive
   2009         (lambda (&rest args)
   2010           (funcall (plist-get args :action)
   2011                    (or (plist-get args :candidates) (plist-get args :target))))
   2012       (lambda (&rest args)
   2013         (command-execute (plist-get args :action)))))
   2014    :action action :quit quit target))
   2015 
   2016 (defun embark--act (action target &optional quit)
   2017   "Perform ACTION injecting the TARGET.
   2018 If called from a minibuffer with non-nil QUIT, quit the
   2019 minibuffer before executing the action."
   2020   (if (memq action '(embark-become       ; these actions should run in
   2021                      embark-collect      ; the current buffer, not the
   2022                      embark-live         ; target buffer
   2023                      embark-export
   2024                      embark-select
   2025                      embark-act-all))
   2026       (progn
   2027         (embark--run-action-hooks embark-pre-action-hooks action target quit)
   2028         (unwind-protect (embark--run-around-action-hooks action target quit)
   2029           (embark--run-action-hooks embark-post-action-hooks
   2030                                     action target quit)))
   2031     (let* ((command embark--command)
   2032            (prefix prefix-arg)
   2033            (action-window (embark--target-window t))
   2034            (directory default-directory)
   2035            (inject
   2036             (lambda ()
   2037               (let ((contents (minibuffer-contents)))
   2038                 (delete-minibuffer-contents)
   2039                 (insert
   2040                  (propertize
   2041                   (substring-no-properties (plist-get target :target))
   2042                   'embark--initial-input contents)))
   2043               (if (memq 'ivy--queue-exhibit post-command-hook)
   2044                   ;; Ivy has special needs: (1) for file names
   2045                   ;; ivy-immediate-done is not equivalent to
   2046                   ;; exit-minibuffer, (2) it needs a chance to run
   2047                   ;; its post command hook first, so use depth 10
   2048                   (add-hook 'post-command-hook 'ivy-immediate-done 10 t)
   2049                 (add-hook 'post-command-hook #'exit-minibuffer nil t))
   2050               (embark--run-action-hooks embark-target-injection-hooks
   2051                                         action target quit)))
   2052            (dedicate (and (derived-mode-p 'embark-collect-mode)
   2053                           (not (window-dedicated-p))
   2054                           (selected-window)))
   2055            (multi (memq action embark-multitarget-actions))
   2056            (run-action
   2057             (if (and (commandp action) (not multi))
   2058                 (lambda ()
   2059                   (let (final-window)
   2060                     (when dedicate (set-window-dedicated-p dedicate t))
   2061                     (unwind-protect
   2062                         (with-selected-window action-window
   2063                           (let ((enable-recursive-minibuffers t)
   2064                                 (embark--command command)
   2065                                 (prefix-arg prefix)
   2066                                 ;; the next two avoid mouse dialogs
   2067                                 (use-dialog-box nil)
   2068                                 (last-nonmenu-event 13)
   2069                                 (default-directory directory))
   2070                             (embark--run-action-hooks embark-pre-action-hooks
   2071                                                       action target quit)
   2072                             (minibuffer-with-setup-hook inject
   2073                               ;; pacify commands that use (this-command-keys)
   2074                               (when (= (length (this-command-keys)) 0)
   2075                                 (set--this-command-keys
   2076                                  (if (characterp last-command-event)
   2077                                      (string last-command-event)
   2078                                   "\r")))
   2079                               (setq this-command action)
   2080                               (embark--run-around-action-hooks
   2081                                action target quit)))
   2082                           (setq final-window (selected-window)))
   2083                       (embark--run-action-hooks embark-post-action-hooks
   2084                                                 action target quit)
   2085                       (when dedicate (set-window-dedicated-p dedicate nil)))
   2086                     (unless (eq final-window action-window)
   2087                       (select-window final-window))))
   2088               (let ((target
   2089                      (if (and multi (null (plist-get target :candidates)))
   2090                          (plist-put
   2091                           target :candidates (list (plist-get target :target)))
   2092                        target)))
   2093                 (lambda ()
   2094                   (with-selected-window action-window
   2095                     (embark--run-action-hooks embark-pre-action-hooks
   2096                                               action target quit)
   2097                     (unwind-protect
   2098                         (let ((current-prefix-arg prefix)
   2099                               (default-directory directory))
   2100                           (embark--run-around-action-hooks
   2101                            action target quit :non-interactive))
   2102                       (embark--run-action-hooks embark-post-action-hooks
   2103                                                 action target quit))))))))
   2104       (setq prefix-arg nil)
   2105       (if quit (embark--quit-and-run run-action) (funcall run-action)))))
   2106 
   2107 (defun embark--refine-multi-category (_type target)
   2108   "Refine `multi-category' TARGET to its actual type."
   2109   (or (get-text-property 0 'multi-category target)
   2110       (cons 'general target)))
   2111 
   2112 (defun embark--simplify-path (_type target)
   2113   "Simplify and '//' or '~/' in the TARGET file path."
   2114   (cons 'file (substitute-in-file-name target)))
   2115 
   2116 (defun embark--keybinding-command (_type target)
   2117   "Treat an `embark-keybinding' TARGET as a command."
   2118   (when-let ((cmd (get-text-property 0 'embark-command target)))
   2119     (cons 'command (format "%s" cmd))))
   2120 
   2121 (defun embark--lookup-lighter-minor-mode (_type target)
   2122   "If TARGET is a lighter, look up its minor mode.
   2123 
   2124 The `describe-minor-mode' command has as completion candidates
   2125 both minor-modes and their lighters.  This function replaces the
   2126 lighters by their minor modes, so actions expecting a function
   2127 work on them."
   2128   (cons 'minor-mode
   2129         (let ((symbol (intern-soft target)))
   2130           (if (and symbol (boundp symbol))
   2131               target
   2132             (symbol-name (lookup-minor-mode-from-indicator target))))))
   2133 
   2134 (declare-function project-current "project")
   2135 (declare-function project-roots "project")
   2136 (declare-function project-root "project")
   2137 
   2138 (defun embark--project-file-full-path (_type target)
   2139   "Get full path of project file TARGET."
   2140   ;; TODO project-find-file can be called from outside all projects in
   2141   ;; which case it prompts for a project first; we don't support that
   2142   ;; case yet, since there is no current project.
   2143   (cons 'file
   2144         (if-let ((project (project-current))
   2145                  (root (if (fboundp 'project-root)
   2146                            (project-root project)
   2147                          (with-no-warnings
   2148                            (car (project-roots project))))))
   2149             (expand-file-name target root)
   2150           target)))
   2151 
   2152 (defun embark--remove-package-version (_type target)
   2153   "Remove version number from a versioned package TARGET."
   2154   (cons 'package (replace-regexp-in-string "-[0-9.]+$" "" target)))
   2155 
   2156 (defun embark--targets ()
   2157   "Retrieve current targets.
   2158 
   2159 An initial guess at the current targets and their types is
   2160 determined by running the functions in `embark-target-finders'.
   2161 Each function should either return nil, a pair of a type symbol
   2162 and target string or a triple of a type symbol, target string and
   2163 target bounds.
   2164 
   2165 In the minibuffer only the first target finder returning non-nil
   2166 is taken into account.  When finding targets at point in other
   2167 buffers, all target finder functions are executed.
   2168 
   2169 For each target, the type is then looked up as a key in the
   2170 variable `embark-transformer-alist'.  If there is a transformer
   2171 for the type, it is called with the type and target, and must
   2172 return a `cons' of the transformed type and transformed target.
   2173 
   2174 The return value of `embark--targets' is a list of plists.  Each
   2175 plist concerns one target, and has keys `:type', `:target',
   2176 `:orig-type', `:orig-target' and `:bounds'."
   2177   (let (targets)
   2178     (run-hook-wrapped
   2179      'embark-target-finders
   2180      (lambda (fun)
   2181        (dolist (found (when-let (result (funcall fun))
   2182                         (if (consp (car result)) result (list result))))
   2183          (let* ((type (or (car found) 'general))
   2184                 (target+bounds (cdr found))
   2185                 (target (if (consp target+bounds)
   2186                             (car target+bounds)
   2187                           target+bounds))
   2188                 (bounds (and (consp target+bounds) (cdr target+bounds)))
   2189                 (full-target
   2190                  (append
   2191                   (list :orig-type type :orig-target target :bounds bounds)
   2192                   (if-let (transform (alist-get type embark-transformer-alist))
   2193                       (let ((trans (funcall transform type target)))
   2194                         (list :type (car trans) :target (cdr trans)))
   2195                     (list :type type :target target)))))
   2196            (push full-target targets)))
   2197        (and targets (minibufferp))))
   2198     (nreverse
   2199      (cl-delete-duplicates ; keeps last duplicate, but we reverse
   2200       targets
   2201       :test (lambda (t1 t2)
   2202               (and (equal (plist-get t1 :target) (plist-get t2 :target))
   2203                    (eq (plist-get t1 :type) (plist-get t2 :type))))))))
   2204 
   2205 (defun embark--default-action (type)
   2206   "Return default action for the given TYPE of target.
   2207 The most common case is that the target comes from minibuffer
   2208 completion, in which case the default action is the command that
   2209 opened the minibuffer in the first place.  This can be overridden
   2210 by `embark-default-action-overrides'.
   2211 
   2212 For targets that do not come from minibuffer completion
   2213 \(typically some thing at point in a regular buffer) and whose
   2214 type is not listed in `embark-default-action-overrides', the
   2215 default action is given by whatever binding RET has in the action
   2216 keymap for the given type."
   2217   (or (alist-get (cons type embark--command) embark-default-action-overrides
   2218                  nil nil #'equal)
   2219       (alist-get type embark-default-action-overrides)
   2220       (alist-get t embark-default-action-overrides)
   2221       embark--command
   2222       (lookup-key (embark--raw-action-keymap type) "\r")))
   2223 
   2224 (defun embark--rotate (list k)
   2225   "Rotate LIST by K elements and return the rotated list."
   2226   (setq k (mod k (length list)))
   2227   (append (seq-drop list k) (seq-take list k)))
   2228 
   2229 (defun embark--orig-target (target)
   2230   "Convert TARGET to original target."
   2231   (plist-put
   2232    (plist-put
   2233     (copy-sequence target)
   2234     :target (plist-get target :orig-target))
   2235    :type (plist-get target :orig-type)))
   2236 
   2237 (defun embark--quit-p (action)
   2238   "Determine whether to quit the minibuffer after ACTION.
   2239 This function consults `embark-quit-after-action' to decide
   2240 whether or not the user wishes to quit the minibuffer after
   2241 performing the ACTION, assuming this is done from a minibuffer."
   2242   (let* ((cfg embark-quit-after-action)
   2243          (quit (if (consp cfg) (alist-get action cfg (alist-get t cfg)) cfg)))
   2244     (when embark--toggle-quit (setq quit (not quit)))
   2245     (setq embark--toggle-quit nil)
   2246     quit))
   2247 
   2248 ;;;###autoload
   2249 (defun embark-act (&optional arg)
   2250   "Prompt the user for an action and perform it.
   2251 The targets of the action are chosen by `embark-target-finders'.
   2252 By default, if called from a minibuffer the target is the top
   2253 completion candidate.  When called from a non-minibuffer buffer
   2254 there can multiple targets and you can cycle among them by using
   2255 `embark-cycle' (which is bound by default to the same key
   2256 binding `embark-act' is, but see `embark-cycle-key').
   2257 
   2258 This command uses `embark-prompter' to ask the user to specify an
   2259 action, and calls it injecting the target at the first minibuffer
   2260 prompt.
   2261 
   2262 If you call this from the minibuffer, it can optionally quit the
   2263 minibuffer.  The variable `embark-quit-after-action' controls
   2264 whether calling `embark-act' with nil ARG quits the minibuffer,
   2265 and if ARG is non-nil it will do the opposite.  Interactively,
   2266 ARG is the prefix argument.
   2267 
   2268 If instead you call this from outside the minibuffer, the first
   2269 ARG targets are skipped over (if ARG is negative the skipping is
   2270 done by cycling backwards) and cycling starts from the following
   2271 target."
   2272   (interactive "P")
   2273   (let* ((targets (or (embark--targets) (user-error "No target found")))
   2274          (indicators (mapcar #'funcall embark-indicators))
   2275          (default-done nil))
   2276     (when arg
   2277       (if (minibufferp)
   2278           (embark-toggle-quit)
   2279         (setq targets (embark--rotate targets (prefix-numeric-value arg)))))
   2280     (unwind-protect
   2281         (while
   2282             (let* ((target (car targets))
   2283                    (action
   2284                     (or (embark--prompt
   2285                          indicators
   2286                          (let ((embark-default-action-overrides
   2287                                 (if default-done
   2288                                     `((t . ,default-done))
   2289                                   embark-default-action-overrides)))
   2290                            (embark--action-keymap (plist-get target :type)
   2291                                                   (cdr targets)))
   2292                          targets)
   2293                         (user-error "Canceled")))
   2294                    (default-action (or default-done
   2295                                        (embark--default-action
   2296                                         (plist-get target :type)))))
   2297               (cond
   2298                ;; When acting twice in the minibuffer, do not restart
   2299                ;; `embark-act'.  Otherwise the next `embark-act' will
   2300                ;; find a target in the original buffer.
   2301                ((eq action #'embark-act)
   2302                 (message "Press an action key"))
   2303                ((eq action #'embark-cycle)
   2304                 (setq targets (embark--rotate
   2305                                targets (prefix-numeric-value prefix-arg))))
   2306                (t
   2307                 ;; if the action is non-repeatable, cleanup indicator now
   2308                 (let ((repeat (embark--action-repeatable-p action)))
   2309                   (unless repeat (mapc #'funcall indicators))
   2310                   (condition-case err
   2311                       (embark--act
   2312                        action
   2313                        (if (and (eq action default-action)
   2314                                 (eq action embark--command)
   2315                                 (not (memq action embark-multitarget-actions)))
   2316                            (embark--orig-target target)
   2317                          target)
   2318                        (embark--quit-p action))
   2319                     (user-error
   2320                      (funcall (if repeat #'message #'user-error)
   2321                               "%s" (cadr err))))
   2322                   (when-let (new-targets (and repeat (embark--targets)))
   2323                     ;; Terminate repeated prompter on default action,
   2324                     ;; when repeating. Jump to the region type if the
   2325                     ;; region is active after the action, or else to the
   2326                     ;; current type again.
   2327                     (setq default-done #'embark-done
   2328                           targets
   2329                           (embark--rotate
   2330                            new-targets
   2331                            (or (cl-position-if
   2332                                 (let ((desired-type
   2333                                        (if (eq repeat t)
   2334                                            (plist-get (car targets) :type)
   2335                                          repeat)))
   2336                                   (lambda (x)
   2337                                     (eq (plist-get x :type) desired-type)))
   2338                                 new-targets)
   2339                                0)))))))))
   2340       (mapc #'funcall indicators))))
   2341 
   2342 (defun embark--maybe-transform-candidates ()
   2343   "Collect candidates and see if they all transform to the same type.
   2344 Return a plist with keys `:type', `:orig-type', `:candidates', and
   2345 `:orig-candidates'."
   2346   (pcase-let* ((`(,type . ,candidates)
   2347                 (run-hook-with-args-until-success 'embark-candidate-collectors))
   2348                (bounds (mapcar #'cdr-safe candidates)))
   2349     (setq candidates
   2350           (mapcar (lambda (x) (if (consp x) (car x) x)) candidates))
   2351     (when (eq type 'file)
   2352       (let ((dir (embark--default-directory)))
   2353         (setq candidates
   2354               (mapcar (lambda (cand)
   2355                         (abbreviate-file-name
   2356                          (expand-file-name (substitute-in-file-name cand) dir)))
   2357                       candidates))))
   2358     ;; TODO more systematic approach to applying substitute-in-file-name
   2359     (append
   2360      (list :orig-type type :orig-candidates candidates :bounds bounds)
   2361      (or (when candidates
   2362            (when-let ((transformer (alist-get type embark-transformer-alist)))
   2363              (pcase-let* ((`(,new-type . ,first-cand)
   2364                            (funcall transformer type (car candidates))))
   2365                (let ((new-candidates (list first-cand)))
   2366                  (when (cl-every
   2367                         (lambda (cand)
   2368                           (pcase-let ((`(,t-type . ,t-cand)
   2369                                        (funcall transformer type cand)))
   2370                             (when (eq t-type new-type)
   2371                               (push t-cand new-candidates)
   2372                               t)))
   2373                         (cdr candidates))
   2374                    (list :type new-type
   2375                          :candidates (nreverse new-candidates)))))))
   2376          (list :type type :candidates candidates)))))
   2377 
   2378 ;;;###autoload
   2379 (defun embark-act-all (&optional arg)
   2380   "Prompt the user for an action and perform it on each candidate.
   2381 The candidates are chosen by `embark-candidate-collectors'.  By
   2382 default, if `embark-select' has been used to select some
   2383 candidates, then `embark-act-all' will act on those candidates;
   2384 otherwise, if the selection is empty and `embark-act-all' is
   2385 called from a minibuffer, then the candidates are the completion
   2386 candidates.
   2387 
   2388 This command uses `embark-prompter' to ask the user to specify an
   2389 action, and calls it injecting the target at the first minibuffer
   2390 prompt.
   2391 
   2392 If you call this from the minibuffer, it can optionally quit the
   2393 minibuffer.  The variable `embark-quit-after-action' controls
   2394 whether calling `embark-act' with nil ARG quits the minibuffer,
   2395 and if ARG is non-nil it will do the opposite.  Interactively,
   2396 ARG is the prefix argument."
   2397   (interactive "P")
   2398   (let* ((transformed (embark--maybe-transform-candidates))
   2399          (type (plist-get transformed :type))
   2400          (orig-type (plist-get transformed :orig-type))
   2401          (candidates
   2402           (or (cl-mapcar
   2403                (lambda (cand orig-cand bounds)
   2404                  (list :type type :target cand
   2405                        :bounds (when bounds
   2406                                  (cons (copy-marker (car bounds))
   2407                                        (copy-marker (cdr bounds))))
   2408                        :orig-type orig-type :orig-target orig-cand))
   2409                (plist-get transformed :candidates)
   2410                (plist-get transformed :orig-candidates)
   2411                (plist-get transformed :bounds))
   2412               (user-error "No candidates to act on")))
   2413          (indicators (mapcar #'funcall embark-indicators)))
   2414     (when arg (embark-toggle-quit))
   2415     (unwind-protect
   2416         (let* ((action
   2417                 (or (embark--prompt
   2418                      indicators (embark--action-keymap type nil)
   2419                      (list (list :type type :multi (length candidates))))
   2420                     (user-error "Canceled")))
   2421                (prefix prefix-arg)
   2422                (act (lambda (candidate)
   2423                       (cl-letf (((symbol-function 'embark--restart) #'ignore)
   2424                                 ((symbol-function 'embark--confirm) #'ignore))
   2425                         (let ((prefix-arg prefix))
   2426                           (when-let ((bounds (plist-get candidate :bounds)))
   2427                             (goto-char (car bounds)))
   2428                           (embark--act action candidate)))))
   2429                (quit (embark--quit-p action)))
   2430           (when (and (eq action (embark--default-action type))
   2431                      (eq action embark--command))
   2432             (setq candidates (mapcar #'embark--orig-target candidates)))
   2433           (when (or (not (or embark-confirm-act-all
   2434                              (memq 'embark--confirm
   2435                                    (alist-get action embark-pre-action-hooks))))
   2436                     (y-or-n-p (format "Run %s on %d %ss? "
   2437                                       action (length candidates) type)))
   2438             (if (memq action embark-multitarget-actions)
   2439                 (let ((prefix-arg prefix))
   2440                   (embark--act action transformed quit))
   2441               (save-excursion
   2442                 (if quit
   2443                     (embark--quit-and-run #'mapc act candidates)
   2444                   (mapc act candidates))))
   2445             (when (and (not quit)
   2446                        (memq 'embark--restart
   2447                              (alist-get action embark-post-action-hooks)))
   2448               (embark--restart))))
   2449       (dolist (cand candidates)
   2450         (when-let ((bounds (plist-get cand :bounds)))
   2451           (set-marker (car bounds) nil) ; yay, manual memory management!
   2452           (set-marker (cdr bounds) nil)))
   2453       (setq prefix-arg nil)
   2454       (mapc #'funcall indicators))))
   2455 
   2456 (defun embark-highlight-indicator ()
   2457   "Action indicator highlighting the target at point."
   2458   (let (overlay)
   2459     (lambda (&optional keymap targets _prefix)
   2460       (let ((bounds (plist-get (car targets) :bounds)))
   2461         (when (and overlay (or (not keymap) (not bounds)))
   2462           (delete-overlay overlay)
   2463           (setq overlay nil))
   2464         (when bounds
   2465           (if overlay
   2466               (move-overlay overlay (car bounds) (cdr bounds))
   2467             (setq overlay (make-overlay (car bounds) (cdr bounds)))
   2468             (overlay-put overlay 'category 'embark-target-overlay))
   2469           (overlay-put overlay 'window (selected-window)))))))
   2470 
   2471 (defun embark-isearch-highlight-indicator ()
   2472   "Action indicator highlighting all occurrences of the identifier at point.
   2473 This indicator only does something for targets which are
   2474 identifiers or symbols.  For those it uses `isearch''s lazy
   2475 highlighting feature to highlight all occurrences of the target in
   2476 the buffer.  This indicator is best used in conjunction with
   2477 `embark-highlight-indicator': by using them both you get the
   2478 target and the other occurrences of it highlighted in different
   2479 colors."
   2480   (lambda (&optional _keymap targets _prefix)
   2481     (if (and (not (minibufferp))
   2482              (memq (plist-get (car targets) :orig-type) '(symbol identifier)))
   2483         (let ((isearch-string (plist-get (car targets) :target))
   2484               (isearch-regexp-function #'isearch-symbol-regexp))
   2485           (isearch-lazy-highlight-new-loop))
   2486       (setq isearch-lazy-highlight-last-string nil)
   2487       (lazy-highlight-cleanup t))))
   2488 
   2489 (defun embark-cycle (_arg)
   2490   "Cycle over the next ARG targets at point.
   2491 If ARG is negative, cycle backwards."
   2492   (interactive "p")
   2493   (user-error "Not meant to be called directly"))
   2494 
   2495 (defun embark-done ()
   2496   "Terminate sequence of repeated actions."
   2497   (interactive))
   2498 
   2499 ;;;###autoload
   2500 (defun embark-dwim (&optional arg)
   2501   "Run the default action on the current target.
   2502 The target of the action is chosen by `embark-target-finders'.
   2503 
   2504 If the target comes from minibuffer completion, then the default
   2505 action is the command that opened the minibuffer in the first
   2506 place, unless overridden by `embark-default-action-overrides'.
   2507 
   2508 For targets that do not come from minibuffer completion
   2509 \(typically some thing at point in a regular buffer) and whose
   2510 type is not listed in `embark-default-action-overrides', the
   2511 default action is given by whatever binding RET has in the action
   2512 keymap for the target's type.
   2513 
   2514 See `embark-act' for the meaning of the prefix ARG."
   2515   (interactive "P")
   2516   (if-let ((targets (embark--targets)))
   2517       (let* ((target
   2518               (or (nth
   2519                    (if (or (null arg) (minibufferp))
   2520                        0
   2521                      (mod (prefix-numeric-value arg) (length targets)))
   2522                    targets)))
   2523              (type (plist-get target :type))
   2524              (default-action (embark--default-action type))
   2525              (action (or (command-remapping default-action) default-action)))
   2526         (unless action
   2527           (user-error "No default action for %s targets" type))
   2528         (when (and arg (minibufferp)) (setq embark--toggle-quit t))
   2529         (embark--act action
   2530                      (if (and (eq default-action embark--command)
   2531                               (not (memq default-action
   2532                                          embark-multitarget-actions)))
   2533                          (embark--orig-target target)
   2534                        target)
   2535                      (embark--quit-p action)))
   2536     (user-error "No target found")))
   2537 
   2538 (defun embark--become-keymap ()
   2539   "Return keymap of commands to become for current command."
   2540   (let ((map (make-composed-keymap
   2541               (cl-loop for keymap-name in embark-become-keymaps
   2542                        for keymap = (symbol-value keymap-name)
   2543                        when (where-is-internal embark--command (list keymap))
   2544                        collect keymap))))
   2545     (when embark-help-key
   2546       (keymap-set map embark-help-key #'embark-keymap-help))
   2547     map))
   2548 
   2549 ;;;###autoload
   2550 (defun embark-become (&optional full)
   2551   "Make current command become a different command.
   2552 Take the current minibuffer input as initial input for new
   2553 command.  The new command can be run normally using key bindings or
   2554 \\[execute-extended-command], but if the current command is found in a keymap in
   2555 `embark-become-keymaps', that keymap is activated to provide
   2556 convenient access to the other commands in it.
   2557 
   2558 If FULL is non-nil (interactively, if called with a prefix
   2559 argument), the entire minibuffer contents are used as the initial
   2560 input of the new command.  By default only the part of the
   2561 minibuffer contents between the current completion boundaries is
   2562 taken.  What this means is fairly technical, but (1) usually
   2563 there is no difference: the completion boundaries include the
   2564 entire minibuffer contents, and (2) the most common case where
   2565 these notions differ is file completion, in which case the
   2566 completion boundaries single out the path component containing
   2567 point."
   2568   (interactive "P")
   2569   (unless (minibufferp)
   2570     (user-error "Not in a minibuffer"))
   2571   (let* ((target (embark--display-string ; remove invisible portions
   2572                   (if full
   2573                       (minibuffer-contents)
   2574                     (pcase-let ((`(,beg . ,end) (embark--boundaries)))
   2575                       (substring (minibuffer-contents) beg
   2576                                  (+ end (embark--minibuffer-point)))))))
   2577          (keymap (embark--become-keymap))
   2578          (targets `((:type embark-become :target ,target)))
   2579          (indicators (mapcar #'funcall embark-indicators))
   2580          (become (unwind-protect
   2581                      (embark--prompt indicators keymap targets)
   2582                    (mapc #'funcall indicators))))
   2583     (unless become
   2584       (user-error "Canceled"))
   2585     (embark--become-command become target)))
   2586 
   2587 (defun embark--become-command (command input)
   2588   "Quit current minibuffer and start COMMAND with INPUT."
   2589   (embark--quit-and-run
   2590    (lambda ()
   2591      (minibuffer-with-setup-hook
   2592          (lambda ()
   2593            (delete-minibuffer-contents)
   2594            (insert input))
   2595        (let ((use-dialog-box nil) ;; avoid mouse dialogs
   2596              (last-nonmenu-event 13))
   2597          (setq this-command command)
   2598          (command-execute command))))))
   2599 
   2600 ;;; Embark collect
   2601 
   2602 (defgroup embark-collect nil
   2603   "Buffers for acting on collected Embark targets."
   2604   :group 'embark)
   2605 
   2606 (defcustom embark-candidate-collectors
   2607   '(embark-selected-candidates
   2608     embark-minibuffer-candidates
   2609     embark-completion-list-candidates
   2610     embark-dired-candidates
   2611     embark-ibuffer-candidates
   2612     embark-embark-collect-candidates
   2613     embark-custom-candidates)
   2614   "List of functions that collect all candidates in a given context.
   2615 These are used to fill an Embark Collect buffer.  Each function
   2616 should return either nil (to indicate it found no candidates) or
   2617 a list whose first element is a symbol indicating the type of
   2618 candidates and whose `cdr' is the list of candidates, each of
   2619 which should be either a string or a dotted list of the
   2620 form (TARGET START . END), where START and END are the buffer
   2621 positions bounding the TARGET string."
   2622   :type 'hook)
   2623 
   2624 (defcustom embark-exporters-alist
   2625   '((buffer . embark-export-ibuffer)
   2626     (file . embark-export-dired)
   2627     (package . embark-export-list-packages)
   2628     (bookmark . embark-export-bookmarks)
   2629     (variable . embark-export-customize-variable)
   2630     (face . embark-export-customize-face)
   2631     (symbol . embark-export-apropos)
   2632     (minor-mode . embark-export-apropos)
   2633     (function . embark-export-apropos)
   2634     (command . embark-export-apropos)
   2635     (t . embark-collect))
   2636   "Alist associating completion types to export functions.
   2637 Each function should take a list of strings which are candidates
   2638 for actions and make a buffer appropriate to manage them.  For
   2639 example, the default is to make a Dired buffer for files, and an
   2640 ibuffer for buffers.
   2641 
   2642 The key t is also allowed in the alist, and the corresponding
   2643 value indicates the default function to use for other types.  The
   2644 default is `embark-collect'"
   2645   :type '(alist :key-type symbol :value-type function))
   2646 
   2647 (defcustom embark-after-export-hook nil
   2648   "Hook run after `embark-export' in the newly created buffer."
   2649   :type 'hook)
   2650 
   2651 (defface embark-collect-candidate '((t :inherit default))
   2652   "Face for candidates in Embark Collect buffers.")
   2653 
   2654 (defface embark-collect-group-title
   2655   '((t :inherit shadow :slant italic))
   2656   "Face for group titles in Embark Collect buffers.")
   2657 
   2658 (defface embark-collect-group-separator
   2659   '((t :inherit shadow :strike-through t italic))
   2660   "Face for group titles in Embark Collect buffers.")
   2661 
   2662 (defcustom embark-collect-group-format
   2663   (concat
   2664    (propertize "    " 'face 'embark-collect-group-separator)
   2665    (propertize " %s " 'face 'embark-collect-group-title)
   2666    (propertize " " 'face 'completions-group-separator
   2667                'display '(space :align-to right)))
   2668   "Format string used for the group title in Embark Collect buffers."
   2669   :type 'string)
   2670 
   2671 (defface embark-collect-annotation '((t :inherit completions-annotations))
   2672   "Face for annotations in Embark Collect.
   2673 This is only used for annotation that are not already fontified.")
   2674 
   2675 (defvar-local embark--rerun-function nil
   2676   "Function to rerun the collect or export that made the current buffer.")
   2677 
   2678 (autoload 'package-delete "package")
   2679 (declare-function package--from-builtin "package")
   2680 (declare-function package-desc-extras "package")
   2681 (declare-function package-desc-name "package")
   2682 (defvar package--builtins)
   2683 (defvar package-alist)
   2684 (defvar package-archive-contents)
   2685 (defvar package--initialized)
   2686 
   2687 (defun embark--package-desc (pkg)
   2688   "Return the description structure for package PKG."
   2689   (or ; found this in `describe-package-1'
   2690    (car (alist-get pkg package-alist))
   2691    (if-let ((built-in (assq pkg package--builtins)))
   2692            (package--from-builtin built-in)
   2693            (car (alist-get pkg package-archive-contents)))))
   2694 
   2695 (defun embark-minibuffer-candidates ()
   2696   "Return all current completion candidates from the minibuffer."
   2697   (when (minibufferp)
   2698     (let* ((all (completion-all-completions
   2699                  (minibuffer-contents)
   2700                  minibuffer-completion-table
   2701                  minibuffer-completion-predicate
   2702                  (embark--minibuffer-point)))
   2703            (last (last all)))
   2704       (when last (setcdr last nil))
   2705       (cons
   2706        (completion-metadata-get (embark--metadata) 'category)
   2707        all))))
   2708 
   2709 (defun embark-sorted-minibuffer-candidates ()
   2710   "Return a sorted list of current minibuffer completion candidates.
   2711 This using the same sort order that `icomplete' and
   2712 `minibuffer-force-complete' use.  The intended usage is that you
   2713 replace `embark-minibuffer-candidates' with this function in the
   2714 list `embark-candidate-collectors'."
   2715   (when (minibufferp)
   2716     (cons
   2717      (completion-metadata-get (embark--metadata) 'category)
   2718      (nconc (cl-copy-list (completion-all-sorted-completions)) nil))))
   2719 
   2720 (declare-function dired-get-marked-files "dired")
   2721 (declare-function dired-move-to-filename "dired")
   2722 (declare-function dired-move-to-end-of-filename "dired")
   2723 
   2724 (defun embark-dired-candidates ()
   2725   "Return marked or all files shown in Dired buffer.
   2726 If any buffer is marked, return marked buffers; otherwise, return
   2727 all buffers."
   2728   (when (derived-mode-p 'dired-mode)
   2729     (cons 'file
   2730           (or
   2731            ;; dired-get-marked-files returns the file on the current
   2732            ;; line if no marked files are found; and when the fourth
   2733            ;; argument is non-nil, the "no marked files" case is
   2734            ;; distinguished from the "single marked file" case by
   2735            ;; returning (list t marked-file) in the latter
   2736            (let ((marked (dired-get-marked-files t nil nil t)))
   2737              (and (cdr marked)
   2738                   (if (eq (car marked) t) (cdr marked) marked)))
   2739            (save-excursion
   2740              (goto-char (point-min))
   2741              (let (files)
   2742                (while (not (eobp))
   2743                  (when-let (file (dired-get-filename t t))
   2744                    (push `(,file
   2745                            ,(progn (dired-move-to-filename) (point))
   2746                            . ,(progn (dired-move-to-end-of-filename t) (point)))
   2747                          files))
   2748                  (forward-line))
   2749                (nreverse files)))))))
   2750 
   2751 (autoload 'ibuffer-marked-buffer-names "ibuffer")
   2752 (declare-function ibuffer-map-lines-nomodify "ibuffer")
   2753 
   2754 (defun embark-ibuffer-candidates ()
   2755   "Return marked or all buffers listed in ibuffer buffer.
   2756 If any buffer is marked, return marked buffers; otherwise, return
   2757 all buffers."
   2758   (when (derived-mode-p 'ibuffer-mode)
   2759     (cons 'buffer
   2760           (or (ibuffer-marked-buffer-names)
   2761               (let (buffers)
   2762                 (ibuffer-map-lines-nomodify
   2763                  (lambda (buffer _mark)
   2764                    (push (buffer-name buffer) buffers)))
   2765                 (nreverse buffers))))))
   2766 
   2767 (defun embark-embark-collect-candidates ()
   2768   "Return candidates in Embark Collect buffer.
   2769 This makes `embark-export' work in Embark Collect buffers."
   2770   (when (derived-mode-p 'embark-collect-mode)
   2771     (cons embark--type
   2772           (save-excursion
   2773             (goto-char (point-min))
   2774             (let (all)
   2775               (when-let ((cand (embark-target-collect-candidate)))
   2776                 (push (cdr cand) all))
   2777               (while (forward-button 1 nil nil t)
   2778                 (when-let ((cand (embark-target-collect-candidate)))
   2779                   (push (cdr cand) all)))
   2780               (nreverse all))))))
   2781 
   2782 (defun embark-completion-list-candidates ()
   2783   "Return all candidates in a completions buffer."
   2784   (when (derived-mode-p 'completion-list-mode)
   2785     (cons
   2786      embark--type
   2787      (save-excursion
   2788        (goto-char (point-min))
   2789        (next-completion 1)
   2790        (let (all)
   2791          (while (not (eobp))
   2792            (push (cdr (embark-target-completion-list-candidate)) all)
   2793            (next-completion 1))
   2794          (nreverse all))))))
   2795 
   2796 (defun embark-custom-candidates ()
   2797   "Return all variables and faces listed in this `Custom-mode' buffer."
   2798   (when (derived-mode-p 'Custom-mode)
   2799     (cons 'symbol ; gets refined to variable or face when acted upon
   2800           (save-excursion
   2801             (goto-char (point-min))
   2802             (let (symbols)
   2803               (while (not (eobp))
   2804                 (when-let (widget (widget-at (point)))
   2805                   (when (eq (car widget) 'custom-visibility)
   2806                     (push
   2807                      `(,(symbol-name
   2808                          (plist-get (cdr (plist-get (cdr widget) :parent))
   2809                                     :value))
   2810                        ,(point)
   2811                        . ,(progn
   2812                             (re-search-forward ":" (line-end-position) 'noerror)
   2813                             (point)))
   2814                      symbols)))
   2815                 (forward-line))
   2816               (nreverse symbols))))))
   2817 
   2818 
   2819 (defun embark-collect--target ()
   2820   "Return the Embark Collect candidate at point.
   2821 This takes into account `embark-transformer-alist'."
   2822   (let ((embark-target-finders '(embark-target-collect-candidate)))
   2823     (car (embark--targets))))
   2824 
   2825 (defun embark--action-command (action)
   2826   "Turn an ACTION into a command to perform the action.
   2827 Returns the name of the command."
   2828   (let ((name (intern (format "embark-action--%s"
   2829                               (embark--command-name action)))))
   2830     (fset name (lambda (arg)
   2831                  (interactive "P")
   2832                  (when-let (target (embark-collect--target))
   2833                    (let ((prefix-arg arg))
   2834                      (embark--act action target)))))
   2835     (when (fboundp action)
   2836       (put name 'function-documentation (documentation action)))
   2837     name))
   2838 
   2839 (defun embark--all-bindings (keymap &optional nested)
   2840   "Return an alist of all bindings in KEYMAP.
   2841 If NESTED is non-nil subkeymaps are not flattened."
   2842   (let (bindings maps)
   2843     (map-keymap
   2844      (lambda (key def)
   2845        (cond
   2846         ((keymapp def)
   2847          (if nested
   2848              (push (cons (vector key) def) maps)
   2849            (dolist (bind (embark--all-bindings def))
   2850              (push (cons (vconcat (vector key) (car bind)) (cdr bind))
   2851                    maps))))
   2852         (def (push (cons (vector key) def) bindings))))
   2853      (keymap-canonicalize keymap))
   2854     (nconc (nreverse bindings) (nreverse maps))))
   2855 
   2856 (defun embark-collect--direct-action-map (type)
   2857   "Return a direct action keymap for targets of given TYPE."
   2858   (let* ((actions (embark--action-keymap type nil))
   2859          (map (make-sparse-keymap)))
   2860     (set-keymap-parent map button-map)
   2861     (pcase-dolist (`(,key . ,cmd) (embark--all-bindings actions))
   2862       (unless (or (equal key [13])
   2863                   (memq cmd '(digit-argument negative-argument)))
   2864         (define-key map key (if (eq cmd 'embark-keymap-help)
   2865                                 #'embark-bindings-at-point
   2866                               (embark--action-command cmd)))))
   2867     map))
   2868 
   2869 (define-minor-mode embark-collect-direct-action-minor-mode
   2870   "Bind type-specific actions directly (without need for `embark-act')."
   2871   :init-value nil
   2872   :lighter " Act"
   2873   (unless (derived-mode-p 'embark-collect-mode)
   2874     (user-error "Not in an Embark Collect buffer"))
   2875   (save-excursion
   2876     (goto-char (point-min))
   2877     (let ((inhibit-read-only t) maps)
   2878       (while (progn
   2879                (when (tabulated-list-get-id)
   2880                  (put-text-property
   2881                   (point) (button-end (point)) 'keymap
   2882                   (if embark-collect-direct-action-minor-mode
   2883                       (when-let ((target (embark-collect--target))
   2884                                  (type (plist-get target :type)))
   2885                         (or (alist-get type maps)
   2886                             (setf (alist-get type maps)
   2887                                   (embark-collect--direct-action-map type)))))))
   2888                (forward-button 1 nil nil t))))))
   2889 
   2890 (define-button-type 'embark-collect-entry
   2891   'face 'embark-collect-candidate
   2892   'action 'embark-collect-choose)
   2893 
   2894 (declare-function outline-toggle-children "outline")
   2895 (define-button-type 'embark-collect-group
   2896   'face 'embark-collect-group-title
   2897   'action (lambda (_) (outline-toggle-children)))
   2898 
   2899 (defun embark--boundaries ()
   2900   "Get current minibuffer completion boundaries."
   2901   (let ((contents (minibuffer-contents))
   2902         (pt (embark--minibuffer-point)))
   2903     (completion-boundaries
   2904      (substring contents 0 pt)
   2905      minibuffer-completion-table
   2906      minibuffer-completion-predicate
   2907      (substring contents pt))))
   2908 
   2909 (defun embark-collect-choose (entry)
   2910   "Run default action on Embark Collect ENTRY."
   2911   (pcase-let ((`(,type ,text ,start . ,end)
   2912                (save-excursion
   2913                  (goto-char entry)
   2914                  (embark-target-collect-candidate))))
   2915     (embark--act (embark--default-action type)
   2916                  (list :target text
   2917                        :type type
   2918                        :bounds (cons start end)))))
   2919 
   2920 (defvar-keymap embark-collect-mode-map
   2921   :doc "Keymap for Embark collect mode."
   2922   :parent tabulated-list-mode-map
   2923   "a" #'embark-act
   2924   "A" #'embark-act-all
   2925   "M-a" #'embark-collect-direct-action-minor-mode
   2926   "E" #'embark-export
   2927   "s" #'isearch-forward
   2928   "n" #'forward-button
   2929   "p" #'backward-button
   2930   "}" 'outline-next-heading
   2931   "{" 'outline-previous-heading
   2932   "<remap> <forward-paragraph>" 'outline-next-heading
   2933   "<remap> <backward-paragraph>" 'outline-previous-heading
   2934   "<remap> <revert-buffer>" #'embark-rerun-collect-or-export)
   2935 
   2936 (defconst embark-collect--outline-string (string #x210000)
   2937   "Special string used for outline headings in Embark Collect buffers.
   2938 Chosen to be extremely unlikely to appear in a candidate.")
   2939 
   2940 (define-derived-mode embark-collect-mode tabulated-list-mode "Embark Collect"
   2941   "List of candidates to be acted on.
   2942 The command `embark-act' is bound `embark-collect-mode-map', but
   2943 you might prefer to change the key binding to match your other
   2944 key binding for it.  Or alternatively you might want to enable the
   2945 embark collect direct action minor mode by adding the function
   2946 `embark-collect-direct-action-minor-mode' to
   2947 `embark-collect-mode-hook'.
   2948 
   2949 Reverting an Embark Collect buffer has slightly unusual behavior
   2950 if the buffer was obtained by running `embark-collect' from
   2951 within a minibuffer completion session.  In that case reverting
   2952 just restarts the completion session, that is, the command that
   2953 opened the minibuffer is run again and the minibuffer contents
   2954 restored.  You can then interact normally with the command,
   2955 perhaps editing the minibuffer contents, and, if you wish, you
   2956 can rerun `embark-collect' to get an updated buffer."
   2957     :interactive nil :abbrev-table nil :syntax-table nil)
   2958 
   2959 (defun embark-collect--metadatum (type metadatum)
   2960   "Get METADATUM for current buffer's candidates.
   2961 For non-minibuffers, assume candidates are of given TYPE."
   2962   (if (minibufferp)
   2963       (or (completion-metadata-get (embark--metadata) metadatum)
   2964           (plist-get completion-extra-properties
   2965                      (intern (format ":%s" metadatum))))
   2966     ;; otherwise fake some metadata for Marginalia users's benefit
   2967     (completion-metadata-get `((category . ,type)) metadatum)))
   2968 
   2969 (defun embark-collect--affixator (type)
   2970   "Get affixation function for current buffer's candidates.
   2971 For non-minibuffers, assume candidates are of given TYPE."
   2972   (or (embark-collect--metadatum type 'affixation-function)
   2973       (let ((annotator
   2974              (or (embark-collect--metadatum type 'annotation-function)
   2975                  (lambda (_) ""))))
   2976         (lambda (candidates)
   2977           (mapcar (lambda (c)
   2978                     (if-let (a (funcall annotator c)) (list c "" a) c))
   2979                   candidates)))))
   2980 
   2981 (defun embark--display-string (str)
   2982   ;; Note: Keep in sync with vertico--display-string
   2983   "Return display STR without display and invisible properties."
   2984   (let ((end (length str)) (pos 0) chunks)
   2985     (while (< pos end)
   2986       (let ((nextd (next-single-property-change pos 'display str end))
   2987             (disp (get-text-property pos 'display str)))
   2988         (if (stringp disp)
   2989             (let ((face (get-text-property pos 'face str)))
   2990               (when face
   2991                 (add-face-text-property
   2992                  0 (length disp) face t (setq disp (concat disp))))
   2993               (setq pos nextd chunks (cons disp chunks)))
   2994           (while (< pos nextd)
   2995             (let ((nexti
   2996                    (next-single-property-change pos 'invisible str nextd)))
   2997               (unless (or (get-text-property pos 'invisible str)
   2998                           (and (= pos 0) (= nexti end))) ;; full=>no allocation
   2999                 (push (substring str pos nexti) chunks))
   3000               (setq pos nexti))))))
   3001     (if chunks (apply #'concat (nreverse chunks)) str)))
   3002 
   3003 (defconst embark--hline
   3004   (propertize
   3005    (concat "\n" (propertize
   3006                  " " 'display '(space :align-to right)
   3007                  'face '(:inherit completions-group-separator :height 0.01)
   3008                  'cursor-intangible t 'intangible t)))
   3009   "Horizontal line used to separate multiline collect entries.")
   3010 
   3011 (defun embark-collect--format-entries (candidates grouper)
   3012   "Format CANDIDATES for `tabulated-list-mode' grouped by GROUPER.
   3013 The GROUPER is either nil or a function like the `group-function'
   3014 completion metadatum, that is, a function of two arguments, the
   3015 first of which is a candidate and the second controls what is
   3016 computed: if nil, the title of the group the candidate belongs
   3017 to, and if non-nil, a rewriting of the candidate (useful to
   3018 simplify the candidate so it doesn't repeat the group title, for
   3019 example)."
   3020   (let ((max-width 0)
   3021         (transform
   3022          (if grouper (lambda (cand) (funcall grouper cand t)) #'identity)))
   3023     (setq
   3024      tabulated-list-entries
   3025      (mapcan
   3026       (lambda (group)
   3027         (let ((multiline (seq-some (lambda (x) (string-match-p "\n" (car x)))
   3028                                    candidates)))
   3029           (cons
   3030            `(nil [(,(concat (propertize embark-collect--outline-string
   3031                                         'invisible t)
   3032                             (format embark-collect-group-format (car group)))
   3033                    type embark-collect-group)
   3034                   ("" skip t)])
   3035            (mapcar
   3036             (pcase-lambda (`(,cand ,prefix ,annotation))
   3037               (let* ((display (embark--display-string (funcall transform cand)))
   3038                      (length (length annotation))
   3039                      (faces (text-property-not-all
   3040                              0 length 'face nil annotation)))
   3041                 (setq max-width (max max-width (+ (string-width prefix)
   3042                                                   (string-width display))))
   3043                 (when faces
   3044                   (add-face-text-property 0 length 'default t annotation))
   3045                 `(,cand
   3046                   [(,(propertize
   3047                       (if multiline (concat display embark--hline) display)
   3048                       'line-prefix prefix)
   3049                     type embark-collect-entry)
   3050                    (,annotation
   3051                     skip t
   3052                     ,@(unless faces
   3053                         '(face embark-collect-annotation)))])))
   3054             (cdr group)))))
   3055      (if grouper
   3056          (seq-group-by (lambda (item) (funcall grouper (car item) nil))
   3057                        candidates)
   3058        (list (cons "" candidates)))))
   3059   (if (null grouper)
   3060       (pop tabulated-list-entries)
   3061     (setq-local outline-regexp embark-collect--outline-string)
   3062     (outline-minor-mode))
   3063   (setq tabulated-list-format
   3064         `[("Candidate" ,max-width t) ("Annotation" 0 t)])))
   3065 
   3066 (defun embark-collect--update-candidates (buffer)
   3067   "Update candidates for Embark Collect BUFFER."
   3068   (let* ((transformed (embark--maybe-transform-candidates))
   3069          (type (plist-get transformed :orig-type)) ; we need the originals for
   3070          (candidates (plist-get transformed :orig-candidates)) ; default action
   3071          (bounds (plist-get transformed :bounds))
   3072          (affixator (embark-collect--affixator type))
   3073          (grouper (embark-collect--metadatum type 'group-function)))
   3074     (when (eq type 'file)
   3075       (let ((dir (buffer-local-value 'default-directory buffer)))
   3076         (setq candidates
   3077               (mapcar (lambda (cand)
   3078                         (let ((rel (file-relative-name cand dir)))
   3079                           (if (string-prefix-p "../" rel) cand rel)))
   3080                       candidates))))
   3081     (if (seq-some #'identity bounds)
   3082       (cl-loop for cand in candidates and (start . _end) in bounds
   3083                when start
   3084                do (add-text-properties
   3085                    0 1 `(embark--location ,(copy-marker start)) cand)))
   3086     (setq candidates (funcall affixator candidates))
   3087     (with-current-buffer buffer
   3088       (setq embark--type type)
   3089       (unless embark--command
   3090         (setq embark--command #'embark--goto))
   3091       (embark-collect--format-entries candidates grouper))
   3092     candidates))
   3093 
   3094 (defun embark--goto (target)
   3095   "Jump to the original location of TARGET.
   3096 This function is used as a default action in Embark Collect
   3097 buffers when the candidates were a selection from a regular
   3098 buffer."
   3099   ;; TODO: ensure the location jumped to is visible
   3100   ;; TODO: remove duplication with embark-org-goto-heading
   3101   (when-let ((marker (get-text-property 0 'embark--location target)))
   3102     (pop-to-buffer (marker-buffer marker))
   3103     (widen)
   3104     (goto-char marker)
   3105     (pulse-momentary-highlight-one-line)))
   3106 
   3107 (defun embark--collect (buffer-name)
   3108   "Create an Embark Collect buffer named BUFFER-NAME.
   3109 
   3110 The function `generate-new-buffer-name' is used to ensure the
   3111 buffer has a unique name."
   3112   (let ((buffer (generate-new-buffer buffer-name))
   3113         (rerun (embark--rerun-function #'embark-collect)))
   3114     (with-current-buffer buffer
   3115       ;; we'll run the mode hooks once the buffer is displayed, so
   3116       ;; the hooks can make use of the window
   3117       (delay-mode-hooks (embark-collect-mode)))
   3118 
   3119     (embark--cache-info buffer)
   3120     (unless (embark-collect--update-candidates buffer)
   3121       (user-error "No candidates to collect"))
   3122 
   3123     (with-current-buffer buffer
   3124       (setq tabulated-list-use-header-line nil ; default to no header
   3125             header-line-format nil
   3126             tabulated-list--header-string nil)
   3127       (setq embark--rerun-function rerun))
   3128 
   3129     (let ((window (display-buffer buffer)))
   3130       (with-selected-window window
   3131         (run-mode-hooks)
   3132         (tabulated-list-revert))
   3133       (set-window-dedicated-p window t)
   3134       buffer)))
   3135 
   3136 (defun embark--descriptive-buffer-name (type)
   3137   "Return a descriptive name for an Embark collect or export buffer.
   3138 TYPE should be either `collect' or `export'."
   3139   (format "*Embark %s: %s*"
   3140           (capitalize (symbol-name type))
   3141           (if (minibufferp)
   3142               (format "%s - %s" embark--command
   3143                       (minibuffer-contents-no-properties))
   3144             (buffer-name))))
   3145 
   3146 ;;;###autoload
   3147 (defun embark-collect ()
   3148   "Create an Embark Collect buffer.
   3149 
   3150 To control the display, add an entry to `display-buffer-alist'
   3151 with key \"Embark Collect\".
   3152 
   3153 In Embark Collect buffers `revert-buffer' is remapped to
   3154 `embark-rerun-collect-or-export', which has slightly unusual
   3155 behavior if the buffer was obtained by running `embark-collect'
   3156 from within a minibuffer completion session.  In that case
   3157 rerunning just restarts the completion session, that is, the
   3158 command that opened the minibuffer is run again and the
   3159 minibuffer contents restored.  You can then interact normally with
   3160 the command, perhaps editing the minibuffer contents, and, if you
   3161 wish, you can rerun `embark-collect' to get an updated buffer."
   3162   (interactive)
   3163   (let ((buffer (embark--collect (embark--descriptive-buffer-name 'collect))))
   3164     (when (minibufferp)
   3165       (embark--run-after-command #'pop-to-buffer buffer)
   3166       (embark--quit-and-run #'message nil))))
   3167 
   3168 ;;;###autoload
   3169 (defun embark-live ()
   3170   "Create a live-updating Embark Collect buffer.
   3171 
   3172 To control the display, add an entry to `display-buffer-alist'
   3173 with key \"Embark Live\"."
   3174   (interactive)
   3175   (let ((live-buffer (embark--collect
   3176                       (format "*Embark Live: %s*"
   3177                               (if (minibufferp)
   3178                                   (format "M-x %s" embark--command)
   3179                                 (buffer-name)))))
   3180         (run-collect (make-symbol "run-collect"))
   3181         (stop-collect (make-symbol "stop-collect"))
   3182         timer)
   3183     (setf (symbol-function stop-collect)
   3184           (lambda ()
   3185             (remove-hook 'change-major-mode-hook stop-collect t)
   3186             (remove-hook 'after-change-functions run-collect t)))
   3187     (setf (symbol-function run-collect)
   3188           (lambda (_1 _2 _3)
   3189             (unless timer
   3190               (setq timer
   3191                     (run-with-idle-timer
   3192                      0.05 nil
   3193                      (lambda ()
   3194                        (if (not (buffer-live-p live-buffer))
   3195                            (funcall stop-collect)
   3196                          (embark-collect--update-candidates live-buffer)
   3197                          (with-current-buffer live-buffer
   3198                            ;; TODO figure out why I can't restore point
   3199                            (tabulated-list-print t t))
   3200                          (setq timer nil))))))))
   3201     (add-hook 'after-change-functions run-collect nil t)
   3202     (when (minibufferp)
   3203       (add-hook 'change-major-mode-hook stop-collect nil t))))
   3204 
   3205 (defun embark--rerun-function (kind)
   3206   "Return a rerun function for an export or collect buffer in this context.
   3207 The parameter KIND should be either `embark-export' or `embark-collect'."
   3208   (let ((buffer (or embark--target-buffer (embark--target-buffer)))
   3209         (command embark--command))
   3210     (cl-flet ((rerunner (action)
   3211                 (lambda (&rest _)
   3212                   (quit-window 'kill-buffer)
   3213                   (with-current-buffer
   3214                       (if (buffer-live-p buffer) buffer (current-buffer))
   3215                     (let ((embark--command command))
   3216                       (funcall action))))))
   3217         (if (minibufferp)
   3218           (rerunner
   3219            (let ((input (minibuffer-contents-no-properties)))
   3220              (lambda ()
   3221                (minibuffer-with-setup-hook
   3222                    (lambda ()
   3223                      (delete-minibuffer-contents)
   3224                      (insert input))
   3225                  (setq this-command embark--command)
   3226                  (command-execute embark--command)))))
   3227           (rerunner kind)))))
   3228 
   3229 (defun embark-rerun-collect-or-export ()
   3230   "Rerun the `embark-collect' or `embark-export' that created this buffer."
   3231   (interactive)
   3232   (if embark--rerun-function
   3233       (funcall embark--rerun-function)
   3234     (user-error "No function to rerun collect or export found")))
   3235 
   3236 ;;;###autoload
   3237 (defun embark-export ()
   3238   "Create a type-specific buffer to manage current candidates.
   3239 The variable `embark-exporters-alist' controls how to make the
   3240 buffer for each type of completion.
   3241 
   3242 In Embark Export buffers `revert-buffer' is remapped to
   3243 `embark-rerun-collect-or-export', which has slightly unusual
   3244 behavior if the buffer was obtained by running `embark-export'
   3245 from within a minibuffer completion session.  In that case
   3246 reverting just restarts the completion session, that is, the
   3247 command that opened the minibuffer is run again and the
   3248 minibuffer contents restored.  You can then interact normally
   3249 with the command, perhaps editing the minibuffer contents, and,
   3250 if you wish, you can rerun `embark-export' to get an updated
   3251 buffer."
   3252   (interactive)
   3253   (let* ((transformed (embark--maybe-transform-candidates))
   3254          (candidates (or (plist-get transformed :candidates)
   3255                          (user-error "No candidates for export")))
   3256          (type (plist-get transformed :type)))
   3257     (let ((exporter (or (alist-get type embark-exporters-alist)
   3258                         (alist-get t embark-exporters-alist))))
   3259       (if (eq exporter 'embark-collect)
   3260           (embark-collect)
   3261         (let* ((after embark-after-export-hook)
   3262                (cmd embark--command)
   3263                (name (embark--descriptive-buffer-name 'export))
   3264                (rerun (embark--rerun-function #'embark-export))
   3265                (buffer (save-excursion
   3266                          (funcall exporter candidates)
   3267                          (rename-buffer name t)
   3268                          (current-buffer))))
   3269           (embark--quit-and-run
   3270            (lambda ()
   3271              (pop-to-buffer buffer)
   3272              (setq embark--rerun-function rerun)
   3273              (use-local-map
   3274               (make-composed-keymap
   3275                '(keymap
   3276                  (remap keymap
   3277                         (revert-buffer . embark-rerun-collect-or-export)))
   3278                (current-local-map)))
   3279              (let ((embark-after-export-hook after)
   3280                    (embark--command cmd))
   3281                (run-hooks 'embark-after-export-hook)))))))))
   3282 
   3283 (defmacro embark--export-rename (buffer title &rest body)
   3284   "Run BODY and rename BUFFER to Embark export buffer with TITLE."
   3285   (declare (indent 2))
   3286   (let ((saved (make-symbol "saved")))
   3287     `(let ((,saved (embark-rename-buffer
   3288                     ,buffer " *Embark Saved*" t)))
   3289        ,@body
   3290        (set-buffer (embark-rename-buffer
   3291                     ,buffer ,(format "*Embark Export %s*" title) t))
   3292        (when ,saved (embark-rename-buffer ,saved ,buffer)))))
   3293 
   3294 (defun embark--export-customize (items type pred)
   3295   "Create a customization buffer listing ITEMS.
   3296 TYPE is the items type.
   3297 PRED is a predicate function used to filter the items."
   3298   (custom-buffer-create
   3299    (cl-loop for item in items
   3300             for sym = (intern-soft item)
   3301             when (and sym (funcall pred sym)) collect `(,sym ,type))))
   3302 
   3303 (autoload 'apropos-parse-pattern "apropos")
   3304 (autoload 'apropos-symbols-internal "apropos")
   3305 (defun embark-export-apropos (symbols)
   3306   "Create apropos buffer listing SYMBOLS."
   3307   (embark--export-rename "*Apropos*" "Apropos"
   3308     (apropos-parse-pattern "") ;; Initialize apropos pattern
   3309     ;; HACK: Ensure that order of exported symbols is kept.
   3310     (cl-letf (((symbol-function #'sort) (lambda (list _pred) (nreverse list))))
   3311       (apropos-symbols-internal
   3312        (delq nil (mapcar #'intern-soft symbols))
   3313        (bound-and-true-p apropos-do-all)))))
   3314 
   3315 (defun embark-export-customize-face (faces)
   3316   "Create a customization buffer listing FACES."
   3317   (embark--export-customize faces 'custom-face #'facep))
   3318 
   3319 (defun embark-export-customize-variable (variables)
   3320   "Create a customization buffer listing VARIABLES."
   3321   ;; The widget library serializes/deserializes the values. We advise
   3322   ;; the serialization in order to avoid errors for nonserializable
   3323   ;; variables.
   3324   (cl-letf* ((ht (make-hash-table :test #'equal))
   3325              (orig-read (symbol-function #'read))
   3326              (orig-write (symbol-function 'widget-sexp-value-to-internal))
   3327              ((symbol-function #'read)
   3328               (lambda (&optional str)
   3329                 (condition-case nil
   3330                     (funcall orig-read str)
   3331                   (error (gethash str ht)))))
   3332              ((symbol-function 'widget-sexp-value-to-internal)
   3333               (lambda (widget val)
   3334                 (let ((str (funcall orig-write widget val)))
   3335                   (puthash str val ht)
   3336                   str))))
   3337     (embark--export-customize variables 'custom-variable #'boundp)))
   3338 
   3339 (defun embark-export-ibuffer (buffers)
   3340   "Create an ibuffer buffer listing BUFFERS."
   3341   (ibuffer t "*Embark Export Ibuffer*"
   3342            `((predicate . (member (buffer-name) ',buffers)))))
   3343 
   3344 (autoload 'dired-check-switches "dired")
   3345 (declare-function dired-unadvertise "dired")
   3346 (defvar dired-directory)
   3347 
   3348 (defun embark-export-dired (files)
   3349   "Create a Dired buffer listing FILES."
   3350   (setq files (mapcar #'directory-file-name
   3351                       (cl-remove-if-not #'file-exists-p files)))
   3352   (when (dired-check-switches dired-listing-switches "A" "almost-all")
   3353     (setq files (cl-remove-if
   3354                  (lambda (path)
   3355                    (let ((file (file-name-nondirectory path)))
   3356                      (or (string= file ".") (string= file ".."))))
   3357                  files)))
   3358   (cl-letf* ((dir (or (file-name-directory (try-completion "" files)) ""))
   3359              ;; Prevent reusing existing Dired buffer.
   3360              ((symbol-function 'dired-find-buffer-nocreate) #'ignore)
   3361              (buf (dired-noselect
   3362                    (cons (expand-file-name dir)
   3363                          (mapcar (lambda (file) (string-remove-prefix dir file))
   3364                                  files)))))
   3365     (with-current-buffer buf
   3366       ;; Unadvertise to prevent the new buffer from being reused.
   3367       (dired-unadvertise (car dired-directory))
   3368       (rename-buffer (format "*Embark Export Dired %s*" default-directory)))
   3369     (pop-to-buffer buf)))
   3370 
   3371 (autoload 'package-menu-mode "package")
   3372 (autoload 'package-menu--generate "package")
   3373 
   3374 (defun embark-export-list-packages (packages)
   3375   "Create a package menu mode buffer listing PACKAGES."
   3376   (let ((buf (generate-new-buffer "*Embark Export Packages*")))
   3377     (with-current-buffer buf
   3378       (package-menu-mode)
   3379       (package-menu--generate nil (mapcar #'intern packages)))
   3380     (pop-to-buffer buf)))
   3381 
   3382 (defvar bookmark-alist)
   3383 
   3384 (defun embark-export-bookmarks (bookmarks)
   3385   "Create a `bookmark-bmenu-mode' buffer listing BOOKMARKS."
   3386   (embark--export-rename "*Bookmark List*" "Bookmarks"
   3387     (let ((bookmark-alist
   3388            (cl-remove-if-not
   3389             (lambda (bmark)
   3390               (member (car bmark) bookmarks))
   3391             bookmark-alist)))
   3392       (bookmark-bmenu-list))))
   3393 
   3394 ;;; Multiple target selection
   3395 
   3396 (defface embark-selected '((t (:inherit match)))
   3397   "Face for selected candidates.")
   3398 
   3399 (defcustom embark-selection-indicator
   3400   #("  Embark:%s " 1 12 (face (embark-selected bold)))
   3401   "Mode line indicator used for selected candidates."
   3402   :type '(choice string (const nil)))
   3403 
   3404 (defvar-local embark--selection nil
   3405   "Buffer local list of selected targets.
   3406 Add or remove elements to this list using the `embark-select'
   3407 action.")
   3408 
   3409 (defun embark--selection-indicator ()
   3410   "Mode line indicator showing number of selected items."
   3411   (when-let ((sel
   3412               (buffer-local-value
   3413                'embark--selection
   3414                (or (when-let ((win (active-minibuffer-window)))
   3415                      (window-buffer win))
   3416                    (current-buffer)))))
   3417     (format embark-selection-indicator (length sel))))
   3418 
   3419 (cl-defun embark--select
   3420     (&key orig-target orig-type bounds &allow-other-keys)
   3421   "Add or remove ORIG-TARGET of given ORIG-TYPE to the selection.
   3422 If BOUNDS are given, also highlight the target when selecting it."
   3423   (cl-flet ((multi-type (x) (car (get-text-property 0 'multi-category x))))
   3424     (if-let* ((existing (seq-find
   3425                          (pcase-lambda (`(,cand . ,ov))
   3426                            (and
   3427                             (equal cand orig-target)
   3428                             (if (and bounds ov)
   3429                                 (and (= (car bounds) (overlay-start ov))
   3430                                      (= (cdr bounds) (overlay-end ov)))
   3431                               (let ((cand-type (multi-type cand)))
   3432                                 (or (eq cand-type orig-type)
   3433                                     (eq cand-type (multi-type orig-target)))))))
   3434                          embark--selection)))
   3435         (progn
   3436           (when (cdr existing) (delete-overlay (cdr existing)))
   3437           (setq embark--selection (delq existing embark--selection)))
   3438       (let ((target (copy-sequence orig-target)) overlay)
   3439         (when bounds
   3440           (setq overlay (make-overlay (car bounds) (cdr bounds)))
   3441           (overlay-put overlay 'category 'embark-selected-overlay))
   3442         (add-text-properties 0 (length orig-target)
   3443                              `(multi-category ,(cons orig-type orig-target))
   3444                              target)
   3445         (push (cons target overlay) embark--selection))))
   3446   (when embark-selection-indicator
   3447     (add-to-list 'mode-line-misc-info '(:eval (embark--selection-indicator)))
   3448     (force-mode-line-update t)))
   3449 
   3450 ;;;###autoload
   3451 (defun embark-select ()
   3452   "Add or remove the target from the current buffer's selection.
   3453 You can act on all selected targets at once with `embark-act-all'.
   3454 When called from outside `embark-act' this command will select
   3455 the first target at point."
   3456   (interactive)
   3457   (if-let ((target (car (embark--targets))))
   3458       (apply #'embark--select target)
   3459     (user-error "No target to select")))
   3460 
   3461 (defun embark-selected-candidates ()
   3462   "Return currently selected candidates in the buffer."
   3463   (when embark--selection
   3464     (cl-flet ((unwrap (x) (get-text-property 0 'multi-category x)))
   3465       (let* ((first-type (car (unwrap (caar embark--selection))))
   3466              (same (cl-every (lambda (item)
   3467                                (eq (car (unwrap (car item))) first-type))
   3468                              embark--selection))
   3469              (extract (if same
   3470                           (pcase-lambda (`(,cand . ,overlay))
   3471                             (cons (cdr (unwrap cand)) overlay))
   3472                         #'identity)))
   3473         (cons
   3474          (if same first-type 'multi-category)
   3475          (nreverse
   3476           (mapcar
   3477            (lambda (item)
   3478              (pcase-let ((`(,cand . ,ov) (funcall extract item)))
   3479                (if ov `(,cand ,(overlay-start ov) . ,(overlay-end ov)) cand)))
   3480            embark--selection)))))))
   3481 
   3482 ;;; Integration with external packages, mostly completion UIs
   3483 
   3484 ;; marginalia
   3485 
   3486 ;; Ensure that the Marginalia cache is reset, such that
   3487 ;; `embark-toggle-variable-value' updates the display (See #540).
   3488 (with-eval-after-load 'marginalia
   3489   (push 'marginalia--cache-reset (alist-get :always embark-post-action-hooks)))
   3490 
   3491 ;; vertico
   3492 
   3493 (declare-function vertico--candidate "ext:vertico")
   3494 (declare-function vertico--update "ext:vertico")
   3495 (defvar vertico--input)
   3496 (defvar vertico--candidates)
   3497 (defvar vertico--base)
   3498 
   3499 (defun embark--vertico-selected ()
   3500   "Target the currently selected item in Vertico.
   3501 Return the category metadatum as the type of the target."
   3502   (when vertico--input
   3503     ;; Force candidate computation, if candidates are not yet available.
   3504     (vertico--update)
   3505     (cons (completion-metadata-get (embark--metadata) 'category)
   3506           (vertico--candidate))))
   3507 
   3508 (defun embark--vertico-candidates ()
   3509   "Collect the current Vertico candidates.
   3510 Return the category metadatum as the type of the candidates."
   3511   (when vertico--input
   3512     ;; Force candidate computation, if candidates are not yet available.
   3513     (vertico--update)
   3514     (cons (completion-metadata-get (embark--metadata) 'category)
   3515           vertico--candidates)))
   3516 
   3517 (defun embark--vertico-indicator ()
   3518   "Embark indicator highlighting the current Vertico candidate."
   3519   (let ((fr face-remapping-alist))
   3520     (lambda (&optional keymap _targets _prefix)
   3521       (when vertico--input
   3522         (setq-local face-remapping-alist
   3523                     (if keymap
   3524                         (cons '(vertico-current . embark-target) fr)
   3525                       fr))))))
   3526 
   3527 (with-eval-after-load 'vertico
   3528   (cl-defmethod vertico--format-candidate
   3529     :around (cand prefix suffix index start &context (embark--selection cons))
   3530     (when (cl-find (concat vertico--base (nth index vertico--candidates))
   3531                    embark--selection
   3532                    :test #'equal :key #'car)
   3533       (setq cand (copy-sequence cand))
   3534       (add-face-text-property 0 (length cand) 'embark-selected t cand))
   3535     (cl-call-next-method cand prefix suffix index start))
   3536   (add-hook 'embark-indicators #'embark--vertico-indicator)
   3537   (add-hook 'embark-target-finders #'embark--vertico-selected)
   3538   (add-hook 'embark-candidate-collectors #'embark--vertico-candidates)
   3539   (remove-hook 'embark-candidate-collectors #'embark-selected-candidates)
   3540   (add-hook 'embark-candidate-collectors #'embark-selected-candidates))
   3541 
   3542 ;; ivy
   3543 
   3544 (declare-function ivy--expand-file-name "ext:ivy")
   3545 (declare-function ivy-state-current "ext:ivy")
   3546 (defvar ivy-text)
   3547 (defvar ivy-last)
   3548 (defvar ivy--old-cands) ; this stores the current candidates :)
   3549 (defvar ivy--length)
   3550 
   3551 (defun embark--ivy-selected ()
   3552   "Target the currently selected item in Ivy.
   3553 Return the category metadatum as the type of the target."
   3554   ;; my favorite way of detecting Ivy
   3555   (when (memq 'ivy--queue-exhibit post-command-hook)
   3556     (cons
   3557      (completion-metadata-get (embark--metadata) 'category)
   3558      (ivy--expand-file-name
   3559       (if (and (> ivy--length 0)
   3560                (stringp (ivy-state-current ivy-last)))
   3561           (ivy-state-current ivy-last)
   3562         ivy-text)))))
   3563 
   3564 (defun embark--ivy-candidates ()
   3565   "Return all current Ivy candidates."
   3566   ;; my favorite way of detecting Ivy
   3567   (when (memq 'ivy--queue-exhibit post-command-hook)
   3568     (cons
   3569      ;; swiper-isearch uses swiper-isearch-function as a completion
   3570      ;; table, but it doesn't understand metadata queries
   3571      (ignore-errors
   3572        (completion-metadata-get (embark--metadata) 'category))
   3573      ivy--old-cands)))
   3574 
   3575 (with-eval-after-load 'ivy
   3576   (add-hook 'embark-target-finders #'embark--ivy-selected)
   3577   (add-hook 'embark-candidate-collectors #'embark--ivy-candidates)
   3578   (remove-hook 'embark-candidate-collectors #'embark-selected-candidates)
   3579   (add-hook 'embark-candidate-collectors #'embark-selected-candidates))
   3580 
   3581 ;;; Custom actions
   3582 
   3583 (defvar embark-separator-history nil
   3584   "Input history for the separators used by some embark commands.
   3585 The commands that prompt for a string separator are
   3586 `embark-insert' and `embark-copy-as-kill'.")
   3587 
   3588 (defun embark-keymap-help ()
   3589   "Prompt for an action to perform or command to become and run it."
   3590   (interactive)
   3591   (user-error "Not meant to be called directly"))
   3592 
   3593 (defun embark-toggle-quit ()
   3594   "Toggle whether the following action quits the minibuffer."
   3595   (interactive)
   3596   (when (minibufferp)
   3597     (setq embark--toggle-quit (not embark--toggle-quit))
   3598     (if (consp embark-quit-after-action)
   3599         (message "Will %sobey embark-quit-after-action."
   3600                  (if embark--toggle-quit "dis" ""))
   3601       (message
   3602        "Will %squit minibuffer after action"
   3603        (if (eq embark--toggle-quit embark-quit-after-action) "not " "")))))
   3604 
   3605 (defun embark--separator (strings)
   3606   "Return a separator to join the STRINGS together.
   3607 With a prefix argument, prompt the user (unless STRINGS has 0 or
   3608 1 elements, in which case a separator is not needed)."
   3609   (if (and current-prefix-arg (cdr strings))
   3610       (read-string "Separator: " nil 'embark-separator-history)
   3611     "\n"))
   3612 
   3613 (defun embark-copy-as-kill (strings)
   3614   "Join STRINGS and save on the `kill-ring'.
   3615 With a prefix argument, prompt for the separator to join the
   3616 STRINGS, which defaults to a newline."
   3617   (kill-new (string-join strings (embark--separator strings))))
   3618 
   3619 (defun embark-insert (strings)
   3620   "Join STRINGS and insert the result at point.
   3621 With a prefix argument, prompt for the separator to join the
   3622 STRINGS, which defaults to a newline.
   3623 
   3624 Some whitespace is also inserted if necessary to avoid having the
   3625 inserted string blend into the existing buffer text.  More
   3626 precisely:
   3627 
   3628 1. If the inserted string does not contain newlines, a space may
   3629 be added before or after it as needed to avoid inserting a word
   3630 constituent character next to an existing word constituent.
   3631 
   3632 2. For a multiline inserted string, newlines may be added before
   3633 or after as needed to ensure the inserted string is on lines of
   3634 its own."
   3635   (let* ((separator (embark--separator strings))
   3636          (multiline
   3637           (or (and (cdr strings) (string-match-p "\n" separator))
   3638               (and (null (cdr strings))
   3639                    (equal (buffer-substring (line-beginning-position)
   3640                                             (line-end-position))
   3641                           (car strings)))
   3642               (seq-some (lambda (s) (string-match-p "\n" s)) strings))))
   3643     (cl-labels ((maybe-space ()
   3644                   (and (looking-at "\\w") (looking-back "\\w" 1)
   3645                        (insert " ")))
   3646                 (maybe-newline ()
   3647                   (or (looking-back "^[ \t]*" 40) (looking-at "\n")
   3648                       (newline-and-indent)))
   3649                 (maybe-whitespace ()
   3650                   (if multiline (maybe-newline) (maybe-space)))
   3651                 (ins-string ()
   3652                   (let ((start (point)))
   3653                     (insert (string-join strings separator))
   3654                     (save-excursion (goto-char start) (maybe-whitespace))
   3655                     (when (looking-back "\n" 1) (delete-char -1))
   3656                     (save-excursion (maybe-whitespace)))))
   3657       (if buffer-read-only
   3658           (with-selected-window (other-window-for-scrolling)
   3659             (ins-string))
   3660         (ins-string)))))
   3661 
   3662 ;; For Emacs 28 dired-jump will be moved to dired.el, but it seems
   3663 ;; that since it already has an autoload in Emacs 28, this next
   3664 ;; autoload is ignored.
   3665 (autoload 'dired-jump "dired-x" nil t)
   3666 
   3667 (defun embark-dired-jump (file &optional other-window)
   3668   "Open Dired buffer in directory containing FILE and move to its line.
   3669 When called with a prefix argument OTHER-WINDOW, open Dired in other window."
   3670   (interactive "fJump to Dired file: \nP")
   3671   (dired-jump other-window file))
   3672 
   3673 (defun embark--read-from-history (prompt candidates &optional category)
   3674   "Read with completion from list of history CANDIDATES of CATEGORY.
   3675 Sorting and history are disabled.  PROMPT is the prompt message."
   3676   (completing-read prompt
   3677                    (embark--with-category category candidates)
   3678                    nil t nil t))
   3679 
   3680 (defun embark-kill-ring-remove (text)
   3681   "Remove TEXT from `kill-ring'."
   3682   (interactive (list (embark--read-from-history
   3683                       "Remove from kill-ring: " kill-ring 'kill-ring)))
   3684   (embark-history-remove text)
   3685   (setq kill-ring (delete text kill-ring)))
   3686 
   3687 (defvar recentf-list)
   3688 (defun embark-recentf-remove (file)
   3689   "Remove FILE from the list of recent files."
   3690   (interactive (list (embark--read-from-history
   3691                       "Remove recent file: " recentf-list 'file)))
   3692   (embark-history-remove (expand-file-name file))
   3693   (embark-history-remove (abbreviate-file-name file))
   3694   (when (and (boundp 'recentf-list) (fboundp 'recentf-expand-file-name))
   3695     (setq recentf-list (delete (recentf-expand-file-name file) recentf-list))))
   3696 
   3697 (defun embark-history-remove (str)
   3698   "Remove STR from `minibuffer-history-variable'.
   3699 Many completion UIs sort by history position.  This command can be used
   3700 to remove entries from the history, such that they are not sorted closer
   3701 to the top."
   3702   (interactive (list (embark--read-from-history
   3703                       "Remove history item: "
   3704                       (if (eq minibuffer-history-variable t)
   3705                           (user-error "No minibuffer history")
   3706                         (symbol-value minibuffer-history-variable)))))
   3707   (unless (eq minibuffer-history-variable t)
   3708     (set minibuffer-history-variable
   3709          (delete str (symbol-value minibuffer-history-variable)))))
   3710 
   3711 (defvar xref-backend-functions)
   3712 
   3713 (defun embark-find-definition (symbol)
   3714   "Find definition of Emacs Lisp SYMBOL."
   3715   (interactive "sSymbol: ")
   3716   (let ((xref-backend-functions (lambda () 'elisp)))
   3717     (xref-find-definitions symbol)))
   3718 
   3719 (defun embark-info-lookup-symbol (symbol)
   3720   "Display the definition of SYMBOL, from the Elisp manual."
   3721   (interactive "SSymbol: ")
   3722   (info-lookup-symbol symbol 'emacs-lisp-mode))
   3723 
   3724 (defun embark-rename-buffer (buffer newname &optional unique)
   3725   "Rename BUFFER to NEWNAME, optionally making it UNIQUE.
   3726 Interactively, you can set UNIQUE with a prefix argument.
   3727 Returns the new name actually used."
   3728   (interactive "bBuffer: \nBRename %s to: \nP")
   3729   (when-let ((buf (get-buffer buffer)))
   3730     (with-current-buffer buf
   3731       (rename-buffer newname unique))))
   3732 
   3733 (defun embark--package-url (pkg)
   3734   "Return homepage for package PKG."
   3735   (when-let (desc (embark--package-desc pkg))
   3736     (alist-get :url (package-desc-extras desc))))
   3737 
   3738 (defun embark--prompt-for-package ()
   3739   "Prompt user for a package name."
   3740   ;; this code is taken from the interactive spec of describe-package
   3741   (unless package--initialized
   3742     (package-initialize t))
   3743   (intern
   3744    (completing-read "Package: "
   3745                     (append (mapcar #'car package-alist)
   3746                             (mapcar #'car package-archive-contents)
   3747                             (mapcar #'car package--builtins)))))
   3748 
   3749 (defun embark-browse-package-url (pkg)
   3750   "Open homepage for package PKG with `browse-url'."
   3751   (interactive (list (embark--prompt-for-package)))
   3752   (if-let ((url (embark--package-url pkg)))
   3753       (browse-url url)
   3754     (user-error "No homepage found for `%s'" pkg)))
   3755 
   3756 (defun embark-save-package-url (pkg)
   3757   "Save URL of homepage for package PKG on the `kill-ring'."
   3758   (interactive (list (embark--prompt-for-package)))
   3759   (if-let ((url (embark--package-url pkg)))
   3760       (kill-new url)
   3761     (user-error "No homepage found for `%s'" pkg)))
   3762 
   3763 (defun embark-save-variable-value (var)
   3764   "Save value of VAR in the `kill-ring'."
   3765   (interactive "SVariable: ")
   3766   (kill-new (string-trim (pp-to-string (symbol-value var)))))
   3767 
   3768 (defun embark-insert-variable-value (var)
   3769   "Insert value of VAR."
   3770   (interactive "SVariable: ")
   3771   (embark-insert (list (string-trim (pp-to-string (symbol-value var))))))
   3772 
   3773 (defun embark-toggle-variable (var &optional local)
   3774   "Toggle value of boolean variable VAR.
   3775 If prefix LOCAL is non-nil make variable local."
   3776   (interactive "SVariable: \nP")
   3777   (let ((val (symbol-value var)))
   3778     (unless (memq val '(nil t))
   3779       (user-error "Not a boolean variable"))
   3780     (when local
   3781       (make-local-variable var))
   3782     (funcall (or (get var 'custom-set) 'set) var (not val))))
   3783 
   3784 (defun embark-insert-relative-path (file)
   3785   "Insert relative path to FILE.
   3786 The insert path is relative to `default-directory'."
   3787   (interactive "FFile: ")
   3788   (embark-insert (list (file-relative-name (substitute-in-file-name file)))))
   3789 
   3790 (defun embark-save-relative-path (file)
   3791   "Save the relative path to FILE in the kill ring.
   3792 The insert path is relative to `default-directory'."
   3793   (interactive "FFile: ")
   3794   (kill-new (file-relative-name (substitute-in-file-name file))))
   3795 
   3796 (defun embark-shell-command-on-buffer (buffer command &optional replace)
   3797   "Run shell COMMAND on contents of BUFFER.
   3798 Called with \\[universal-argument], replace contents of buffer
   3799 with command output.  For replacement behavior see
   3800 `shell-command-dont-erase-buffer' setting."
   3801   (interactive
   3802    (list
   3803     (read-buffer "Buffer: " nil t)
   3804     (read-shell-command "Shell command: ")
   3805     current-prefix-arg))
   3806   (with-current-buffer buffer
   3807     (shell-command-on-region (point-min) (point-max)
   3808                              command
   3809                              (and replace (current-buffer)))))
   3810 
   3811 (defun embark-open-externally (file)
   3812   "Open FILE or url using system's default application."
   3813   (interactive "sOpen externally: ")
   3814   (unless (string-match-p "\\`[a-z]+://" file)
   3815     (setq file (expand-file-name file)))
   3816   (message "Opening `%s' externally..." file)
   3817   (if (and (eq system-type 'windows-nt)
   3818            (fboundp 'w32-shell-execute))
   3819       (w32-shell-execute "open" file)
   3820     (call-process (pcase system-type
   3821                     ('darwin "open")
   3822                     ('cygwin "cygstart")
   3823                     (_ "xdg-open"))
   3824                   nil 0 nil file)))
   3825 
   3826 (declare-function bookmark-prop-get "bookmark")
   3827 (declare-function bookmark-completing-read "bookmark")
   3828 
   3829 (defun embark-bookmark-open-externally (bookmark)
   3830   "Open BOOKMARK in external application."
   3831   (interactive (list (bookmark-completing-read "Open externally: ")))
   3832   (embark-open-externally
   3833    (or (bookmark-prop-get bookmark 'location)
   3834        (bookmark-prop-get bookmark 'filename)
   3835        (user-error "Bookmark `%s' does not have a location" bookmark))))
   3836 
   3837 (defun embark-bury-buffer (buf)
   3838   "Bury buffer BUF."
   3839   (interactive "bBuffer: ")
   3840   (if-let (win (get-buffer-window buf))
   3841       (with-selected-window win
   3842         (bury-buffer))
   3843     (bury-buffer)))
   3844 
   3845 (defun embark-kill-buffer-and-window (buf)
   3846   "Kill buffer BUF and delete its window."
   3847   (interactive "bBuffer: ")
   3848   (when-let (buf (get-buffer buf))
   3849     (if-let (win (get-buffer-window buf))
   3850         (with-selected-window win
   3851           (kill-buffer-and-window))
   3852       (kill-buffer buf))))
   3853 
   3854 (defun embark-save-unicode-character (char)
   3855   "Save Unicode character CHAR to kill ring."
   3856   (interactive
   3857    (list (read-char-by-name "Insert character  (Unicode name or hex): ")))
   3858   (kill-new (format "%c" char)))
   3859 
   3860 (defun embark-isearch-forward ()
   3861   "Prompt for string in the minibuffer and start isearch forwards.
   3862 Unlike isearch, this command reads the string from the
   3863 minibuffer, which means it can be used as an Embark action."
   3864   (interactive)
   3865   (isearch-mode t)
   3866   (isearch-edit-string))
   3867 
   3868 (defun embark-isearch-backward ()
   3869   "Prompt for string in the minibuffer and start isearch backwards.
   3870 Unlike isearch, this command reads the string from the
   3871 minibuffer, which means it can be used as an Embark action."
   3872   (interactive)
   3873   (isearch-mode nil)
   3874   (isearch-edit-string))
   3875 
   3876 (defun embark-toggle-highlight ()
   3877   "Toggle symbol highlighting using `highlight-symbol-at-point'."
   3878   (interactive)
   3879   (let ((regexp (find-tag-default-as-symbol-regexp))
   3880         (highlighted (cl-find-if #'boundp
   3881                                  '(hi-lock-interactive-lighters
   3882                                    hi-lock-interactive-patterns))))
   3883     (if (and highlighted (assoc regexp (symbol-value highlighted)))
   3884         (unhighlight-regexp regexp)
   3885       (highlight-symbol-at-point))))
   3886 
   3887 (defun embark-next-symbol ()
   3888   "Jump to next occurrence of symbol at point.
   3889 The search respects symbol boundaries."
   3890   (interactive)
   3891   (if-let ((symbol (thing-at-point 'symbol)))
   3892       (let ((regexp (format "\\_<%s\\_>" (regexp-quote symbol))))
   3893         (when (looking-at regexp)
   3894           (forward-symbol 1))
   3895         (unless (re-search-forward regexp nil t)
   3896           (user-error "Symbol `%s' not found" symbol)))
   3897     (user-error "No symbol at point")))
   3898 
   3899 (defun embark-previous-symbol ()
   3900   "Jump to previous occurrence of symbol at point.
   3901 The search respects symbol boundaries."
   3902   (interactive)
   3903   (if-let ((symbol (thing-at-point 'symbol)))
   3904       (let ((regexp (format "\\_<%s\\_>" (regexp-quote symbol))))
   3905         (when (looking-back regexp (- (point) (length symbol)))
   3906           (forward-symbol -1))
   3907         (unless (re-search-backward regexp nil t)
   3908           (user-error "Symbol `%s' not found" symbol)))
   3909     (user-error "No symbol at point")))
   3910 
   3911 (defun embark-compose-mail (address)
   3912   "Compose email to ADDRESS."
   3913   ;; The only reason we cannot use compose-mail directly is its
   3914   ;; interactive specification, which just supplies nil for the
   3915   ;; address (and several other arguments).
   3916   (interactive "sTo: ")
   3917   (compose-mail address))
   3918 
   3919 (autoload 'pp-display-expression "pp")
   3920 
   3921 (defun embark-pp-eval-defun (edebug)
   3922   "Run `eval-defun' and pretty print the result.
   3923 With a prefix argument EDEBUG, instrument the code for debugging."
   3924   (interactive "P")
   3925   (cl-letf (((symbol-function #'eval-expression-print-format)
   3926              (lambda (result)
   3927                (pp-display-expression result "*Pp Eval Output*"))))
   3928     (eval-defun edebug)))
   3929 
   3930 (defun embark-eval-replace (noquote)
   3931   "Evaluate region and replace with evaluated result.
   3932 If NOQUOTE is non-nil (interactively, if called with a prefix
   3933 argument), no quoting is used for strings."
   3934   (interactive "P")
   3935   (let ((beg (region-beginning))
   3936         (end (region-end)))
   3937     (save-excursion
   3938       (goto-char end)
   3939       (insert (format (if noquote "%s" "%S")
   3940                (eval (read (buffer-substring beg end)) lexical-binding)))
   3941       (delete-region beg end))))
   3942 
   3943 (when (< emacs-major-version 29)
   3944   (defun embark-elp-restore-package (prefix)
   3945     "Remove instrumentation from functions with names starting with PREFIX."
   3946     (interactive "SPrefix: ")
   3947     (when (fboundp 'elp-restore-list)
   3948       (elp-restore-list
   3949        (mapcar #'intern
   3950                (all-completions (symbol-name prefix)
   3951                                 obarray 'elp-profilable-p))))))
   3952 
   3953 (defmacro embark--define-hash (algorithm)
   3954   "Define command which computes hash from a string.
   3955 ALGORITHM is the hash algorithm symbol understood by `secure-hash'."
   3956   `(defun ,(intern (format "embark-hash-%s" algorithm)) (str)
   3957      ,(format "Compute %s hash of STR and store it in the kill ring." algorithm)
   3958      (interactive "sString: ")
   3959      (let ((hash (secure-hash ',algorithm str)))
   3960        (kill-new hash)
   3961        (message "%s: %s" ',algorithm hash))))
   3962 
   3963 (embark--define-hash md5)
   3964 (embark--define-hash sha1)
   3965 (embark--define-hash sha224)
   3966 (embark--define-hash sha256)
   3967 (embark--define-hash sha384)
   3968 (embark--define-hash sha512)
   3969 
   3970 (defun embark-encode-url (start end)
   3971   "Properly URI-encode the region between START and END in current buffer."
   3972   (interactive "r")
   3973   (let ((encoded (url-encode-url (buffer-substring-no-properties start end))))
   3974     (delete-region start end)
   3975     (insert encoded)))
   3976 
   3977 (defun embark-decode-url (start end)
   3978   "Decode the URI-encoded region between START and END in current buffer."
   3979   (interactive "r")
   3980   (let ((decoded (url-unhex-string (buffer-substring-no-properties start end))))
   3981     (delete-region start end)
   3982     (insert decoded)))
   3983 
   3984 (defvar epa-replace-original-text)
   3985 (defun embark-epa-decrypt-region (start end)
   3986   "Decrypt region between START and END."
   3987   (interactive "r")
   3988   (let ((epa-replace-original-text t))
   3989     (epa-decrypt-region start end)))
   3990 
   3991 (defvar eww-download-directory)
   3992 (autoload 'eww-download-callback "eww")
   3993 
   3994 (defun embark-download-url (url)
   3995   "Download URL to `eww-download-directory'."
   3996   (interactive "sDownload URL: ")
   3997   (let ((dir eww-download-directory))
   3998     (when (functionp dir) (setq dir (funcall dir)))
   3999     (access-file dir "Download failed")
   4000     (url-retrieve
   4001      url #'eww-download-callback
   4002      (if (>= emacs-major-version 28) (list url dir) (list url)))))
   4003 
   4004 ;;; Setup and pre-action hooks
   4005 
   4006 (defun embark--restart (&rest _)
   4007   "Restart current command with current input.
   4008 Use this to refresh the list of candidates for commands that do
   4009 not handle that themselves."
   4010   (when (minibufferp)
   4011     (embark--become-command embark--command (minibuffer-contents))))
   4012 
   4013 (defun embark--shell-prep (&rest _)
   4014   "Prepare target for use as argument for a shell command.
   4015 This quotes the spaces, inserts an extra space at the beginning
   4016 and leaves the point to the left of it."
   4017   (let ((contents (minibuffer-contents)))
   4018     (delete-minibuffer-contents)
   4019     (insert " " (shell-quote-wildcard-pattern contents))
   4020     (goto-char (minibuffer-prompt-end))))
   4021 
   4022 (defun embark--force-complete (&rest _)
   4023   "Select first minibuffer completion candidate matching target."
   4024   (minibuffer-force-complete))
   4025 
   4026 (cl-defun embark--eval-prep (&key type &allow-other-keys)
   4027   "If target's TYPE is variable, skip edit; if function, wrap in ()."
   4028   (when (memq type '(command function))
   4029     (embark--allow-edit)
   4030     (goto-char (minibuffer-prompt-end))
   4031     (insert "(")
   4032     (goto-char (point-max))
   4033     (insert ")")
   4034     (backward-char)))
   4035 
   4036 (cl-defun embark--beginning-of-target (&key bounds &allow-other-keys)
   4037   "Go to beginning of the target BOUNDS."
   4038   (when (number-or-marker-p (car bounds))
   4039     (goto-char (car bounds))))
   4040 
   4041 (cl-defun embark--end-of-target (&key bounds &allow-other-keys)
   4042   "Go to end of the target BOUNDS."
   4043   (when (number-or-marker-p (cdr bounds))
   4044     (goto-char (cdr bounds))))
   4045 
   4046 (cl-defun embark--mark-target (&rest rest &key run bounds &allow-other-keys)
   4047   "Mark the target if its BOUNDS are known.
   4048 After marking the target, call RUN with the REST of its arguments."
   4049   (cond
   4050    ((and bounds run)
   4051     (save-mark-and-excursion
   4052       (set-mark (cdr bounds))
   4053       (goto-char (car bounds))
   4054       (apply run :bounds bounds rest)))
   4055    (bounds ;; used as pre- or post-action hook
   4056     (set-mark (cdr bounds))
   4057     (goto-char (car bounds)))
   4058    (run (apply run rest))))
   4059 
   4060 (cl-defun embark--unmark-target (&rest _)
   4061   "Deactivate the region target."
   4062   (deactivate-mark t))
   4063 
   4064 (cl-defun embark--narrow-to-target
   4065     (&rest rest &key run bounds &allow-other-keys)
   4066   "Narrow buffer to target if its BOUNDS are known.
   4067 Intended for use as an Embark around-action hook.  This function
   4068 runs RUN with the buffer narrowed to given BOUNDS passing along
   4069 the REST of the arguments."
   4070   (if bounds
   4071     (save-excursion
   4072       (save-restriction
   4073         (narrow-to-region (car bounds) (cdr bounds))
   4074         (goto-char (car bounds))
   4075         (apply run :bounds bounds rest)))
   4076     (apply run rest)))
   4077 
   4078 (defun embark--allow-edit (&rest _)
   4079   "Allow editing the target."
   4080   (remove-hook 'post-command-hook #'exit-minibuffer t)
   4081   (remove-hook 'post-command-hook 'ivy-immediate-done t))
   4082 
   4083 (defun embark--ignore-target (&rest _)
   4084   "Ignore the target."
   4085   (let ((contents
   4086          (get-text-property (minibuffer-prompt-end) 'embark--initial-input)))
   4087     (delete-minibuffer-contents)
   4088     (when contents (insert contents)))
   4089   (embark--allow-edit))
   4090 
   4091 (autoload 'xref-push-marker-stack "xref")
   4092 (defun embark--xref-push-marker (&rest _)
   4093   "Push a marker onto the xref marker stack."
   4094   (xref-push-marker-stack))
   4095 
   4096 (cl-defun embark--confirm (&key action target &allow-other-keys)
   4097   "Ask for confirmation before running the ACTION on the TARGET."
   4098   (unless (y-or-n-p (format "Run %s on %s? " action target))
   4099     (user-error "Canceled")))
   4100 
   4101 (defconst embark--associated-file-fn-alist
   4102   `((file . identity)
   4103     (buffer . ,(lambda (target)
   4104                  (let ((buffer (get-buffer target)))
   4105                    (or (buffer-file-name buffer)
   4106                        (buffer-local-value 'default-directory buffer)))))
   4107     (bookmark . bookmark-location)
   4108     (library . locate-library))
   4109   "Alist of functions that extract a file path from targets of a given type.")
   4110 
   4111 (defun embark--associated-directory (target type)
   4112   "Return directory associated to TARGET of given TYPE.
   4113 The supported values of TYPE are file, buffer, bookmark and
   4114 library, which have an obvious notion of associated directory."
   4115   (when-let ((file-fn (alist-get type embark--associated-file-fn-alist))
   4116              (file (funcall file-fn target)))
   4117     (if (file-directory-p file)
   4118         (file-name-as-directory file)
   4119       (file-name-directory file))))
   4120 
   4121 (cl-defun embark--cd (&rest rest &key run target type &allow-other-keys)
   4122   "Run action with `default-directory' set to the directory of TARGET.
   4123 The supported values of TYPE are file, buffer, bookmark and
   4124 library, which have an obvious notion of associated directory.
   4125 The REST of the arguments are also passed to RUN."
   4126   (let ((default-directory
   4127           (or (embark--associated-directory target type) default-directory)))
   4128     (apply run :target target :type type rest)))
   4129 
   4130 (cl-defun embark--save-excursion (&rest rest &key run &allow-other-keys)
   4131   "Run action without moving point.
   4132 This simply calls RUN with the REST of its arguments inside
   4133 `save-excursion'."
   4134   (save-excursion (apply run rest)))
   4135 
   4136 (defun embark--universal-argument (&rest _)
   4137   "Run action with a universal prefix argument."
   4138   (setq prefix-arg '(4)))
   4139 
   4140 ;;; keymaps
   4141 
   4142 (defvar-keymap embark-meta-map
   4143   :doc "Keymap for non-action Embark functions."
   4144   "-" #'negative-argument
   4145   "0" #'digit-argument
   4146   "1" #'digit-argument
   4147   "2" #'digit-argument
   4148   "3" #'digit-argument
   4149   "4" #'digit-argument
   4150   "5" #'digit-argument
   4151   "6" #'digit-argument
   4152   "7" #'digit-argument
   4153   "8" #'digit-argument
   4154   "9" #'digit-argument)
   4155 
   4156 (defvar-keymap embark-general-map
   4157   :doc "Keymap for Embark general actions."
   4158   :parent embark-meta-map
   4159   "i" #'embark-insert
   4160   "w" #'embark-copy-as-kill
   4161   "q" #'embark-toggle-quit
   4162   "E" #'embark-export
   4163   "S" #'embark-collect
   4164   "L" #'embark-live
   4165   "B" #'embark-become
   4166   "A" #'embark-act-all
   4167   "C-s" #'embark-isearch-forward
   4168   "C-r" #'embark-isearch-backward
   4169   "C-SPC" #'mark
   4170   "DEL" #'delete-region
   4171   "SPC" #'embark-select)
   4172 
   4173 (defvar-keymap embark-encode-map
   4174   :doc "Keymap for Embark region encoding actions."
   4175   "r" #'rot13-region
   4176   "." #'morse-region
   4177   "-" #'unmorse-region
   4178   "s" #'studlify-region
   4179   "m" #'embark-hash-md5
   4180   "1" #'embark-hash-sha1
   4181   "2" #'embark-hash-sha256
   4182   "3" #'embark-hash-sha384
   4183   "4" #'embark-hash-sha224
   4184   "5" #'embark-hash-sha512
   4185   "f" #'format-encode-region
   4186   "F" #'format-decode-region
   4187   "b" #'base64-encode-region
   4188   "B" #'base64-decode-region
   4189   "u" #'embark-encode-url
   4190   "U" #'embark-decode-url
   4191   "c" #'epa-encrypt-region
   4192   "C" #'embark-epa-decrypt-region)
   4193 
   4194 (fset 'embark-encode-map embark-encode-map)
   4195 
   4196 (defvar-keymap embark-sort-map
   4197   :doc "Keymap for Embark actions that sort the region"
   4198   "l" #'sort-lines
   4199   "P" #'sort-pages
   4200   "f" #'sort-fields
   4201   "c" #'sort-columns
   4202   "p" #'sort-paragraphs
   4203   "r" #'sort-regexp-fields
   4204   "n" #'sort-numeric-fields)
   4205 
   4206 (fset 'embark-sort-map embark-sort-map)
   4207 
   4208 ;; these will have autoloads in Emacs 28
   4209 (autoload 'calc-grab-sum-down "calc" nil t)
   4210 (autoload 'calc-grab-sum-across "calc" nil t)
   4211 
   4212 ;; this has had an autoload cookie since at least Emacs 26
   4213 ;; but that autoload doesn't seem to work for me
   4214 (autoload 'org-table-convert-region "org-table" nil t)
   4215 
   4216 (defvar-keymap embark-region-map
   4217   :doc "Keymap for Embark actions on the active region."
   4218   :parent embark-general-map
   4219   "u" #'upcase-region
   4220   "l" #'downcase-region
   4221   "c" #'capitalize-region
   4222   "|" #'shell-command-on-region
   4223   "e" #'eval-region
   4224   "<" #'embark-eval-replace
   4225   "a" #'align
   4226   "A" #'align-regexp
   4227   "<left>" #'indent-rigidly
   4228   "<right>" #'indent-rigidly
   4229   "TAB" #'indent-region
   4230   "f" #'fill-region
   4231   "p" #'fill-region-as-paragraph
   4232   "$" #'ispell-region
   4233   "=" #'count-words-region
   4234   "F" #'whitespace-cleanup-region
   4235   "t" #'transpose-regions
   4236   "o" #'org-table-convert-region
   4237   ";" #'comment-or-uncomment-region
   4238   "W" #'write-region
   4239   "+" #'append-to-file
   4240   "m" #'apply-macro-to-region-lines
   4241   "n" #'narrow-to-region
   4242   "*" #'calc-grab-region
   4243   ":" #'calc-grab-sum-down
   4244   "_" #'calc-grab-sum-across
   4245   "r" #'reverse-region
   4246   "d" #'delete-duplicate-lines
   4247   "b" #'browse-url-of-region
   4248   "h" #'shr-render-region
   4249   "'" #'expand-region-abbrevs
   4250   "v" #'vc-region-history
   4251   "R" #'repunctuate-sentences
   4252   "s" 'embark-sort-map
   4253   ">" 'embark-encode-map)
   4254 
   4255 (defvar-keymap embark-vc-file-map
   4256   :doc "Keymap for Embark VC file actions."
   4257   "d" #'vc-delete-file
   4258   "r" #'vc-rename-file
   4259   "i" #'vc-ignore)
   4260 
   4261 (fset 'embark-vc-file-map embark-vc-file-map)
   4262 
   4263 (defvar-keymap embark-file-map
   4264   :doc "Keymap for Embark file actions."
   4265   :parent embark-general-map
   4266   "RET" #'find-file
   4267   "f" #'find-file
   4268   "F" #'find-file-literally
   4269   "o" #'find-file-other-window
   4270   "d" #'delete-file
   4271   "D" #'delete-directory
   4272   "r" #'rename-file
   4273   "c" #'copy-file
   4274   "s" #'make-symbolic-link
   4275   "j" #'embark-dired-jump
   4276   "!" #'shell-command
   4277   "&" #'async-shell-command
   4278   "$" #'eshell
   4279   "<" #'insert-file
   4280   "m" #'chmod
   4281   "=" #'ediff-files
   4282   "+" #'make-directory
   4283   "\\" #'embark-recentf-remove
   4284   "I" #'embark-insert-relative-path
   4285   "W" #'embark-save-relative-path
   4286   "x" #'embark-open-externally
   4287   "e" #'eww-open-file
   4288   "l" #'load-file
   4289   "b" #'byte-compile-file
   4290   "R" #'byte-recompile-directory
   4291   "v" 'embark-vc-file-map)
   4292 
   4293 (defvar-keymap embark-kill-ring-map
   4294   :doc "Keymap for `kill-ring' commands."
   4295   :parent embark-general-map
   4296   "\\" #'embark-kill-ring-remove)
   4297 
   4298 (defvar-keymap embark-url-map
   4299   :doc "Keymap for Embark url actions."
   4300   :parent embark-general-map
   4301   "RET" #'browse-url
   4302   "b" #'browse-url
   4303   "d" #'embark-download-url
   4304   "x" #'embark-open-externally
   4305   "e" #'eww)
   4306 
   4307 (defvar-keymap embark-email-map
   4308   :doc "Keymap for Embark email actions."
   4309   :parent embark-general-map
   4310   "RET" #'embark-compose-mail
   4311   "c" #'embark-compose-mail)
   4312 
   4313 (defvar-keymap embark-library-map
   4314   :doc "Keymap for operations on Emacs Lisp libraries."
   4315   :parent embark-general-map
   4316   "RET" #'find-library
   4317   "l" #'load-library
   4318   "f" #'find-library
   4319   "h" #'finder-commentary
   4320   "a" #'apropos-library
   4321   "L" #'locate-library
   4322   "m" #'info-display-manual
   4323   "$" #'eshell)
   4324 
   4325 (defvar-keymap embark-buffer-map
   4326   :doc "Keymap for Embark buffer actions."
   4327   :parent embark-general-map
   4328   "RET" #'switch-to-buffer
   4329   "k" #'kill-buffer
   4330   "b" #'switch-to-buffer
   4331   "o" #'switch-to-buffer-other-window
   4332   "z" #'embark-bury-buffer
   4333   "K" #'embark-kill-buffer-and-window
   4334   "r" #'embark-rename-buffer
   4335   "=" #'ediff-buffers
   4336   "|" #'embark-shell-command-on-buffer
   4337   "<" #'insert-buffer
   4338   "$" #'eshell)
   4339 
   4340 (defvar-keymap embark-tab-map
   4341   :doc "Keymap for actions for tab-bar tabs."
   4342   :parent embark-general-map
   4343   "RET" #'tab-bar-select-tab-by-name
   4344   "s" #'tab-bar-select-tab-by-name
   4345   "r" #'tab-bar-rename-tab-by-name
   4346   "k" #'tab-bar-close-tab-by-name)
   4347 
   4348 (defvar-keymap embark-identifier-map
   4349   :doc "Keymap for Embark identifier actions."
   4350   :parent embark-general-map
   4351   "RET" #'xref-find-definitions
   4352   "h" #'display-local-help
   4353   "H" #'embark-toggle-highlight
   4354   "d" #'xref-find-definitions
   4355   "r" #'xref-find-references
   4356   "a" #'xref-find-apropos
   4357   "s" #'info-lookup-symbol
   4358   "n" #'embark-next-symbol
   4359   "p" #'embark-previous-symbol
   4360   "'" #'expand-abbrev
   4361   "$" #'ispell-word
   4362   "o" #'occur)
   4363 
   4364 (defvar-keymap embark-expression-map
   4365   :doc "Keymap for Embark expression actions."
   4366   :parent embark-general-map
   4367   "RET" #'pp-eval-expression
   4368   "e" #'pp-eval-expression
   4369   "<" #'embark-eval-replace
   4370   "m" #'pp-macroexpand-expression
   4371   "TAB" #'indent-region
   4372   "r" #'raise-sexp
   4373   "t" #'transpose-sexps
   4374   "k" #'kill-region
   4375   "u" #'backward-up-list
   4376   "n" #'forward-list
   4377   "p" #'backward-list)
   4378 
   4379 (defvar-keymap embark-defun-map
   4380   :doc "Keymap for Embark defun actions."
   4381   :parent embark-expression-map
   4382   "RET" #'embark-pp-eval-defun
   4383   "e" #'embark-pp-eval-defun
   4384   "c" #'compile-defun
   4385   "D" #'edebug-defun
   4386   "o" #'checkdoc-defun
   4387   "N" #'narrow-to-defun)
   4388 
   4389 ;; Use quoted symbols to avoid byte-compiler warnings.
   4390 (defvar-keymap embark-heading-map
   4391   :doc "Keymap for Embark heading actions."
   4392   :parent embark-general-map
   4393   "RET" 'outline-show-subtree
   4394   "TAB" 'outline-cycle ;; New in Emacs 28!
   4395   "C-SPC" 'outline-mark-subtree
   4396   "n" 'outline-next-visible-heading
   4397   "p" 'outline-previous-visible-heading
   4398   "f" 'outline-forward-same-level
   4399   "b" 'outline-backward-same-level
   4400   "^" 'outline-move-subtree-up
   4401   "v" 'outline-move-subtree-down
   4402   "u" 'outline-up-heading
   4403   "+" 'outline-show-subtree
   4404   "-" 'outline-hide-subtree
   4405   ">" 'outline-demote
   4406   "<" 'outline-promote)
   4407 
   4408 (defvar-keymap embark-symbol-map
   4409   :doc "Keymap for Embark symbol actions."
   4410   :parent embark-identifier-map
   4411   "RET" #'embark-find-definition
   4412   "h" #'describe-symbol
   4413   "s" #'embark-info-lookup-symbol
   4414   "d" #'embark-find-definition
   4415   "e" #'pp-eval-expression
   4416   "a" #'apropos
   4417   "\\" #'embark-history-remove)
   4418 
   4419 (defvar-keymap embark-face-map
   4420   :doc "Keymap for Embark face actions."
   4421   :parent embark-symbol-map
   4422   "h" #'describe-face
   4423   "c" #'customize-face
   4424   "+" #'make-face-bold
   4425   "-" #'make-face-unbold
   4426   "/" #'make-face-italic
   4427   "|" #'make-face-unitalic
   4428   "!" #'invert-face
   4429   "f" #'set-face-foreground
   4430   "b" #'set-face-background)
   4431 
   4432 (defvar-keymap embark-variable-map
   4433   :doc "Keymap for Embark variable actions."
   4434   :parent embark-symbol-map
   4435   "=" #'set-variable
   4436   "c" #'customize-set-variable
   4437   "u" #'customize-variable
   4438   "v" #'embark-save-variable-value
   4439   "<" #'embark-insert-variable-value
   4440   "t" #'embark-toggle-variable)
   4441 
   4442 (defvar-keymap embark-function-map
   4443   :doc "Keymap for Embark function actions."
   4444   :parent embark-symbol-map
   4445   "m" #'elp-instrument-function ;; m=measure
   4446   "M" 'elp-restore-function ;; quoted, not autoloaded
   4447   "k" #'debug-on-entry ;; breaKpoint (running out of letters, really)
   4448   "K" #'cancel-debug-on-entry
   4449   "t" #'trace-function
   4450   "T" 'untrace-function) ;; quoted, not autoloaded
   4451 
   4452 (defvar-keymap embark-command-map
   4453   :doc "Keymap for Embark command actions."
   4454   :parent embark-function-map
   4455   "x" #'execute-extended-command
   4456   "I" #'Info-goto-emacs-command-node
   4457   "b" #'where-is
   4458   "g" #'global-set-key
   4459   "l" #'local-set-key)
   4460 
   4461 (defvar-keymap embark-package-map
   4462   :doc "Keymap for Embark package actions."
   4463   :parent embark-general-map
   4464   "RET" #'describe-package
   4465   "h" #'describe-package
   4466   "i" #'package-install
   4467   "I" #'embark-insert
   4468   "d" #'package-delete
   4469   "r" #'package-reinstall
   4470   "u" #'embark-browse-package-url
   4471   "W" #'embark-save-package-url
   4472   "a" #'package-autoremove
   4473   "g" #'package-refresh-contents
   4474   "m" #'elp-instrument-package ;; m=measure
   4475   "M" (if (fboundp 'embark-elp-restore-package)
   4476         'embark-elp-restore-package
   4477         'elp-restore-package))
   4478 
   4479 (defvar-keymap embark-bookmark-map
   4480   :doc "Keymap for Embark bookmark actions."
   4481   :parent embark-general-map
   4482   "RET" #'bookmark-jump
   4483   "s" #'bookmark-set
   4484   "d" #'bookmark-delete
   4485   "r" #'bookmark-rename
   4486   "R" #'bookmark-relocate
   4487   "l" #'bookmark-locate
   4488   "<" #'bookmark-insert
   4489   "j" #'bookmark-jump
   4490   "o" #'bookmark-jump-other-window
   4491   "f" #'bookmark-jump-other-frame
   4492   "a" 'bookmark-show-annotation
   4493   "e" 'bookmark-edit-annotation
   4494   "x" #'embark-bookmark-open-externally
   4495   "$" #'eshell)
   4496 
   4497 (defvar-keymap embark-unicode-name-map
   4498   :doc "Keymap for Embark Unicode name actions."
   4499   :parent embark-general-map
   4500   "RET" #'insert-char
   4501   "I" #'insert-char
   4502   "W" #'embark-save-unicode-character)
   4503 
   4504 (defvar-keymap embark-prose-map
   4505   :doc "Keymap for Embark actions for dealing with prose."
   4506   :parent embark-general-map
   4507   "$" #'ispell-region
   4508   "f" #'fill-region
   4509   "u" #'upcase-region
   4510   "l" #'downcase-region
   4511   "c" #'capitalize-region
   4512   "F" #'whitespace-cleanup-region
   4513   "=" #'count-words-region)
   4514 
   4515 (defvar-keymap embark-sentence-map
   4516   :doc "Keymap for Embark actions for dealing with sentences."
   4517   :parent embark-prose-map
   4518   "t" #'transpose-sentences
   4519   "n" #'forward-sentence
   4520   "p" #'backward-sentence)
   4521 
   4522 (defvar-keymap embark-paragraph-map
   4523   :doc "Keymap for Embark actions for dealing with paragraphs."
   4524   :parent embark-prose-map
   4525   "t" #'transpose-paragraphs
   4526   "n" #'forward-paragraph
   4527   "p" #'backward-paragraph
   4528   "R" #'repunctuate-sentences)
   4529 
   4530 (defvar-keymap embark-flymake-map
   4531   :doc "Keymap for Embark actions on Flymake diagnostics."
   4532   :parent embark-general-map
   4533   "RET" 'flymake-show-buffer-diagnostics
   4534   "n" 'flymake-goto-next-error
   4535   "p" 'flymake-goto-prev-error)
   4536 
   4537 (defvar-keymap embark-become-help-map
   4538   :doc "Keymap for Embark help actions."
   4539   :parent embark-meta-map
   4540   "V" #'apropos-variable
   4541   "U" #'apropos-user-option
   4542   "C" #'apropos-command
   4543   "v" #'describe-variable
   4544   "f" #'describe-function
   4545   "s" #'describe-symbol
   4546   "F" #'describe-face
   4547   "p" #'describe-package
   4548   "i" #'describe-input-method)
   4549 
   4550 (autoload 'recentf-open-files "recentf" nil t)
   4551 
   4552 (defvar-keymap embark-become-file+buffer-map
   4553   :doc "Embark become keymap for files and buffers."
   4554   :parent embark-meta-map
   4555   "f" #'find-file
   4556   "4 f" #'find-file-other-window
   4557   "." #'find-file-at-point
   4558   "p" #'project-find-file
   4559   "r" #'recentf-open-files
   4560   "b" #'switch-to-buffer
   4561   "4 b" #'switch-to-buffer-other-window
   4562   "l" #'locate
   4563   "L" #'find-library
   4564   "v" #'vc-dir)
   4565 
   4566 (defvar-keymap embark-become-shell-command-map
   4567   :doc "Embark become keymap for shell commands."
   4568   :parent embark-meta-map
   4569   "!" #'shell-command
   4570   "&" #'async-shell-command
   4571   "c" #'comint-run
   4572   "t" #'term)
   4573 
   4574 (defvar-keymap embark-become-match-map
   4575   :doc "Embark become keymap for search."
   4576   :parent embark-meta-map
   4577   "o" #'occur
   4578   "k" #'keep-lines
   4579   "f" #'flush-lines
   4580   "c" #'count-matches)
   4581 
   4582 (provide 'embark)
   4583 
   4584 ;; Check that embark-consult is installed. If Embark is used in
   4585 ;; combination with Consult, you should install the integration package,
   4586 ;; such that features like embark-export from consult-grep work as
   4587 ;; expected.
   4588 
   4589 (with-eval-after-load 'consult
   4590   (unless (require 'embark-consult nil 'noerror)
   4591     (warn "The package embark-consult should be installed if you use both Embark and Consult")))
   4592 
   4593 (with-eval-after-load 'org
   4594   (require 'embark-org))
   4595 
   4596 ;;; embark.el ends here