config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

embark.el (191900B)


      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.1
      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
   1283            'mac-mwheel-scroll 'pixel-scroll-precision)
   1284        (funcall cmd last-command-event)
   1285        (embark-keymap-prompter keymap update))
   1286       ('execute-extended-command
   1287        (let ((prefix-arg prefix-arg)) ; preserve prefix arg
   1288          (intern-soft (read-extended-command))))
   1289       ((or 'keyboard-quit 'keyboard-escape-quit)
   1290        nil)
   1291       (_ cmd))))
   1292 
   1293 (defun embark--command-name (cmd)
   1294   "Return an appropriate name for CMD.
   1295 If CMD is a symbol, use its symbol name; for lambdas, use the
   1296 first line of the documentation string; for keyboard macros use
   1297 `key-description'; otherwise use the word \"unnamed\"."
   1298   (concat ; fresh copy, so we can freely add text properties
   1299    (cond
   1300     ((or (stringp cmd) (vectorp cmd)) (key-description cmd))
   1301     ((stringp (car-safe cmd)) (car cmd))
   1302     ((eq (car-safe cmd) 'menu-item) (eval (cadr cmd)))
   1303     ((keymapp cmd)
   1304      (propertize (if (symbolp cmd) (format "+%s" cmd) "<keymap>")
   1305                  'face 'embark-keymap))
   1306     ((symbolp cmd)
   1307      (let ((name (symbol-name cmd)))
   1308        (if (string-prefix-p "embark-action--" name) ; direct action mode
   1309            (format "(%s)" (string-remove-prefix "embark-action--" name))
   1310          name)))
   1311     ((when-let (doc (and (functionp cmd) (ignore-errors (documentation cmd))))
   1312        (save-match-data
   1313          (when (string-match "^\\(.*\\)$" doc)
   1314            (match-string 1 doc)))))
   1315     (t "<unnamed>"))))
   1316 
   1317 ;; Taken from Marginalia, needed by the verbose indicator.
   1318 ;; We cannot use the completion annotators in this case.
   1319 (defconst embark--advice-regexp
   1320   (rx bos
   1321       (1+ (seq (? "This function has ")
   1322                (or ":before" ":after" ":around" ":override"
   1323                    ":before-while" ":before-until" ":after-while"
   1324                    ":after-until" ":filter-args" ":filter-return")
   1325                " advice: " (0+ nonl) "\n"))
   1326       "\n")
   1327   "Regexp to match lines about advice in function documentation strings.")
   1328 
   1329 ;; Taken from Marginalia, needed by the verbose indicator.
   1330 ;; We cannot use the completion annotators in this case.
   1331 (defun embark--function-doc (sym)
   1332   "Documentation string of function SYM."
   1333   (let ((vstr (and (symbolp sym) (keymapp sym) (boundp sym)
   1334                    (eq (symbol-function sym) (symbol-value sym))
   1335                    (documentation-property sym 'variable-documentation))))
   1336     (when-let (str (or (ignore-errors (documentation sym)) vstr))
   1337       ;; Replace standard description with variable documentation
   1338       (when (and vstr (string-match-p "\\`Prefix command" str))
   1339         (setq str vstr))
   1340       (save-match-data
   1341         (if (string-match embark--advice-regexp str)
   1342             (substring str (match-end 0))
   1343           str)))))
   1344 
   1345 (defun embark--action-repeatable-p (action)
   1346   "Is ACTION repeatable?
   1347 When the return value is non-nil it will be the desired starting
   1348 point of the next target cycle or t to indicate the default,
   1349 namely that the target cycle for the next action should begin at
   1350 the type of the current target."
   1351   (or (cdr (assq action embark-repeat-actions))
   1352       (and (memq action embark-repeat-actions) t)))
   1353 
   1354 (defun embark--formatted-bindings (keymap &optional nested)
   1355   "Return the formatted keybinding of KEYMAP.
   1356 The keybindings are returned in their order of appearance.
   1357 If NESTED is non-nil subkeymaps are not flattened."
   1358   (let* ((commands
   1359           (cl-loop for (key . def) in (embark--all-bindings keymap nested)
   1360                    for name = (embark--command-name def)
   1361                    for cmd = (keymap--menu-item-binding def)
   1362                    unless (memq cmd '(nil embark-keymap-help
   1363                                       negative-argument digit-argument))
   1364                    collect (list name cmd key
   1365                                  (concat
   1366                                   (if (eq (car-safe def) 'menu-item)
   1367                                       "menu-item"
   1368                                     (key-description key))))))
   1369          (width (cl-loop for (_name _cmd _key desc) in commands
   1370                          maximize (length desc)))
   1371          (default)
   1372          (candidates
   1373           (cl-loop for item in commands
   1374                    for (name cmd key desc) = item
   1375                    for desc-rep =
   1376                    (concat
   1377                     (propertize desc 'face 'embark-keybinding)
   1378                     (and (embark--action-repeatable-p cmd)
   1379                          embark-keybinding-repeat))
   1380                    for formatted =
   1381                    (propertize
   1382                     (concat desc-rep
   1383                             (make-string (- width (length desc-rep) -1) ?\s)
   1384                             name)
   1385                     'embark-command cmd)
   1386                    when (equal key [13])
   1387                    do (setq default formatted)
   1388                    collect (cons formatted item))))
   1389     (cons candidates default)))
   1390 
   1391 (defun embark--with-category (category candidates)
   1392   "Return completion table for CANDIDATES of CATEGORY with sorting disabled."
   1393   (lambda (string predicate action)
   1394     (if (eq action 'metadata)
   1395         `(metadata (display-sort-function . identity)
   1396                    (cycle-sort-function . identity)
   1397                    (category . ,category))
   1398       (complete-with-action
   1399        action candidates string predicate))))
   1400 
   1401 (defun embark-completing-read-prompter (keymap update &optional no-default)
   1402   "Prompt via completion for a command bound in KEYMAP.
   1403 If NO-DEFAULT is t, no default value is passed to`completing-read'.
   1404 
   1405 UPDATE is the indicator update function.  It is not used directly
   1406 here, but if the user switches to `embark-keymap-prompter', the
   1407 UPDATE function is passed to it."
   1408   (let* ((candidates+def (embark--formatted-bindings keymap))
   1409          (candidates (car candidates+def))
   1410          (def (and (not no-default) (cdr candidates+def)))
   1411          (buf (current-buffer))
   1412          (choice
   1413           (catch 'choice
   1414             (minibuffer-with-setup-hook
   1415                 (lambda ()
   1416                   (let ((map (make-sparse-keymap)))
   1417                     (define-key map "\M-q"
   1418                                 (lambda ()
   1419                                   (interactive)
   1420                                   (with-current-buffer buf
   1421                                     (embark-toggle-quit))))
   1422                     (when-let (cycle (embark--cycle-key))
   1423                       ;; Rebind `embark-cycle' in order allow cycling
   1424                       ;; from the `completing-read' prompter. Additionally
   1425                       ;; `embark-cycle' can be selected via
   1426                       ;; `completing-read'. The downside is that this breaks
   1427                       ;; recursively acting on the candidates of type
   1428                       ;; embark-keybinding in the `completing-read' prompter.
   1429                       (define-key map cycle
   1430                         (cond
   1431                          ((eq (lookup-key keymap cycle) 'embark-cycle)
   1432                           (lambda ()
   1433                             (interactive)
   1434                             (throw 'choice 'embark-cycle)))
   1435                          ((null embark-cycle-key)
   1436                           (lambda ()
   1437                             (interactive)
   1438                             (minibuffer-message
   1439                              "No cycling possible; press `%s' again to act."
   1440                              (key-description cycle))
   1441                             (define-key map cycle #'embark-act))))))
   1442                     (when embark-keymap-prompter-key
   1443                       (keymap-set map embark-keymap-prompter-key
   1444                         (lambda ()
   1445                           (interactive)
   1446                           (message "Press key binding")
   1447                           (let ((cmd (embark-keymap-prompter keymap update)))
   1448                             (if (null cmd)
   1449                                 (user-error "Unknown key")
   1450                               (throw 'choice cmd))))))
   1451                     (use-local-map
   1452                      (make-composed-keymap map (current-local-map)))))
   1453               (completing-read
   1454                "Command: "
   1455                (embark--with-category 'embark-keybinding candidates)
   1456                nil nil nil 'embark--prompter-history def)))))
   1457     (pcase (assoc choice candidates)
   1458       (`(,_formatted ,_name ,cmd ,key ,_desc)
   1459        ;; Set last-command-event as it would be from the command loop.
   1460        (setq last-command-event (aref key (1- (length key))))
   1461        cmd)
   1462       ('nil (intern-soft choice)))))
   1463 
   1464 ;;; Verbose action indicator
   1465 
   1466 (defgroup embark-indicators nil
   1467   "Indicators display information about actions and targets."
   1468   :group 'embark)
   1469 
   1470 (defcustom embark-indicators
   1471   '(embark-mixed-indicator
   1472     embark-highlight-indicator
   1473     embark-isearch-highlight-indicator)
   1474   "Indicator functions to use when acting or becoming.
   1475 The indicator functions are called from both `embark-act' and
   1476 from `embark-become' and should display information about this to
   1477 the user, such as: which of those two commands is running; a
   1478 description of the key bindings that are available for actions or
   1479 commands to become; and, in the case of `embark-act', the type
   1480 and value of the targets, and whether other targets are available
   1481 via `embark-cycle'.  The indicator function is free to display as
   1482 much or as little of this information as desired and can use any
   1483 Emacs interface elements to do so.
   1484 
   1485 Embark comes with five such indicators:
   1486 
   1487 - `embark-minimal-indicator', which does not display any
   1488   information about keybindings, but does display types and
   1489   values of action targets in the echo area or minibuffer prompt,
   1490 
   1491 - `embark-verbose-indicator', which pops up a buffer containing
   1492   detailed information including key bindings and the first line
   1493   of the docstring of the commands they run, and
   1494 
   1495 - `embark-mixed-indicator', which combines the minimal and the
   1496   verbose indicator: the minimal indicator is shown first and the
   1497   verbose popup is shown after `embark-mixed-indicator-delay'
   1498   seconds.
   1499 
   1500 - `embark-highlight-indicator', which highlights the target
   1501   at point.
   1502 
   1503 - `embark-isearch-highlight-indicator', which when the target at
   1504   point is an identifier or symbol, lazily highlights all
   1505   occurrences of it.
   1506 
   1507 The protocol for indicator functions is as follows:
   1508 
   1509 When called from `embark-act', an indicator function is called
   1510 without arguments.  The indicator function should then return a
   1511 closure, which captures the indicator state.  The returned
   1512 closure must accept up to three optional arguments, the action
   1513 keymap, the targets (plists as returned by `embark--targets') and
   1514 the prefix keys typed by the user so far.  The keymap, targets
   1515 and prefix keys may be updated when cycling targets at point
   1516 resulting in multiple calls to the closure.  When called from
   1517 `embark-become', the indicator closure will be called with the
   1518 keymap of commands to become, a fake target list containing a
   1519 single target of type `embark-become' and whose value is the
   1520 minibuffer input, and the prefix set to nil.  Note, in
   1521 particular, that if an indicator function wishes to distinguish
   1522 between `embark-act' and `embark-become' it should check whether
   1523 the `car' of the first target is `embark-become'.
   1524 
   1525 After the action has been performed the indicator closure is
   1526 called without arguments, such that the indicator can perform the
   1527 necessary cleanup work.  For example, if the indicator adds
   1528 overlays, it should remove these overlays.  The indicator should
   1529 be written in a way that it is safe to call it for cleanup more
   1530 than once, in fact, it should be able to handle any sequence of
   1531 update and cleanup calls ending in a call for cleanup.
   1532 
   1533 NOTE: Experience shows that the indicator calling convention may
   1534 change again in order to support more action features.  The
   1535 calling convention should currently be considered unstable.
   1536 Please keep this in mind when writing a custom indicator
   1537 function, or when using the `which-key' indicator function from
   1538 the wiki."
   1539   :type '(repeat
   1540           (choice
   1541            (const :tag "Verbose indicator" embark-verbose-indicator)
   1542            (const :tag "Minimal indicator" embark-minimal-indicator)
   1543            (const :tag "Mixed indicator" embark-mixed-indicator)
   1544            (const :tag "Highlight target" embark-highlight-indicator)
   1545            (const :tag "Highlight all occurrences"
   1546                   embark-isearch-highlight-indicator)
   1547            (function :tag "Other"))))
   1548 
   1549 (defface embark-verbose-indicator-documentation
   1550   '((t :inherit completions-annotations))
   1551   "Face used by the verbose action indicator to display binding descriptions.
   1552 Used by `embark-verbose-indicator'.")
   1553 
   1554 (defface embark-verbose-indicator-title '((t :height 1.1 :weight bold))
   1555   "Face used by the verbose action indicator for the title.
   1556 Used by `embark-verbose-indicator'.")
   1557 
   1558 (defface embark-verbose-indicator-shadowed '((t :inherit shadow))
   1559   "Face used by the verbose action indicator for the shadowed targets.
   1560 Used by `embark-verbose-indicator'.")
   1561 
   1562 (defcustom embark-verbose-indicator-display-action
   1563   '(display-buffer-reuse-window)
   1564   "Parameters added to `display-buffer-alist' to show the actions buffer.
   1565 See the docstring of `display-buffer' for information on what
   1566 display actions and parameters are available."
   1567   :type `(choice
   1568           (const :tag "Reuse some window"
   1569                  (display-buffer-reuse-window))
   1570           (const :tag "Below target buffer"
   1571                  (display-buffer-below-selected
   1572                   (window-height . fit-window-to-buffer)))
   1573           (const :tag "Bottom of frame (fixed-size)"
   1574                  (display-buffer-at-bottom))
   1575           (const :tag "Bottom of frame (resizes during cycling)"
   1576                  (display-buffer-at-bottom
   1577                   (window-height . fit-window-to-buffer)))
   1578           (const :tag "Side window on the right"
   1579                  (display-buffer-in-side-window (side . right)))
   1580           (const :tag "Side window on the left"
   1581                  (display-buffer-in-side-window (side . left)))
   1582           (sexp :tag "Other")))
   1583 
   1584 (defcustom embark-verbose-indicator-excluded-actions nil
   1585   "Commands not displayed by `embark-verbose-indicator'.
   1586 This variable should be set to a list of symbols and regexps.
   1587 The verbose indicator will exclude from its listing any commands
   1588 matching an element of this list."
   1589   :type '(choice
   1590           (const :tag "Exclude nothing" nil)
   1591           (const :tag "Exclude Embark general actions"
   1592                  (embark-collect embark-live embark-export
   1593                   embark-cycle embark-act-all embark-keymap-help
   1594                   embark-become embark-isearch-forward
   1595                   embark-isearch-backward))
   1596           (repeat :tag "Other" (choice regexp symbol))))
   1597 
   1598 (defcustom embark-verbose-indicator-buffer-sections
   1599   `(target "\n" shadowed-targets " " cycle "\n" bindings)
   1600   "List of sections to display in the verbose indicator buffer, in order.
   1601 You can use either a symbol designating a concrete section (one
   1602 of the keywords below, but without the colon), a string literal
   1603 or a function returning a string or list of strings to insert and
   1604 that accepts the following keyword arguments:
   1605 
   1606 - `:target', the target as a cons of type and value,
   1607 - `:shadowed-targets', a list of conses for the other targets,
   1608 - `:bindings' a list returned by `embark--formatted-bindings', and
   1609 - `:cycle', a string describing the key binding of `embark-cycle'."
   1610   :type '(repeat
   1611           (choice (const :tag "Current target name" target)
   1612                   (const :tag "List of other shadowed targets" shadowed-targets)
   1613                   (const :tag "Key bindings" bindings)
   1614                   (const :tag "Cycle indicator" cycle)
   1615                   (string :tag "Literal string")
   1616                   (function :tag "Custom function"))))
   1617 
   1618 (defcustom embark-verbose-indicator-nested t
   1619   "Whether the verbose indicator should use nested keymap navigation.
   1620 When this variable is non-nil the actions buffer displayed by
   1621 `embark-verbose-indicator' will include any prefix keys found in
   1622 the keymap it is displaying, and will update to show what is
   1623 bound under the prefix if the prefix is pressed.  If this
   1624 variable is nil, then the actions buffer will contain a flat list
   1625 of all full key sequences bound in the keymap."
   1626   :type 'boolean)
   1627 
   1628 (defun embark--verbose-indicator-excluded-p (cmd)
   1629   "Return non-nil if CMD should be excluded from the verbose indicator."
   1630   (seq-find (lambda (x)
   1631               (if (symbolp x)
   1632                   (eq cmd x)
   1633                 (string-match-p x (symbol-name cmd))))
   1634             embark-verbose-indicator-excluded-actions))
   1635 
   1636 (cl-defun embark--verbose-indicator-section-target
   1637     (&key targets bindings &allow-other-keys)
   1638   "Format the TARGETS section for the indicator buffer.
   1639 BINDINGS is the formatted list of keybindings."
   1640   (let ((result (embark--format-targets
   1641                  (car targets)
   1642                  nil   ; the shadowed targets section deals with these
   1643                  (cl-find 'embark-done bindings :key #'caddr :test #'eq))))
   1644     (add-face-text-property 0 (length result)
   1645                             'embark-verbose-indicator-title
   1646                             'append
   1647                             result)
   1648     result))
   1649 
   1650 (cl-defun embark--verbose-indicator-section-cycle
   1651     (&key cycle shadowed-targets &allow-other-keys)
   1652   "Format the CYCLE key section for the indicator buffer.
   1653 SHADOWED-TARGETS is the list of other targets."
   1654   (concat
   1655    (and cycle (propertize (format "(%s to cycle)" cycle)
   1656                           'face 'embark-verbose-indicator-shadowed))
   1657    (and shadowed-targets "\n")))
   1658 
   1659 (cl-defun embark--verbose-indicator-section-shadowed-targets
   1660     (&key shadowed-targets &allow-other-keys)
   1661   "Format the SHADOWED-TARGETS section for the indicator buffer."
   1662   (when shadowed-targets
   1663     (propertize (format "Shadowed targets at point: %s"
   1664                         (string-join shadowed-targets ", "))
   1665                 'face 'embark-verbose-indicator-shadowed)))
   1666 
   1667 (cl-defun embark--verbose-indicator-section-bindings
   1668     (&key bindings &allow-other-keys)
   1669   "Format the BINDINGS section for the indicator buffer."
   1670   (let* ((max-width (apply #'max (cons 0 (mapcar (lambda (x)
   1671                                                   (string-width (car x)))
   1672                                                 bindings))))
   1673          (fmt (format "%%-%ds" (1+ max-width)))
   1674          (result nil))
   1675     (dolist (binding bindings (string-join (nreverse result)))
   1676       (let ((cmd (caddr binding)))
   1677         (unless (embark--verbose-indicator-excluded-p cmd)
   1678           (let ((keys (format fmt (car binding)))
   1679                 (doc (embark--function-doc cmd)))
   1680             (push (format "%s%s\n" keys
   1681                           (propertize
   1682                            (car (split-string (or doc "") "\n"))
   1683                            'face 'embark-verbose-indicator-documentation))
   1684                           result)))))))
   1685 
   1686 (defun embark--verbose-indicator-update (keymap targets)
   1687   "Update verbose indicator buffer.
   1688 The arguments are the new KEYMAP and TARGETS."
   1689   (with-current-buffer (get-buffer-create embark--verbose-indicator-buffer)
   1690     (let* ((inhibit-read-only t)
   1691            (bindings
   1692             (embark--formatted-bindings keymap embark-verbose-indicator-nested))
   1693            (bindings (car bindings))
   1694            (shadowed-targets (mapcar
   1695                               (lambda (x) (symbol-name (plist-get x :type)))
   1696                               (cdr targets)))
   1697            (cycle (let ((ck (where-is-internal #'embark-cycle keymap)))
   1698                     (and ck (key-description (car ck))))))
   1699       (setq-local cursor-type nil)
   1700       (setq-local truncate-lines t)
   1701       (setq-local buffer-read-only t)
   1702       (erase-buffer)
   1703       (dolist (section embark-verbose-indicator-buffer-sections)
   1704         (insert
   1705          (if (stringp section)
   1706              section
   1707            (or (funcall
   1708                 (let ((prefixed (intern (format
   1709                                          "embark--verbose-indicator-section-%s"
   1710                                          section))))
   1711                   (cond
   1712                    ((fboundp prefixed) prefixed)
   1713                    ((fboundp section) section)
   1714                    (t (error "Undefined verbose indicator section `%s'"
   1715                              section))))
   1716                 :targets targets :shadowed-targets shadowed-targets
   1717                 :bindings bindings :cycle cycle)
   1718                ""))))
   1719       (goto-char (point-min)))))
   1720 
   1721 (defun embark-verbose-indicator ()
   1722   "Indicator that displays a table of key bindings in a buffer.
   1723 The default display includes the type and value of the current
   1724 target, the list of other target types, and a table of key
   1725 bindings, actions and the first line of their docstrings.
   1726 
   1727 The order and formatting of these items is completely
   1728 configurable through the variable
   1729 `embark-verbose-indicator-buffer-sections'.
   1730 
   1731 If the keymap being shown contains prefix keys, the table of key
   1732 bindings can either show just the prefixes and update once the
   1733 prefix is pressed, or it can contain a flat list of all full key
   1734 sequences bound in the keymap.  This is controlled by the
   1735 variable `embark-verbose-indicator-nested'.
   1736 
   1737 To reduce clutter in the key binding table, one can set the
   1738 variable `embark-verbose-indicator-excluded-actions' to a list
   1739 of symbols and regexps matching commands to exclude from the
   1740 table.
   1741 
   1742 To configure how a window is chosen to display this buffer, see
   1743 the variable `embark-verbose-indicator-display-action'."
   1744   (lambda (&optional keymap targets prefix)
   1745     (if (not keymap)
   1746         (when-let ((win (get-buffer-window embark--verbose-indicator-buffer
   1747                                            'visible)))
   1748           (quit-window 'kill-buffer win))
   1749       (embark--verbose-indicator-update
   1750        (if (and prefix embark-verbose-indicator-nested)
   1751            ;; Lookup prefix keymap globally if not found in action keymap
   1752            (let ((overriding-terminal-local-map keymap))
   1753              (key-binding prefix 'accept-default))
   1754          keymap)
   1755        targets)
   1756       (let ((display-buffer-alist
   1757              `(,@display-buffer-alist
   1758                (,(regexp-quote embark--verbose-indicator-buffer)
   1759                 ,@embark-verbose-indicator-display-action))))
   1760         (display-buffer embark--verbose-indicator-buffer)))))
   1761 
   1762 (defcustom embark-mixed-indicator-delay 0.5
   1763   "Time in seconds after which the verbose indicator is shown.
   1764 The mixed indicator starts by showing the minimal indicator and
   1765 after this delay shows the verbose indicator."
   1766   :type '(choice (const :tag "No delay" 0)
   1767                  (number :tag "Delay in seconds")))
   1768 
   1769 (defcustom embark-mixed-indicator-both nil
   1770   "Show both indicators, even after the verbose indicator appeared."
   1771   :type 'boolean)
   1772 
   1773 (defun embark-mixed-indicator ()
   1774   "Mixed indicator showing keymap and targets.
   1775 The indicator shows the `embark-minimal-indicator' by default.
   1776 After `embark-mixed-indicator-delay' seconds, the
   1777 `embark-verbose-indicator' is shown.  This which-key-like approach
   1778 ensures that Embark stays out of the way for quick actions.  The
   1779 helpful keybinding reminder still pops up automatically without
   1780 further user intervention."
   1781   (let ((vindicator (embark-verbose-indicator))
   1782         (mindicator (embark-minimal-indicator))
   1783         vindicator-active
   1784         vtimer)
   1785     (lambda (&optional keymap targets prefix)
   1786       ;; Always cancel the timer.
   1787       ;; 1. When updating, cancel timer, since the user has pressed
   1788       ;;    a key before the timer elapsed.
   1789       ;; 2. For cleanup, the timer must also be canceled.
   1790       (when vtimer
   1791         (cancel-timer vtimer)
   1792         (setq vtimer nil))
   1793       (if (not keymap)
   1794           (progn
   1795             (funcall vindicator)
   1796             (when mindicator
   1797               (funcall mindicator)))
   1798         (when mindicator
   1799           (funcall mindicator keymap targets prefix))
   1800         (if vindicator-active
   1801             (funcall vindicator keymap targets prefix)
   1802           (setq vtimer
   1803                 (run-at-time
   1804                  embark-mixed-indicator-delay nil
   1805                  (lambda ()
   1806                    (when (and (not embark-mixed-indicator-both) mindicator)
   1807                      (funcall mindicator)
   1808                      (setq mindicator nil))
   1809                    (setq vindicator-active t)
   1810                    (funcall vindicator keymap targets prefix)))))))))
   1811 
   1812 ;;;###autoload
   1813 (defun embark-bindings-in-keymap (keymap)
   1814   "Explore command key bindings in KEYMAP with `completing-read'.
   1815 The selected command will be executed.  Interactively, prompt the
   1816 user for a KEYMAP variable."
   1817   (interactive
   1818    (list
   1819     (symbol-value
   1820      (intern-soft
   1821       (completing-read
   1822        "Keymap: "
   1823        (embark--with-category
   1824         'variable
   1825         (cl-loop for x being the symbols
   1826                  if (and (boundp x) (keymapp (symbol-value x)))
   1827                  collect (symbol-name x)))
   1828        nil t nil 'variable-name-history
   1829        (let ((major-mode-map
   1830               (concat (symbol-name major-mode) "-map")))
   1831          (when (intern-soft major-mode-map) major-mode-map)))))))
   1832   (when-let (command (embark-completing-read-prompter keymap nil 'no-default))
   1833     (call-interactively command)))
   1834 
   1835 ;;;###autoload
   1836 (defun embark-bindings (global)
   1837   "Explore current command key bindings with `completing-read'.
   1838 The selected command will be executed.
   1839 
   1840 This shows key bindings from minor mode maps and the local
   1841 map (usually set by the major mode), but also less common keymaps
   1842 such as those from a text property or overlay, or the overriding
   1843 maps: `overriding-terminal-local-map' and `overriding-local-map'.
   1844 
   1845 Additionally, if GLOBAL is non-nil (interactively, if called with
   1846 a prefix argument), this command includes global key bindings."
   1847   (interactive "P")
   1848   (embark-bindings-in-keymap
   1849    (make-composed-keymap
   1850     (let ((all-maps (current-active-maps t)))
   1851       (if global all-maps (remq global-map all-maps))))))
   1852 
   1853 ;;;###autoload
   1854 (defun embark-bindings-at-point ()
   1855   "Explore all key bindings at point with `completing-read'.
   1856 The selected command will be executed.
   1857 
   1858 This command lists key bindings found in keymaps specified by the
   1859 text properties `keymap' or `local-map', from either buffer text
   1860 or an overlay.  These are not widely used in Emacs, and when they
   1861 are used can be somewhat hard to discover.  Examples of locations
   1862 that have such a keymap are links and images in `eww' buffers,
   1863 attachment links in `gnus' article buffers, and the stash line
   1864 in a `vc-dir' buffer."
   1865   (interactive)
   1866   (if-let ((keymaps (delq nil (list (get-char-property (point) 'keymap)
   1867                                     (get-char-property (point) 'local-map)))))
   1868       (embark-bindings-in-keymap (make-composed-keymap keymaps))
   1869     (user-error "No key bindings found at point")))
   1870 
   1871 ;;;###autoload
   1872 (defun embark-prefix-help-command ()
   1873   "Prompt for and run a command bound in the prefix used for this command.
   1874 The prefix described consists of all but the last event of the
   1875 key sequence that ran this command.  This function is intended to
   1876 be used as a value for `prefix-help-command'.
   1877 
   1878 In addition to using completion to select a command, you can also
   1879 type @ and the key binding (without the prefix)."
   1880   (interactive)
   1881   (when-let ((keys (this-command-keys-vector))
   1882              (prefix (seq-take keys (1- (length keys))))
   1883              (keymap (key-binding prefix 'accept-default)))
   1884     (minibuffer-with-setup-hook
   1885         (lambda ()
   1886           (let ((pt (- (minibuffer-prompt-end) 2)))
   1887             (overlay-put (make-overlay pt pt) 'before-string
   1888                          (format " under %s" (key-description prefix)))))
   1889       (embark-bindings-in-keymap keymap))))
   1890 
   1891 (defun embark--prompt (indicators keymap targets)
   1892   "Call the prompter with KEYMAP and INDICATORS.
   1893 The TARGETS are displayed for actions outside the minibuffer."
   1894   (mapc (lambda (i) (funcall i keymap targets)) indicators)
   1895   (condition-case nil
   1896       (minibuffer-with-setup-hook
   1897           (lambda ()
   1898             ;; if the prompter opens its own minibuffer, show
   1899             ;; the indicator there too
   1900             (let ((inner-indicators (mapcar #'funcall embark-indicators)))
   1901               (mapc (lambda (i) (funcall i keymap targets)) inner-indicators)
   1902               (add-hook 'minibuffer-exit-hook
   1903                         (lambda () (mapc #'funcall inner-indicators))
   1904                         nil t)))
   1905         (let ((enable-recursive-minibuffers t))
   1906           (funcall embark-prompter keymap
   1907                    (lambda (prefix)
   1908                      (mapc (lambda (i) (funcall i keymap targets prefix))
   1909                            indicators)))))
   1910     (quit nil)))
   1911 
   1912 (defvar embark--run-after-command-functions nil
   1913   "Abnormal hook, used by `embark--run-after-command'.")
   1914 
   1915 (defun embark--run-after-command (fn &rest args)
   1916   "Call FN with ARGS after the current commands finishes.
   1917 If multiple functions are queued with this function during the
   1918 same command, they will be called in the order from the one
   1919 queued most recently to the one queued least recently."
   1920   ;; We don't simply add FN to `post-command-hook' because FN may recursively
   1921   ;; call this function.  In that case, FN would modify `post-command-hook'
   1922   ;; from within post-command-hook, which doesn't behave properly in our case.
   1923   ;; We use our own abnormal hook and run it from PCH in a way that it is OK to
   1924   ;; modify it from within its own functions.
   1925   (unless embark--run-after-command-functions
   1926     (let (pch timer has-run)
   1927       (setq pch
   1928             (lambda ()
   1929               (remove-hook 'post-command-hook pch)
   1930               (cancel-timer timer)
   1931               (unless has-run
   1932                 (setq has-run t)
   1933                 (while embark--run-after-command-functions
   1934                   ;; The following funcall may recursively call
   1935                   ;; `embark--run-after-command', modifying
   1936                   ;; `embark--run-after-command-functions'.  This is why this
   1937                   ;; loop has to be implemented carefully.  We have to pop the
   1938                   ;; function off the hook before calling it.  Using `dolist'
   1939                   ;; on the hook would also be incorrect, because it wouldn't
   1940                   ;; take modifications of this hook into account.
   1941                   (with-demoted-errors "embark PCH: %S"
   1942                     (condition-case nil
   1943                         (funcall (pop embark--run-after-command-functions))
   1944                       (quit (message "Quit"))))))))
   1945       (add-hook 'post-command-hook pch 'append)
   1946       ;; Generally we prefer `post-command-hook' because it plays well with
   1947       ;; keyboard macros.  In some cases, `post-command-hook' isn't run after
   1948       ;; exiting a recursive edit, so set up the following timer as a backup.
   1949       (setq timer (run-at-time 0 nil pch))))
   1950 
   1951   ;; Keep the default-directory alive, since this is often overwritten,
   1952   ;; for example by Consult commands.
   1953   ;; TODO it might be necessary to add more dynamically bound variables
   1954   ;; here. What we actually want are functions `capture-dynamic-scope'
   1955   ;; and `eval-in-dynamic-scope', but this does not exist?
   1956   (let ((dir default-directory))
   1957     (push (lambda ()
   1958             (let ((default-directory dir))
   1959               (apply fn args)))
   1960           embark--run-after-command-functions)))
   1961 
   1962 (defun embark--quit-and-run (fn &rest args)
   1963   "Quit the minibuffer and then call FN with ARGS.
   1964 If called outside the minibuffer, simply apply FN to ARGS."
   1965   (if (not (minibufferp))
   1966       (apply fn args)
   1967     (apply #'embark--run-after-command fn args)
   1968     (embark--run-after-command #'set 'ring-bell-function ring-bell-function)
   1969     (setq ring-bell-function #'ignore)
   1970     (if (fboundp 'minibuffer-quit-recursive-edit)
   1971         (minibuffer-quit-recursive-edit)
   1972       (abort-recursive-edit))))
   1973 
   1974 (defun embark--run-action-hooks (hooks action target quit)
   1975   "Run HOOKS for ACTION.
   1976 The HOOKS argument must be alist.  The keys t and :always are
   1977 treated specially.  The :always hooks are executed always and the
   1978 t hooks are the default hooks, for when there are no
   1979 command-specific hooks for ACTION.  The QUIT, ACTION and TARGET
   1980 arguments are passed to the hooks as keyword arguments."
   1981   (mapc (lambda (h) (apply h :action action :quit quit target))
   1982         (or (alist-get action hooks)
   1983             (alist-get t hooks)))
   1984   (mapc (lambda (h) (apply h :action action :quit quit target))
   1985         (alist-get :always hooks)))
   1986 
   1987 (defun embark--run-around-action-hooks
   1988     (action target quit &optional non-interactive)
   1989   "Run the `embark-around-action-hooks' for ACTION.
   1990 All the applicable around hooks are composed in the order they
   1991 are present in `embark-around-action-hooks'.  The keys t and
   1992 :always in `embark-around-action-hooks' are treated specially.
   1993 The :always hooks are executed always (outermost) and the t hooks
   1994 are the default hooks, for when there are no command-specific
   1995 hooks for ACTION.  The QUIT, ACTION and TARGET arguments are
   1996 passed to the hooks as keyword arguments.
   1997 
   1998 The optional argument NON-INTERACTIVE controls whether the action
   1999 is run with `command-execute' or with `funcall' passing the
   2000 target as argument."
   2001   (apply
   2002    (seq-reduce
   2003     (lambda (fn hook)
   2004       (lambda (&rest args) (apply hook (plist-put args :run fn))))
   2005     (let ((hooks embark-around-action-hooks))
   2006       (reverse
   2007        (append (or (alist-get action hooks) (alist-get t hooks))
   2008                (alist-get :always hooks))))
   2009     (if non-interactive
   2010         (lambda (&rest args)
   2011           (funcall (plist-get args :action)
   2012                    (or (plist-get args :candidates) (plist-get args :target))))
   2013       (lambda (&rest args)
   2014         (command-execute (plist-get args :action)))))
   2015    :action action :quit quit target))
   2016 
   2017 (defun embark--act (action target &optional quit)
   2018   "Perform ACTION injecting the TARGET.
   2019 If called from a minibuffer with non-nil QUIT, quit the
   2020 minibuffer before executing the action."
   2021   (if (memq action '(embark-become       ; these actions should run in
   2022                      embark-collect      ; the current buffer, not the
   2023                      embark-live         ; target buffer
   2024                      embark-export
   2025                      embark-select
   2026                      embark-act-all))
   2027       (progn
   2028         (embark--run-action-hooks embark-pre-action-hooks action target quit)
   2029         (unwind-protect (embark--run-around-action-hooks action target quit)
   2030           (embark--run-action-hooks embark-post-action-hooks
   2031                                     action target quit)))
   2032     (let* ((command embark--command)
   2033            (prefix prefix-arg)
   2034            (action-window (embark--target-window t))
   2035            (directory default-directory)
   2036            (inject
   2037             (lambda ()
   2038               (let ((contents (minibuffer-contents)))
   2039                 (delete-minibuffer-contents)
   2040                 (insert
   2041                  (propertize
   2042                   (substring-no-properties (plist-get target :target))
   2043                   'embark--initial-input contents)))
   2044               (if (memq 'ivy--queue-exhibit post-command-hook)
   2045                   ;; Ivy has special needs: (1) for file names
   2046                   ;; ivy-immediate-done is not equivalent to
   2047                   ;; exit-minibuffer, (2) it needs a chance to run
   2048                   ;; its post command hook first, so use depth 10
   2049                   (add-hook 'post-command-hook 'ivy-immediate-done 10 t)
   2050                 (add-hook 'post-command-hook #'exit-minibuffer nil t))
   2051               (embark--run-action-hooks embark-target-injection-hooks
   2052                                         action target quit)))
   2053            (dedicate (and (derived-mode-p 'embark-collect-mode)
   2054                           (not (window-dedicated-p))
   2055                           (selected-window)))
   2056            (multi (memq action embark-multitarget-actions))
   2057            (run-action
   2058             (if (and (commandp action) (not multi))
   2059                 (lambda ()
   2060                   (let (final-window)
   2061                     (when dedicate (set-window-dedicated-p dedicate t))
   2062                     (unwind-protect
   2063                         (with-selected-window action-window
   2064                           (let ((enable-recursive-minibuffers t)
   2065                                 (embark--command command)
   2066                                 (prefix-arg prefix)
   2067                                 ;; the next two avoid mouse dialogs
   2068                                 (use-dialog-box nil)
   2069                                 (last-nonmenu-event 13)
   2070                                 (default-directory directory))
   2071                             (embark--run-action-hooks embark-pre-action-hooks
   2072                                                       action target quit)
   2073                             (minibuffer-with-setup-hook inject
   2074                               ;; pacify commands that use (this-command-keys)
   2075                               (when (= (length (this-command-keys)) 0)
   2076                                 (set--this-command-keys
   2077                                  (if (characterp last-command-event)
   2078                                      (string last-command-event)
   2079                                   "\r")))
   2080                               (setq this-command action)
   2081                               (embark--run-around-action-hooks
   2082                                action target quit)))
   2083                           (setq final-window (selected-window)))
   2084                       (embark--run-action-hooks embark-post-action-hooks
   2085                                                 action target quit)
   2086                       (when dedicate (set-window-dedicated-p dedicate nil)))
   2087                     (unless (eq final-window action-window)
   2088                       (select-window final-window))))
   2089               (let ((target
   2090                      (if (and multi (null (plist-get target :candidates)))
   2091                          (plist-put
   2092                           target :candidates (list (plist-get target :target)))
   2093                        target)))
   2094                 (lambda ()
   2095                   (with-selected-window action-window
   2096                     (embark--run-action-hooks embark-pre-action-hooks
   2097                                               action target quit)
   2098                     (unwind-protect
   2099                         (let ((current-prefix-arg prefix)
   2100                               (default-directory directory))
   2101                           (embark--run-around-action-hooks
   2102                            action target quit :non-interactive))
   2103                       (embark--run-action-hooks embark-post-action-hooks
   2104                                                 action target quit))))))))
   2105       (setq prefix-arg nil)
   2106       (if quit (embark--quit-and-run run-action) (funcall run-action)))))
   2107 
   2108 (defun embark--refine-multi-category (_type target)
   2109   "Refine `multi-category' TARGET to its actual type."
   2110   (or (let ((mc (get-text-property 0 'multi-category target)))
   2111         (cond
   2112          ;; The `cdr' of the `multi-category' property can be a buffer object.
   2113          ((and (eq (car mc) 'buffer) (buffer-live-p (cdr mc)))
   2114           (cons 'buffer (buffer-name (cdr mc))))
   2115          ((stringp (cdr mc)) mc)))
   2116       (cons 'general target)))
   2117 
   2118 (defun embark--simplify-path (_type target)
   2119   "Simplify and '//' or '~/' in the TARGET file path."
   2120   (cons 'file (substitute-in-file-name target)))
   2121 
   2122 (defun embark--keybinding-command (_type target)
   2123   "Treat an `embark-keybinding' TARGET as a command."
   2124   (when-let ((cmd (get-text-property 0 'embark-command target)))
   2125     (cons 'command (format "%s" cmd))))
   2126 
   2127 (defun embark--lookup-lighter-minor-mode (_type target)
   2128   "If TARGET is a lighter, look up its minor mode.
   2129 
   2130 The `describe-minor-mode' command has as completion candidates
   2131 both minor-modes and their lighters.  This function replaces the
   2132 lighters by their minor modes, so actions expecting a function
   2133 work on them."
   2134   (cons 'minor-mode
   2135         (let ((symbol (intern-soft target)))
   2136           (if (and symbol (boundp symbol))
   2137               target
   2138             (symbol-name (lookup-minor-mode-from-indicator target))))))
   2139 
   2140 (declare-function project-current "project")
   2141 (declare-function project-roots "project")
   2142 (declare-function project-root "project")
   2143 
   2144 (defun embark--project-file-full-path (_type target)
   2145   "Get full path of project file TARGET."
   2146   ;; TODO project-find-file can be called from outside all projects in
   2147   ;; which case it prompts for a project first; we don't support that
   2148   ;; case yet, since there is no current project.
   2149   (cons 'file
   2150         (if-let ((project (project-current))
   2151                  (root (if (fboundp 'project-root)
   2152                            (project-root project)
   2153                          (with-no-warnings
   2154                            (car (project-roots project))))))
   2155             (expand-file-name target root)
   2156           target)))
   2157 
   2158 (defun embark--remove-package-version (_type target)
   2159   "Remove version number from a versioned package TARGET."
   2160   (cons 'package (replace-regexp-in-string "-[0-9.]+$" "" target)))
   2161 
   2162 (defun embark--targets ()
   2163   "Retrieve current targets.
   2164 
   2165 An initial guess at the current targets and their types is
   2166 determined by running the functions in `embark-target-finders'.
   2167 Each function should either return nil, a pair of a type symbol
   2168 and target string or a triple of a type symbol, target string and
   2169 target bounds.
   2170 
   2171 In the minibuffer only the first target finder returning non-nil
   2172 is taken into account.  When finding targets at point in other
   2173 buffers, all target finder functions are executed.
   2174 
   2175 For each target, the type is then looked up as a key in the
   2176 variable `embark-transformer-alist'.  If there is a transformer
   2177 for the type, it is called with the type and target, and must
   2178 return a `cons' of the transformed type and transformed target.
   2179 
   2180 The return value of `embark--targets' is a list of plists.  Each
   2181 plist concerns one target, and has keys `:type', `:target',
   2182 `:orig-type', `:orig-target' and `:bounds'."
   2183   (let (targets)
   2184     (run-hook-wrapped
   2185      'embark-target-finders
   2186      (lambda (fun)
   2187        (dolist (found (when-let (result (funcall fun))
   2188                         (if (consp (car result)) result (list result))))
   2189          (let* ((type (or (car found) 'general))
   2190                 (target+bounds (cdr found))
   2191                 (target (if (consp target+bounds)
   2192                             (car target+bounds)
   2193                           target+bounds))
   2194                 (bounds (and (consp target+bounds) (cdr target+bounds)))
   2195                 (full-target
   2196                  (append
   2197                   (list :orig-type type :orig-target target :bounds bounds)
   2198                   (if-let (transform (alist-get type embark-transformer-alist))
   2199                       (let ((trans (funcall transform type target)))
   2200                         (list :type (car trans) :target (cdr trans)))
   2201                     (list :type type :target target)))))
   2202            (push full-target targets)))
   2203        (and targets (minibufferp))))
   2204     (nreverse
   2205      (cl-delete-duplicates ; keeps last duplicate, but we reverse
   2206       targets
   2207       :test (lambda (t1 t2)
   2208               (and (equal (plist-get t1 :target) (plist-get t2 :target))
   2209                    (eq (plist-get t1 :type) (plist-get t2 :type))))))))
   2210 
   2211 (defun embark--default-action (type)
   2212   "Return default action for the given TYPE of target.
   2213 The most common case is that the target comes from minibuffer
   2214 completion, in which case the default action is the command that
   2215 opened the minibuffer in the first place.  This can be overridden
   2216 by `embark-default-action-overrides'.
   2217 
   2218 For targets that do not come from minibuffer completion
   2219 \(typically some thing at point in a regular buffer) and whose
   2220 type is not listed in `embark-default-action-overrides', the
   2221 default action is given by whatever binding RET has in the action
   2222 keymap for the given type."
   2223   (or (alist-get (cons type embark--command) embark-default-action-overrides
   2224                  nil nil #'equal)
   2225       (alist-get type embark-default-action-overrides)
   2226       (alist-get t embark-default-action-overrides)
   2227       embark--command
   2228       (lookup-key (embark--raw-action-keymap type) "\r")))
   2229 
   2230 (defun embark--rotate (list k)
   2231   "Rotate LIST by K elements and return the rotated list."
   2232   (setq k (mod k (length list)))
   2233   (append (seq-drop list k) (seq-take list k)))
   2234 
   2235 (defun embark--orig-target (target)
   2236   "Convert TARGET to original target."
   2237   (plist-put
   2238    (plist-put
   2239     (copy-sequence target)
   2240     :target (plist-get target :orig-target))
   2241    :type (plist-get target :orig-type)))
   2242 
   2243 (defun embark--quit-p (action)
   2244   "Determine whether to quit the minibuffer after ACTION.
   2245 This function consults `embark-quit-after-action' to decide
   2246 whether or not the user wishes to quit the minibuffer after
   2247 performing the ACTION, assuming this is done from a minibuffer."
   2248   (let* ((cfg embark-quit-after-action)
   2249          (quit (if (consp cfg) (alist-get action cfg (alist-get t cfg)) cfg)))
   2250     (when embark--toggle-quit (setq quit (not quit)))
   2251     (setq embark--toggle-quit nil)
   2252     quit))
   2253 
   2254 ;;;###autoload
   2255 (defun embark-act (&optional arg)
   2256   "Prompt the user for an action and perform it.
   2257 The targets of the action are chosen by `embark-target-finders'.
   2258 By default, if called from a minibuffer the target is the top
   2259 completion candidate.  When called from a non-minibuffer buffer
   2260 there can multiple targets and you can cycle among them by using
   2261 `embark-cycle' (which is bound by default to the same key
   2262 binding `embark-act' is, but see `embark-cycle-key').
   2263 
   2264 This command uses `embark-prompter' to ask the user to specify an
   2265 action, and calls it injecting the target at the first minibuffer
   2266 prompt.
   2267 
   2268 If you call this from the minibuffer, it can optionally quit the
   2269 minibuffer.  The variable `embark-quit-after-action' controls
   2270 whether calling `embark-act' with nil ARG quits the minibuffer,
   2271 and if ARG is non-nil it will do the opposite.  Interactively,
   2272 ARG is the prefix argument.
   2273 
   2274 If instead you call this from outside the minibuffer, the first
   2275 ARG targets are skipped over (if ARG is negative the skipping is
   2276 done by cycling backwards) and cycling starts from the following
   2277 target."
   2278   (interactive "P")
   2279   (let* ((targets (or (embark--targets) (user-error "No target found")))
   2280          (indicators (mapcar #'funcall embark-indicators))
   2281          (default-done nil))
   2282     (when arg
   2283       (if (minibufferp)
   2284           (embark-toggle-quit)
   2285         (setq targets (embark--rotate targets (prefix-numeric-value arg)))))
   2286     (unwind-protect
   2287         (while
   2288             (let* ((target (car targets))
   2289                    (action
   2290                     (or (embark--prompt
   2291                          indicators
   2292                          (let ((embark-default-action-overrides
   2293                                 (if default-done
   2294                                     `((t . ,default-done))
   2295                                   embark-default-action-overrides)))
   2296                            (embark--action-keymap (plist-get target :type)
   2297                                                   (cdr targets)))
   2298                          targets)
   2299                         (user-error "Canceled")))
   2300                    (default-action (or default-done
   2301                                        (embark--default-action
   2302                                         (plist-get target :type)))))
   2303               (cond
   2304                ;; When acting twice in the minibuffer, do not restart
   2305                ;; `embark-act'.  Otherwise the next `embark-act' will
   2306                ;; find a target in the original buffer.
   2307                ((eq action #'embark-act)
   2308                 (message "Press an action key"))
   2309                ((eq action #'embark-cycle)
   2310                 (setq targets (embark--rotate
   2311                                targets (prefix-numeric-value prefix-arg))))
   2312                (t
   2313                 ;; if the action is non-repeatable, cleanup indicator now
   2314                 (let ((repeat (embark--action-repeatable-p action)))
   2315                   (unless repeat (mapc #'funcall indicators))
   2316                   (condition-case err
   2317                       (embark--act
   2318                        action
   2319                        (if (and (eq action default-action)
   2320                                 (eq action embark--command)
   2321                                 (not (memq action embark-multitarget-actions)))
   2322                            (embark--orig-target target)
   2323                          target)
   2324                        (embark--quit-p action))
   2325                     (user-error
   2326                      (funcall (if repeat #'message #'user-error)
   2327                               "%s" (cadr err))))
   2328                   (when-let (new-targets (and repeat (embark--targets)))
   2329                     ;; Terminate repeated prompter on default action,
   2330                     ;; when repeating. Jump to the region type if the
   2331                     ;; region is active after the action, or else to the
   2332                     ;; current type again.
   2333                     (setq default-done #'embark-done
   2334                           targets
   2335                           (embark--rotate
   2336                            new-targets
   2337                            (or (cl-position-if
   2338                                 (let ((desired-type
   2339                                        (if (eq repeat t)
   2340                                            (plist-get (car targets) :type)
   2341                                          repeat)))
   2342                                   (lambda (x)
   2343                                     (eq (plist-get x :type) desired-type)))
   2344                                 new-targets)
   2345                                0)))))))))
   2346       (mapc #'funcall indicators))))
   2347 
   2348 (defun embark--maybe-transform-candidates ()
   2349   "Collect candidates and see if they all transform to the same type.
   2350 Return a plist with keys `:type', `:orig-type', `:candidates', and
   2351 `:orig-candidates'."
   2352   (pcase-let* ((`(,type . ,candidates)
   2353                 (run-hook-with-args-until-success 'embark-candidate-collectors))
   2354                (bounds (mapcar #'cdr-safe candidates)))
   2355     (setq candidates
   2356           (mapcar (lambda (x) (if (consp x) (car x) x)) candidates))
   2357     (when (eq type 'file)
   2358       (let ((dir (embark--default-directory)))
   2359         (setq candidates
   2360               (mapcar (lambda (cand)
   2361                         (abbreviate-file-name
   2362                          (expand-file-name (substitute-in-file-name cand) dir)))
   2363                       candidates))))
   2364     ;; TODO more systematic approach to applying substitute-in-file-name
   2365     (append
   2366      (list :orig-type type :orig-candidates candidates :bounds bounds)
   2367      (or (when candidates
   2368            (when-let ((transformer (alist-get type embark-transformer-alist)))
   2369              (pcase-let* ((`(,new-type . ,first-cand)
   2370                            (funcall transformer type (car candidates))))
   2371                (let ((new-candidates (list first-cand)))
   2372                  (when (cl-every
   2373                         (lambda (cand)
   2374                           (pcase-let ((`(,t-type . ,t-cand)
   2375                                        (funcall transformer type cand)))
   2376                             (when (eq t-type new-type)
   2377                               (push t-cand new-candidates)
   2378                               t)))
   2379                         (cdr candidates))
   2380                    (list :type new-type
   2381                          :candidates (nreverse new-candidates)))))))
   2382          (list :type type :candidates candidates)))))
   2383 
   2384 ;;;###autoload
   2385 (defun embark-act-all (&optional arg)
   2386   "Prompt the user for an action and perform it on each candidate.
   2387 The candidates are chosen by `embark-candidate-collectors'.  By
   2388 default, if `embark-select' has been used to select some
   2389 candidates, then `embark-act-all' will act on those candidates;
   2390 otherwise, if the selection is empty and `embark-act-all' is
   2391 called from a minibuffer, then the candidates are the completion
   2392 candidates.
   2393 
   2394 This command uses `embark-prompter' to ask the user to specify an
   2395 action, and calls it injecting the target at the first minibuffer
   2396 prompt.
   2397 
   2398 If you call this from the minibuffer, it can optionally quit the
   2399 minibuffer.  The variable `embark-quit-after-action' controls
   2400 whether calling `embark-act' with nil ARG quits the minibuffer,
   2401 and if ARG is non-nil it will do the opposite.  Interactively,
   2402 ARG is the prefix argument."
   2403   (interactive "P")
   2404   (let* ((transformed (embark--maybe-transform-candidates))
   2405          (type (plist-get transformed :type))
   2406          (orig-type (plist-get transformed :orig-type))
   2407          (candidates
   2408           (or (cl-mapcar
   2409                (lambda (cand orig-cand bounds)
   2410                  (list :type type :target cand
   2411                        :bounds (when bounds
   2412                                  (cons (copy-marker (car bounds))
   2413                                        (copy-marker (cdr bounds))))
   2414                        :orig-type orig-type :orig-target orig-cand))
   2415                (plist-get transformed :candidates)
   2416                (plist-get transformed :orig-candidates)
   2417                (plist-get transformed :bounds))
   2418               (user-error "No candidates to act on")))
   2419          (indicators (mapcar #'funcall embark-indicators)))
   2420     (when arg (embark-toggle-quit))
   2421     (unwind-protect
   2422         (let* ((action
   2423                 (or (embark--prompt
   2424                      indicators (embark--action-keymap type nil)
   2425                      (list (list :type type :multi (length candidates))))
   2426                     (user-error "Canceled")))
   2427                (prefix prefix-arg)
   2428                (act (lambda (candidate)
   2429                       (cl-letf (((symbol-function 'embark--restart) #'ignore)
   2430                                 ((symbol-function 'embark--confirm) #'ignore))
   2431                         (let ((prefix-arg prefix))
   2432                           (when-let ((bounds (plist-get candidate :bounds)))
   2433                             (goto-char (car bounds)))
   2434                           (embark--act action candidate)))))
   2435                (quit (embark--quit-p action)))
   2436           (when (and (eq action (embark--default-action type))
   2437                      (eq action embark--command))
   2438             (setq candidates (mapcar #'embark--orig-target candidates)))
   2439           (when (or (not (or embark-confirm-act-all
   2440                              (memq 'embark--confirm
   2441                                    (alist-get action embark-pre-action-hooks))))
   2442                     (y-or-n-p (format "Run %s on %d %ss? "
   2443                                       action (length candidates) type)))
   2444             (if (memq action embark-multitarget-actions)
   2445                 (let ((prefix-arg prefix))
   2446                   (embark--act action transformed quit))
   2447               (save-excursion
   2448                 (if quit
   2449                     (embark--quit-and-run #'mapc act candidates)
   2450                   (mapc act candidates))))
   2451             (when (and (not quit)
   2452                        (memq 'embark--restart
   2453                              (alist-get action embark-post-action-hooks)))
   2454               (embark--restart))))
   2455       (dolist (cand candidates)
   2456         (when-let ((bounds (plist-get cand :bounds)))
   2457           (set-marker (car bounds) nil) ; yay, manual memory management!
   2458           (set-marker (cdr bounds) nil)))
   2459       (setq prefix-arg nil)
   2460       (mapc #'funcall indicators))))
   2461 
   2462 (defun embark-highlight-indicator ()
   2463   "Action indicator highlighting the target at point."
   2464   (let (overlay)
   2465     (lambda (&optional keymap targets _prefix)
   2466       (let ((bounds (plist-get (car targets) :bounds)))
   2467         (when (and overlay (or (not keymap) (not bounds)))
   2468           (delete-overlay overlay)
   2469           (setq overlay nil))
   2470         (when bounds
   2471           (if overlay
   2472               (move-overlay overlay (car bounds) (cdr bounds))
   2473             (setq overlay (make-overlay (car bounds) (cdr bounds)))
   2474             (overlay-put overlay 'category 'embark-target-overlay))
   2475           (overlay-put overlay 'window (selected-window)))))))
   2476 
   2477 (defun embark-isearch-highlight-indicator ()
   2478   "Action indicator highlighting all occurrences of the identifier at point.
   2479 This indicator only does something for targets which are
   2480 identifiers or symbols.  For those it uses `isearch''s lazy
   2481 highlighting feature to highlight all occurrences of the target in
   2482 the buffer.  This indicator is best used in conjunction with
   2483 `embark-highlight-indicator': by using them both you get the
   2484 target and the other occurrences of it highlighted in different
   2485 colors."
   2486   (lambda (&optional _keymap targets _prefix)
   2487     (if (and (not (minibufferp))
   2488              (memq (plist-get (car targets) :orig-type) '(symbol identifier)))
   2489         (let ((isearch-string (plist-get (car targets) :target))
   2490               (isearch-regexp-function #'isearch-symbol-regexp))
   2491           (isearch-lazy-highlight-new-loop))
   2492       (setq isearch-lazy-highlight-last-string nil)
   2493       (lazy-highlight-cleanup t))))
   2494 
   2495 (defun embark-cycle (_arg)
   2496   "Cycle over the next ARG targets at point.
   2497 If ARG is negative, cycle backwards."
   2498   (interactive "p")
   2499   (user-error "Not meant to be called directly"))
   2500 
   2501 (defun embark-done ()
   2502   "Terminate sequence of repeated actions."
   2503   (interactive))
   2504 
   2505 ;;;###autoload
   2506 (defun embark-dwim (&optional arg)
   2507   "Run the default action on the current target.
   2508 The target of the action is chosen by `embark-target-finders'.
   2509 
   2510 If the target comes from minibuffer completion, then the default
   2511 action is the command that opened the minibuffer in the first
   2512 place, unless overridden by `embark-default-action-overrides'.
   2513 
   2514 For targets that do not come from minibuffer completion
   2515 \(typically some thing at point in a regular buffer) and whose
   2516 type is not listed in `embark-default-action-overrides', the
   2517 default action is given by whatever binding RET has in the action
   2518 keymap for the target's type.
   2519 
   2520 See `embark-act' for the meaning of the prefix ARG."
   2521   (interactive "P")
   2522   (if-let ((targets (embark--targets)))
   2523       (let* ((target
   2524               (or (nth
   2525                    (if (or (null arg) (minibufferp))
   2526                        0
   2527                      (mod (prefix-numeric-value arg) (length targets)))
   2528                    targets)))
   2529              (type (plist-get target :type))
   2530              (default-action (embark--default-action type))
   2531              (action (or (command-remapping default-action) default-action)))
   2532         (unless action
   2533           (user-error "No default action for %s targets" type))
   2534         (when (and arg (minibufferp)) (setq embark--toggle-quit t))
   2535         (embark--act action
   2536                      (if (and (eq default-action embark--command)
   2537                               (not (memq default-action
   2538                                          embark-multitarget-actions)))
   2539                          (embark--orig-target target)
   2540                        target)
   2541                      (embark--quit-p action)))
   2542     (user-error "No target found")))
   2543 
   2544 (defun embark--become-keymap ()
   2545   "Return keymap of commands to become for current command."
   2546   (let ((map (make-composed-keymap
   2547               (cl-loop for keymap-name in embark-become-keymaps
   2548                        for keymap = (symbol-value keymap-name)
   2549                        when (where-is-internal embark--command (list keymap))
   2550                        collect keymap))))
   2551     (when embark-help-key
   2552       (keymap-set map embark-help-key #'embark-keymap-help))
   2553     map))
   2554 
   2555 ;;;###autoload
   2556 (defun embark-become (&optional full)
   2557   "Make current command become a different command.
   2558 Take the current minibuffer input as initial input for new
   2559 command.  The new command can be run normally using key bindings or
   2560 \\[execute-extended-command], but if the current command is found in a keymap in
   2561 `embark-become-keymaps', that keymap is activated to provide
   2562 convenient access to the other commands in it.
   2563 
   2564 If FULL is non-nil (interactively, if called with a prefix
   2565 argument), the entire minibuffer contents are used as the initial
   2566 input of the new command.  By default only the part of the
   2567 minibuffer contents between the current completion boundaries is
   2568 taken.  What this means is fairly technical, but (1) usually
   2569 there is no difference: the completion boundaries include the
   2570 entire minibuffer contents, and (2) the most common case where
   2571 these notions differ is file completion, in which case the
   2572 completion boundaries single out the path component containing
   2573 point."
   2574   (interactive "P")
   2575   (unless (minibufferp)
   2576     (user-error "Not in a minibuffer"))
   2577   (let* ((target (embark--display-string ; remove invisible portions
   2578                   (if full
   2579                       (minibuffer-contents)
   2580                     (pcase-let ((`(,beg . ,end) (embark--boundaries)))
   2581                       (substring (minibuffer-contents) beg
   2582                                  (+ end (embark--minibuffer-point)))))))
   2583          (keymap (embark--become-keymap))
   2584          (targets `((:type embark-become :target ,target)))
   2585          (indicators (mapcar #'funcall embark-indicators))
   2586          (become (unwind-protect
   2587                      (embark--prompt indicators keymap targets)
   2588                    (mapc #'funcall indicators))))
   2589     (unless become
   2590       (user-error "Canceled"))
   2591     (embark--become-command become target)))
   2592 
   2593 (defun embark--become-command (command input)
   2594   "Quit current minibuffer and start COMMAND with INPUT."
   2595   (embark--quit-and-run
   2596    (lambda ()
   2597      (minibuffer-with-setup-hook
   2598          (lambda ()
   2599            (delete-minibuffer-contents)
   2600            (insert input))
   2601        (let ((use-dialog-box nil) ;; avoid mouse dialogs
   2602              (last-nonmenu-event 13))
   2603          (setq this-command command)
   2604          (command-execute command))))))
   2605 
   2606 ;;; Embark collect
   2607 
   2608 (defgroup embark-collect nil
   2609   "Buffers for acting on collected Embark targets."
   2610   :group 'embark)
   2611 
   2612 (defcustom embark-candidate-collectors
   2613   '(embark-selected-candidates
   2614     embark-minibuffer-candidates
   2615     embark-completion-list-candidates
   2616     embark-dired-candidates
   2617     embark-ibuffer-candidates
   2618     embark-embark-collect-candidates
   2619     embark-custom-candidates)
   2620   "List of functions that collect all candidates in a given context.
   2621 These are used to fill an Embark Collect buffer.  Each function
   2622 should return either nil (to indicate it found no candidates) or
   2623 a list whose first element is a symbol indicating the type of
   2624 candidates and whose `cdr' is the list of candidates, each of
   2625 which should be either a string or a dotted list of the
   2626 form (TARGET START . END), where START and END are the buffer
   2627 positions bounding the TARGET string."
   2628   :type 'hook)
   2629 
   2630 (defcustom embark-exporters-alist
   2631   '((buffer . embark-export-ibuffer)
   2632     (file . embark-export-dired)
   2633     (package . embark-export-list-packages)
   2634     (bookmark . embark-export-bookmarks)
   2635     (variable . embark-export-customize-variable)
   2636     (face . embark-export-customize-face)
   2637     (symbol . embark-export-apropos)
   2638     (minor-mode . embark-export-apropos)
   2639     (function . embark-export-apropos)
   2640     (command . embark-export-apropos)
   2641     (t . embark-collect))
   2642   "Alist associating completion types to export functions.
   2643 Each function should take a list of strings which are candidates
   2644 for actions and make a buffer appropriate to manage them.  For
   2645 example, the default is to make a Dired buffer for files, and an
   2646 ibuffer for buffers.
   2647 
   2648 The key t is also allowed in the alist, and the corresponding
   2649 value indicates the default function to use for other types.  The
   2650 default is `embark-collect'"
   2651   :type '(alist :key-type symbol :value-type function))
   2652 
   2653 (defcustom embark-after-export-hook nil
   2654   "Hook run after `embark-export' in the newly created buffer."
   2655   :type 'hook)
   2656 
   2657 (defface embark-collect-candidate '((t :inherit default))
   2658   "Face for candidates in Embark Collect buffers.")
   2659 
   2660 (defface embark-collect-group-title
   2661   '((t :inherit shadow :slant italic))
   2662   "Face for group titles in Embark Collect buffers.")
   2663 
   2664 (defface embark-collect-group-separator
   2665   '((t :inherit shadow :strike-through t italic))
   2666   "Face for group titles in Embark Collect buffers.")
   2667 
   2668 (defcustom embark-collect-group-format
   2669   (concat
   2670    (propertize "    " 'face 'embark-collect-group-separator)
   2671    (propertize " %s " 'face 'embark-collect-group-title)
   2672    (propertize " " 'face 'completions-group-separator
   2673                'display '(space :align-to right)))
   2674   "Format string used for the group title in Embark Collect buffers."
   2675   :type 'string)
   2676 
   2677 (defface embark-collect-annotation '((t :inherit completions-annotations))
   2678   "Face for annotations in Embark Collect.
   2679 This is only used for annotation that are not already fontified.")
   2680 
   2681 (defvar-local embark--rerun-function nil
   2682   "Function to rerun the collect or export that made the current buffer.")
   2683 
   2684 (autoload 'package-delete "package")
   2685 (declare-function package--from-builtin "package")
   2686 (declare-function package-desc-extras "package")
   2687 (declare-function package-desc-name "package")
   2688 (defvar package--builtins)
   2689 (defvar package-alist)
   2690 (defvar package-archive-contents)
   2691 (defvar package--initialized)
   2692 
   2693 (defun embark--package-desc (pkg)
   2694   "Return the description structure for package PKG."
   2695   (or ; found this in `describe-package-1'
   2696    (car (alist-get pkg package-alist))
   2697    (if-let ((built-in (assq pkg package--builtins)))
   2698            (package--from-builtin built-in)
   2699            (car (alist-get pkg package-archive-contents)))))
   2700 
   2701 (defun embark-minibuffer-candidates ()
   2702   "Return all current completion candidates from the minibuffer."
   2703   (when (minibufferp)
   2704     (let* ((all (completion-all-completions
   2705                  (minibuffer-contents)
   2706                  minibuffer-completion-table
   2707                  minibuffer-completion-predicate
   2708                  (embark--minibuffer-point)))
   2709            (last (last all)))
   2710       (when last (setcdr last nil))
   2711       (cons
   2712        (completion-metadata-get (embark--metadata) 'category)
   2713        all))))
   2714 
   2715 (defun embark-sorted-minibuffer-candidates ()
   2716   "Return a sorted list of current minibuffer completion candidates.
   2717 This using the same sort order that `icomplete' and
   2718 `minibuffer-force-complete' use.  The intended usage is that you
   2719 replace `embark-minibuffer-candidates' with this function in the
   2720 list `embark-candidate-collectors'."
   2721   (when (minibufferp)
   2722     (cons
   2723      (completion-metadata-get (embark--metadata) 'category)
   2724      (nconc (cl-copy-list (completion-all-sorted-completions)) nil))))
   2725 
   2726 (declare-function dired-get-marked-files "dired")
   2727 (declare-function dired-move-to-filename "dired")
   2728 (declare-function dired-move-to-end-of-filename "dired")
   2729 
   2730 (defun embark-dired-candidates ()
   2731   "Return marked or all files shown in Dired buffer.
   2732 If any buffer is marked, return marked buffers; otherwise, return
   2733 all buffers."
   2734   (when (derived-mode-p 'dired-mode)
   2735     (cons 'file
   2736           (or
   2737            ;; dired-get-marked-files returns the file on the current
   2738            ;; line if no marked files are found; and when the fourth
   2739            ;; argument is non-nil, the "no marked files" case is
   2740            ;; distinguished from the "single marked file" case by
   2741            ;; returning (list t marked-file) in the latter
   2742            (let ((marked (dired-get-marked-files t nil nil t)))
   2743              (and (cdr marked)
   2744                   (if (eq (car marked) t) (cdr marked) marked)))
   2745            (save-excursion
   2746              (goto-char (point-min))
   2747              (let (files)
   2748                (while (not (eobp))
   2749                  (when-let (file (dired-get-filename t t))
   2750                    (push `(,file
   2751                            ,(progn (dired-move-to-filename) (point))
   2752                            . ,(progn (dired-move-to-end-of-filename t) (point)))
   2753                          files))
   2754                  (forward-line))
   2755                (nreverse files)))))))
   2756 
   2757 (autoload 'ibuffer-marked-buffer-names "ibuffer")
   2758 (declare-function ibuffer-map-lines-nomodify "ibuffer")
   2759 
   2760 (defun embark-ibuffer-candidates ()
   2761   "Return marked or all buffers listed in ibuffer buffer.
   2762 If any buffer is marked, return marked buffers; otherwise, return
   2763 all buffers."
   2764   (when (derived-mode-p 'ibuffer-mode)
   2765     (cons 'buffer
   2766           (or (ibuffer-marked-buffer-names)
   2767               (let (buffers)
   2768                 (ibuffer-map-lines-nomodify
   2769                  (lambda (buffer _mark)
   2770                    (push (buffer-name buffer) buffers)))
   2771                 (nreverse buffers))))))
   2772 
   2773 (defun embark-embark-collect-candidates ()
   2774   "Return candidates in Embark Collect buffer.
   2775 This makes `embark-export' work in Embark Collect buffers."
   2776   (when (derived-mode-p 'embark-collect-mode)
   2777     (cons embark--type
   2778           (save-excursion
   2779             (goto-char (point-min))
   2780             (let (all)
   2781               (when-let ((cand (embark-target-collect-candidate)))
   2782                 (push (cdr cand) all))
   2783               (while (forward-button 1 nil nil t)
   2784                 (when-let ((cand (embark-target-collect-candidate)))
   2785                   (push (cdr cand) all)))
   2786               (nreverse all))))))
   2787 
   2788 (defun embark-completion-list-candidates ()
   2789   "Return all candidates in a completions buffer."
   2790   (when (derived-mode-p 'completion-list-mode)
   2791     (cons
   2792      embark--type
   2793      (save-excursion
   2794        (goto-char (point-min))
   2795        (next-completion 1)
   2796        (let (all)
   2797          (while (not (eobp))
   2798            (push (cdr (embark-target-completion-list-candidate)) all)
   2799            (next-completion 1))
   2800          (nreverse all))))))
   2801 
   2802 (defun embark-custom-candidates ()
   2803   "Return all variables and faces listed in this `Custom-mode' buffer."
   2804   (when (derived-mode-p 'Custom-mode)
   2805     (cons 'symbol ; gets refined to variable or face when acted upon
   2806           (save-excursion
   2807             (goto-char (point-min))
   2808             (let (symbols)
   2809               (while (not (eobp))
   2810                 (when-let (widget (widget-at (point)))
   2811                   (when (eq (car widget) 'custom-visibility)
   2812                     (push
   2813                      `(,(symbol-name
   2814                          (plist-get (cdr (plist-get (cdr widget) :parent))
   2815                                     :value))
   2816                        ,(point)
   2817                        . ,(progn
   2818                             (re-search-forward ":" (line-end-position) 'noerror)
   2819                             (point)))
   2820                      symbols)))
   2821                 (forward-line))
   2822               (nreverse symbols))))))
   2823 
   2824 
   2825 (defun embark-collect--target ()
   2826   "Return the Embark Collect candidate at point.
   2827 This takes into account `embark-transformer-alist'."
   2828   (let ((embark-target-finders '(embark-target-collect-candidate)))
   2829     (car (embark--targets))))
   2830 
   2831 (defun embark--action-command (action)
   2832   "Turn an ACTION into a command to perform the action.
   2833 Returns the name of the command."
   2834   (let ((name (intern (format "embark-action--%s"
   2835                               (embark--command-name action)))))
   2836     (fset name (lambda (arg)
   2837                  (interactive "P")
   2838                  (when-let (target (embark-collect--target))
   2839                    (let ((prefix-arg arg))
   2840                      (embark--act action target)))))
   2841     (when (fboundp action)
   2842       (put name 'function-documentation (documentation action)))
   2843     name))
   2844 
   2845 (defun embark--all-bindings (keymap &optional nested)
   2846   "Return an alist of all bindings in KEYMAP.
   2847 If NESTED is non-nil subkeymaps are not flattened."
   2848   (let (bindings maps)
   2849     (map-keymap
   2850      (lambda (key def)
   2851        (cond
   2852         ((keymapp def)
   2853          (if nested
   2854              (push (cons (vector key) def) maps)
   2855            (dolist (bind (embark--all-bindings def))
   2856              (push (cons (vconcat (vector key) (car bind)) (cdr bind))
   2857                    maps))))
   2858         (def (push (cons (vector key) def) bindings))))
   2859      (keymap-canonicalize keymap))
   2860     (nconc (nreverse bindings) (nreverse maps))))
   2861 
   2862 (defun embark-collect--direct-action-map (type)
   2863   "Return a direct action keymap for targets of given TYPE."
   2864   (let* ((actions (embark--action-keymap type nil))
   2865          (map (make-sparse-keymap)))
   2866     (set-keymap-parent map button-map)
   2867     (pcase-dolist (`(,key . ,cmd) (embark--all-bindings actions))
   2868       (unless (or (equal key [13])
   2869                   (memq cmd '(digit-argument negative-argument)))
   2870         (define-key map key (if (eq cmd 'embark-keymap-help)
   2871                                 #'embark-bindings-at-point
   2872                               (embark--action-command cmd)))))
   2873     map))
   2874 
   2875 (define-minor-mode embark-collect-direct-action-minor-mode
   2876   "Bind type-specific actions directly (without need for `embark-act')."
   2877   :init-value nil
   2878   :lighter " Act"
   2879   (unless (derived-mode-p 'embark-collect-mode)
   2880     (user-error "Not in an Embark Collect buffer"))
   2881   (save-excursion
   2882     (goto-char (point-min))
   2883     (let ((inhibit-read-only t) maps)
   2884       (while (progn
   2885                (when (tabulated-list-get-id)
   2886                  (put-text-property
   2887                   (point) (button-end (point)) 'keymap
   2888                   (if embark-collect-direct-action-minor-mode
   2889                       (when-let ((target (embark-collect--target))
   2890                                  (type (plist-get target :type)))
   2891                         (or (alist-get type maps)
   2892                             (setf (alist-get type maps)
   2893                                   (embark-collect--direct-action-map type)))))))
   2894                (forward-button 1 nil nil t))))))
   2895 
   2896 (define-button-type 'embark-collect-entry
   2897   'face 'embark-collect-candidate
   2898   'action 'embark-collect-choose)
   2899 
   2900 (declare-function outline-toggle-children "outline")
   2901 (define-button-type 'embark-collect-group
   2902   'face 'embark-collect-group-title
   2903   'action (lambda (_) (outline-toggle-children)))
   2904 
   2905 (defun embark--boundaries ()
   2906   "Get current minibuffer completion boundaries."
   2907   (let ((contents (minibuffer-contents))
   2908         (pt (embark--minibuffer-point)))
   2909     (completion-boundaries
   2910      (substring contents 0 pt)
   2911      minibuffer-completion-table
   2912      minibuffer-completion-predicate
   2913      (substring contents pt))))
   2914 
   2915 (defun embark-collect-choose (entry)
   2916   "Run default action on Embark Collect ENTRY."
   2917   (pcase-let ((`(,type ,text ,start . ,end)
   2918                (save-excursion
   2919                  (goto-char entry)
   2920                  (embark-target-collect-candidate))))
   2921     (embark--act (embark--default-action type)
   2922                  (list :target text
   2923                        :type type
   2924                        :bounds (cons start end)))))
   2925 
   2926 (defvar-keymap embark-collect-mode-map
   2927   :doc "Keymap for Embark collect mode."
   2928   :parent tabulated-list-mode-map
   2929   "a" #'embark-act
   2930   "A" #'embark-act-all
   2931   "M-a" #'embark-collect-direct-action-minor-mode
   2932   "E" #'embark-export
   2933   "s" #'isearch-forward
   2934   "n" #'forward-button
   2935   "p" #'backward-button
   2936   "}" 'outline-next-heading
   2937   "{" 'outline-previous-heading
   2938   "<remap> <forward-paragraph>" 'outline-next-heading
   2939   "<remap> <backward-paragraph>" 'outline-previous-heading
   2940   "<remap> <revert-buffer>" #'embark-rerun-collect-or-export)
   2941 
   2942 (defconst embark-collect--outline-string (string #x210000)
   2943   "Special string used for outline headings in Embark Collect buffers.
   2944 Chosen to be extremely unlikely to appear in a candidate.")
   2945 
   2946 (define-derived-mode embark-collect-mode tabulated-list-mode "Embark Collect"
   2947   "List of candidates to be acted on.
   2948 The command `embark-act' is bound `embark-collect-mode-map', but
   2949 you might prefer to change the key binding to match your other
   2950 key binding for it.  Or alternatively you might want to enable the
   2951 embark collect direct action minor mode by adding the function
   2952 `embark-collect-direct-action-minor-mode' to
   2953 `embark-collect-mode-hook'.
   2954 
   2955 Reverting an Embark Collect buffer has slightly unusual behavior
   2956 if the buffer was obtained by running `embark-collect' from
   2957 within a minibuffer completion session.  In that case reverting
   2958 just restarts the completion session, that is, the command that
   2959 opened the minibuffer is run again and the minibuffer contents
   2960 restored.  You can then interact normally with the command,
   2961 perhaps editing the minibuffer contents, and, if you wish, you
   2962 can rerun `embark-collect' to get an updated buffer."
   2963     :interactive nil :abbrev-table nil :syntax-table nil)
   2964 
   2965 (defun embark-collect--metadatum (type metadatum)
   2966   "Get METADATUM for current buffer's candidates.
   2967 For non-minibuffers, assume candidates are of given TYPE."
   2968   (if (minibufferp)
   2969       (or (completion-metadata-get (embark--metadata) metadatum)
   2970           (plist-get completion-extra-properties
   2971                      (intern (format ":%s" metadatum))))
   2972     ;; otherwise fake some metadata for Marginalia users's benefit
   2973     (completion-metadata-get `((category . ,type)) metadatum)))
   2974 
   2975 (defun embark-collect--affixator (type)
   2976   "Get affixation function for current buffer's candidates.
   2977 For non-minibuffers, assume candidates are of given TYPE."
   2978   (or (embark-collect--metadatum type 'affixation-function)
   2979       (let ((annotator
   2980              (or (embark-collect--metadatum type 'annotation-function)
   2981                  (lambda (_) ""))))
   2982         (lambda (candidates)
   2983           (mapcar (lambda (c)
   2984                     (if-let (a (funcall annotator c)) (list c "" a) c))
   2985                   candidates)))))
   2986 
   2987 (defun embark--display-string (str)
   2988   ;; Note: Keep in sync with vertico--display-string
   2989   "Return display STR without display and invisible properties."
   2990   (let ((end (length str)) (pos 0) chunks)
   2991     (while (< pos end)
   2992       (let ((nextd (next-single-property-change pos 'display str end))
   2993             (disp (get-text-property pos 'display str)))
   2994         (if (stringp disp)
   2995             (let ((face (get-text-property pos 'face str)))
   2996               (when face
   2997                 (add-face-text-property
   2998                  0 (length disp) face t (setq disp (concat disp))))
   2999               (setq pos nextd chunks (cons disp chunks)))
   3000           (while (< pos nextd)
   3001             (let ((nexti
   3002                    (next-single-property-change pos 'invisible str nextd)))
   3003               (unless (or (get-text-property pos 'invisible str)
   3004                           (and (= pos 0) (= nexti end))) ;; full=>no allocation
   3005                 (push (substring str pos nexti) chunks))
   3006               (setq pos nexti))))))
   3007     (if chunks (apply #'concat (nreverse chunks)) str)))
   3008 
   3009 (defconst embark--hline
   3010   (propertize
   3011    (concat "\n" (propertize
   3012                  " " 'display '(space :align-to right)
   3013                  'face '(:inherit completions-group-separator :height 0.01)
   3014                  'cursor-intangible t 'intangible t)))
   3015   "Horizontal line used to separate multiline collect entries.")
   3016 
   3017 (defun embark-collect--format-entries (candidates grouper)
   3018   "Format CANDIDATES for `tabulated-list-mode' grouped by GROUPER.
   3019 The GROUPER is either nil or a function like the `group-function'
   3020 completion metadatum, that is, a function of two arguments, the
   3021 first of which is a candidate and the second controls what is
   3022 computed: if nil, the title of the group the candidate belongs
   3023 to, and if non-nil, a rewriting of the candidate (useful to
   3024 simplify the candidate so it doesn't repeat the group title, for
   3025 example)."
   3026   (let ((max-width 0)
   3027         (transform
   3028          (if grouper (lambda (cand) (funcall grouper cand t)) #'identity)))
   3029     (setq
   3030      tabulated-list-entries
   3031      (mapcan
   3032       (lambda (group)
   3033         (let ((multiline (seq-some (lambda (x) (string-match-p "\n" (car x)))
   3034                                    candidates)))
   3035           (cons
   3036            `(nil [(,(concat (propertize embark-collect--outline-string
   3037                                         'invisible t)
   3038                             (format embark-collect-group-format (car group)))
   3039                    type embark-collect-group)
   3040                   ("" skip t)])
   3041            (mapcar
   3042             (pcase-lambda (`(,cand ,prefix ,annotation))
   3043               (let* ((display (embark--display-string (funcall transform cand)))
   3044                      (length (length annotation))
   3045                      (faces (text-property-not-all
   3046                              0 length 'face nil annotation)))
   3047                 (setq max-width (max max-width (+ (string-width prefix)
   3048                                                   (string-width display))))
   3049                 (when faces
   3050                   (add-face-text-property 0 length 'default t annotation))
   3051                 `(,cand
   3052                   [(,(propertize
   3053                       (if multiline (concat display embark--hline) display)
   3054                       'line-prefix prefix)
   3055                     type embark-collect-entry)
   3056                    (,annotation
   3057                     skip t
   3058                     ,@(unless faces
   3059                         '(face embark-collect-annotation)))])))
   3060             (cdr group)))))
   3061      (if grouper
   3062          (seq-group-by (lambda (item) (funcall grouper (car item) nil))
   3063                        candidates)
   3064        (list (cons "" candidates)))))
   3065   (if (null grouper)
   3066       (pop tabulated-list-entries)
   3067     (setq-local outline-regexp embark-collect--outline-string)
   3068     (outline-minor-mode))
   3069   (setq tabulated-list-format
   3070         `[("Candidate" ,max-width t) ("Annotation" 0 t)])))
   3071 
   3072 (defun embark-collect--update-candidates (buffer)
   3073   "Update candidates for Embark Collect BUFFER."
   3074   (let* ((transformed (embark--maybe-transform-candidates))
   3075          (type (plist-get transformed :orig-type)) ; we need the originals for
   3076          (candidates (plist-get transformed :orig-candidates)) ; default action
   3077          (bounds (plist-get transformed :bounds))
   3078          (affixator (embark-collect--affixator type))
   3079          (grouper (embark-collect--metadatum type 'group-function)))
   3080     (when (eq type 'file)
   3081       (let ((dir (buffer-local-value 'default-directory buffer)))
   3082         (setq candidates
   3083               (mapcar (lambda (cand)
   3084                         (let ((rel (file-relative-name cand dir)))
   3085                           (if (string-prefix-p "../" rel) cand rel)))
   3086                       candidates))))
   3087     (if (seq-some #'identity bounds)
   3088       (cl-loop for cand in candidates and (start . _end) in bounds
   3089                when start
   3090                do (add-text-properties
   3091                    0 1 `(embark--location ,(copy-marker start)) cand)))
   3092     (setq candidates (funcall affixator candidates))
   3093     (with-current-buffer buffer
   3094       (setq embark--type type)
   3095       (unless embark--command
   3096         (setq embark--command #'embark--goto))
   3097       (embark-collect--format-entries candidates grouper))
   3098     candidates))
   3099 
   3100 (defun embark--goto (target)
   3101   "Jump to the original location of TARGET.
   3102 This function is used as a default action in Embark Collect
   3103 buffers when the candidates were a selection from a regular
   3104 buffer."
   3105   ;; TODO: ensure the location jumped to is visible
   3106   ;; TODO: remove duplication with embark-org-goto-heading
   3107   (when-let ((marker (get-text-property 0 'embark--location target)))
   3108     (pop-to-buffer (marker-buffer marker))
   3109     (widen)
   3110     (goto-char marker)
   3111     (pulse-momentary-highlight-one-line)))
   3112 
   3113 (defun embark--collect (buffer-name)
   3114   "Create an Embark Collect buffer named BUFFER-NAME.
   3115 
   3116 The function `generate-new-buffer-name' is used to ensure the
   3117 buffer has a unique name."
   3118   (let ((buffer (generate-new-buffer buffer-name))
   3119         (rerun (embark--rerun-function #'embark-collect)))
   3120     (with-current-buffer buffer
   3121       ;; we'll run the mode hooks once the buffer is displayed, so
   3122       ;; the hooks can make use of the window
   3123       (delay-mode-hooks (embark-collect-mode)))
   3124 
   3125     (embark--cache-info buffer)
   3126     (unless (embark-collect--update-candidates buffer)
   3127       (user-error "No candidates to collect"))
   3128 
   3129     (with-current-buffer buffer
   3130       (setq tabulated-list-use-header-line nil ; default to no header
   3131             header-line-format nil
   3132             tabulated-list--header-string nil)
   3133       (setq embark--rerun-function rerun))
   3134 
   3135     (let ((window (display-buffer buffer)))
   3136       (with-selected-window window
   3137         (run-mode-hooks)
   3138         (tabulated-list-revert))
   3139       (set-window-dedicated-p window t)
   3140       buffer)))
   3141 
   3142 (defun embark--descriptive-buffer-name (type)
   3143   "Return a descriptive name for an Embark collect or export buffer.
   3144 TYPE should be either `collect' or `export'."
   3145   (format "*Embark %s: %s*"
   3146           (capitalize (symbol-name type))
   3147           (if (minibufferp)
   3148               (format "%s - %s" embark--command
   3149                       (minibuffer-contents-no-properties))
   3150             (buffer-name))))
   3151 
   3152 ;;;###autoload
   3153 (defun embark-collect ()
   3154   "Create an Embark Collect buffer.
   3155 
   3156 To control the display, add an entry to `display-buffer-alist'
   3157 with key \"Embark Collect\".
   3158 
   3159 In Embark Collect buffers `revert-buffer' is remapped to
   3160 `embark-rerun-collect-or-export', which has slightly unusual
   3161 behavior if the buffer was obtained by running `embark-collect'
   3162 from within a minibuffer completion session.  In that case
   3163 rerunning just restarts the completion session, that is, the
   3164 command that opened the minibuffer is run again and the
   3165 minibuffer contents restored.  You can then interact normally with
   3166 the command, perhaps editing the minibuffer contents, and, if you
   3167 wish, you can rerun `embark-collect' to get an updated buffer."
   3168   (interactive)
   3169   (let ((buffer (embark--collect (embark--descriptive-buffer-name 'collect))))
   3170     (when (minibufferp)
   3171       (embark--run-after-command #'pop-to-buffer buffer)
   3172       (embark--quit-and-run #'message nil))))
   3173 
   3174 ;;;###autoload
   3175 (defun embark-live ()
   3176   "Create a live-updating Embark Collect buffer.
   3177 
   3178 To control the display, add an entry to `display-buffer-alist'
   3179 with key \"Embark Live\"."
   3180   (interactive)
   3181   (let ((live-buffer (embark--collect
   3182                       (format "*Embark Live: %s*"
   3183                               (if (minibufferp)
   3184                                   (format "M-x %s" embark--command)
   3185                                 (buffer-name)))))
   3186         (run-collect (make-symbol "run-collect"))
   3187         (stop-collect (make-symbol "stop-collect"))
   3188         timer)
   3189     (setf (symbol-function stop-collect)
   3190           (lambda ()
   3191             (remove-hook 'change-major-mode-hook stop-collect t)
   3192             (remove-hook 'after-change-functions run-collect t)))
   3193     (setf (symbol-function run-collect)
   3194           (lambda (_1 _2 _3)
   3195             (unless timer
   3196               (setq timer
   3197                     (run-with-idle-timer
   3198                      0.05 nil
   3199                      (lambda ()
   3200                        (if (not (buffer-live-p live-buffer))
   3201                            (funcall stop-collect)
   3202                          (embark-collect--update-candidates live-buffer)
   3203                          (with-current-buffer live-buffer
   3204                            ;; TODO figure out why I can't restore point
   3205                            (tabulated-list-print t t))
   3206                          (setq timer nil))))))))
   3207     (add-hook 'after-change-functions run-collect nil t)
   3208     (when (minibufferp)
   3209       (add-hook 'change-major-mode-hook stop-collect nil t))))
   3210 
   3211 (defun embark--rerun-function (kind)
   3212   "Return a rerun function for an export or collect buffer in this context.
   3213 The parameter KIND should be either `embark-export' or `embark-collect'."
   3214   (let ((buffer (or embark--target-buffer (embark--target-buffer)))
   3215         (command embark--command))
   3216     (cl-flet ((rerunner (action)
   3217                 (lambda (&rest _)
   3218                   (quit-window 'kill-buffer)
   3219                   (with-current-buffer
   3220                       (if (buffer-live-p buffer) buffer (current-buffer))
   3221                     (let ((embark--command command))
   3222                       (funcall action))))))
   3223         (if (minibufferp)
   3224           (rerunner
   3225            (let ((input (minibuffer-contents-no-properties)))
   3226              (lambda ()
   3227                (minibuffer-with-setup-hook
   3228                    (lambda ()
   3229                      (delete-minibuffer-contents)
   3230                      (insert input))
   3231                  (setq this-command embark--command)
   3232                  (command-execute embark--command)))))
   3233           (rerunner kind)))))
   3234 
   3235 (defun embark-rerun-collect-or-export ()
   3236   "Rerun the `embark-collect' or `embark-export' that created this buffer."
   3237   (interactive)
   3238   (if embark--rerun-function
   3239       (funcall embark--rerun-function)
   3240     (user-error "No function to rerun collect or export found")))
   3241 
   3242 ;;;###autoload
   3243 (defun embark-export ()
   3244   "Create a type-specific buffer to manage current candidates.
   3245 The variable `embark-exporters-alist' controls how to make the
   3246 buffer for each type of completion.
   3247 
   3248 In Embark Export buffers `revert-buffer' is remapped to
   3249 `embark-rerun-collect-or-export', which has slightly unusual
   3250 behavior if the buffer was obtained by running `embark-export'
   3251 from within a minibuffer completion session.  In that case
   3252 reverting just restarts the completion session, that is, the
   3253 command that opened the minibuffer is run again and the
   3254 minibuffer contents restored.  You can then interact normally
   3255 with the command, perhaps editing the minibuffer contents, and,
   3256 if you wish, you can rerun `embark-export' to get an updated
   3257 buffer."
   3258   (interactive)
   3259   (let* ((transformed (embark--maybe-transform-candidates))
   3260          (candidates (or (plist-get transformed :candidates)
   3261                          (user-error "No candidates for export")))
   3262          (type (plist-get transformed :type)))
   3263     (let ((exporter (or (alist-get type embark-exporters-alist)
   3264                         (alist-get t embark-exporters-alist))))
   3265       (if (eq exporter 'embark-collect)
   3266           (embark-collect)
   3267         (let* ((after embark-after-export-hook)
   3268                (cmd embark--command)
   3269                (name (embark--descriptive-buffer-name 'export))
   3270                (rerun (embark--rerun-function #'embark-export))
   3271                (buffer (save-excursion
   3272                          (funcall exporter candidates)
   3273                          (rename-buffer name t)
   3274                          (current-buffer))))
   3275           (embark--quit-and-run
   3276            (lambda ()
   3277              (pop-to-buffer buffer)
   3278              (setq embark--rerun-function rerun)
   3279              (use-local-map
   3280               (make-composed-keymap
   3281                '(keymap
   3282                  (remap keymap
   3283                         (revert-buffer . embark-rerun-collect-or-export)))
   3284                (current-local-map)))
   3285              (let ((embark-after-export-hook after)
   3286                    (embark--command cmd))
   3287                (run-hooks 'embark-after-export-hook)))))))))
   3288 
   3289 (defmacro embark--export-rename (buffer title &rest body)
   3290   "Run BODY and rename BUFFER to Embark export buffer with TITLE."
   3291   (declare (indent 2))
   3292   (let ((saved (make-symbol "saved")))
   3293     `(let ((,saved (embark-rename-buffer
   3294                     ,buffer " *Embark Saved*" t)))
   3295        ,@body
   3296        (set-buffer (embark-rename-buffer
   3297                     ,buffer ,(format "*Embark Export %s*" title) t))
   3298        (when ,saved (embark-rename-buffer ,saved ,buffer)))))
   3299 
   3300 (defun embark--export-customize (items type pred)
   3301   "Create a customization buffer listing ITEMS.
   3302 TYPE is the items type.
   3303 PRED is a predicate function used to filter the items."
   3304   (custom-buffer-create
   3305    (cl-loop for item in items
   3306             for sym = (intern-soft item)
   3307             when (and sym (funcall pred sym)) collect `(,sym ,type))))
   3308 
   3309 (autoload 'apropos-parse-pattern "apropos")
   3310 (autoload 'apropos-symbols-internal "apropos")
   3311 (defun embark-export-apropos (symbols)
   3312   "Create apropos buffer listing SYMBOLS."
   3313   (embark--export-rename "*Apropos*" "Apropos"
   3314     (apropos-parse-pattern "") ;; Initialize apropos pattern
   3315     ;; HACK: Ensure that order of exported symbols is kept.
   3316     (cl-letf (((symbol-function #'sort) (lambda (list _pred) (nreverse list))))
   3317       (apropos-symbols-internal
   3318        (delq nil (mapcar #'intern-soft symbols))
   3319        (bound-and-true-p apropos-do-all)))))
   3320 
   3321 (defun embark-export-customize-face (faces)
   3322   "Create a customization buffer listing FACES."
   3323   (embark--export-customize faces 'custom-face #'facep))
   3324 
   3325 (defun embark-export-customize-variable (variables)
   3326   "Create a customization buffer listing VARIABLES."
   3327   ;; The widget library serializes/deserializes the values. We advise
   3328   ;; the serialization in order to avoid errors for nonserializable
   3329   ;; variables.
   3330   (cl-letf* ((ht (make-hash-table :test #'equal))
   3331              (orig-read (symbol-function #'read))
   3332              (orig-write (symbol-function 'widget-sexp-value-to-internal))
   3333              ((symbol-function #'read)
   3334               (lambda (&optional str)
   3335                 (condition-case nil
   3336                     (funcall orig-read str)
   3337                   (error (gethash str ht)))))
   3338              ((symbol-function 'widget-sexp-value-to-internal)
   3339               (lambda (widget val)
   3340                 (let ((str (funcall orig-write widget val)))
   3341                   (puthash str val ht)
   3342                   str))))
   3343     (embark--export-customize variables 'custom-variable #'boundp)))
   3344 
   3345 (defun embark-export-ibuffer (buffers)
   3346   "Create an ibuffer buffer listing BUFFERS."
   3347   (ibuffer t "*Embark Export Ibuffer*"
   3348            `((predicate . (member (buffer-name) ',buffers)))))
   3349 
   3350 (autoload 'dired-check-switches "dired")
   3351 (declare-function dired-unadvertise "dired")
   3352 (defvar dired-directory)
   3353 
   3354 (defun embark-export-dired (files)
   3355   "Create a Dired buffer listing FILES."
   3356   (setq files (mapcar #'directory-file-name
   3357                       (cl-remove-if-not #'file-exists-p files)))
   3358   (when (dired-check-switches dired-listing-switches "A" "almost-all")
   3359     (setq files (cl-remove-if
   3360                  (lambda (path)
   3361                    (let ((file (file-name-nondirectory path)))
   3362                      (or (string= file ".") (string= file ".."))))
   3363                  files)))
   3364   (cl-letf* ((dir (or (file-name-directory (try-completion "" files)) ""))
   3365              ;; Prevent reusing existing Dired buffer.
   3366              ((symbol-function 'dired-find-buffer-nocreate) #'ignore)
   3367              (buf (dired-noselect
   3368                    (cons (expand-file-name dir)
   3369                          (mapcar (lambda (file) (string-remove-prefix dir file))
   3370                                  files)))))
   3371     (with-current-buffer buf
   3372       ;; Unadvertise to prevent the new buffer from being reused.
   3373       (dired-unadvertise default-directory)
   3374       (rename-buffer (format "*Embark Export Dired %s*" default-directory)))
   3375     (pop-to-buffer buf)))
   3376 
   3377 (autoload 'package-menu-mode "package")
   3378 (autoload 'package-menu--generate "package")
   3379 
   3380 (defun embark-export-list-packages (packages)
   3381   "Create a package menu mode buffer listing PACKAGES."
   3382   (let ((buf (generate-new-buffer "*Embark Export Packages*")))
   3383     (with-current-buffer buf
   3384       (package-menu-mode)
   3385       (package-menu--generate nil (mapcar #'intern packages)))
   3386     (pop-to-buffer buf)))
   3387 
   3388 (defvar bookmark-alist)
   3389 
   3390 (defun embark-export-bookmarks (bookmarks)
   3391   "Create a `bookmark-bmenu-mode' buffer listing BOOKMARKS."
   3392   (embark--export-rename "*Bookmark List*" "Bookmarks"
   3393     (let ((bookmark-alist
   3394            (cl-remove-if-not
   3395             (lambda (bmark)
   3396               (member (car bmark) bookmarks))
   3397             bookmark-alist)))
   3398       (bookmark-bmenu-list))))
   3399 
   3400 ;;; Multiple target selection
   3401 
   3402 (defface embark-selected '((t (:inherit match)))
   3403   "Face for selected candidates.")
   3404 
   3405 (defcustom embark-selection-indicator
   3406   #("  Embark:%s " 1 12 (face (embark-selected bold)))
   3407   "Mode line indicator used for selected candidates."
   3408   :type '(choice string (const nil)))
   3409 
   3410 (defvar-local embark--selection nil
   3411   "Buffer local list of selected targets.
   3412 Add or remove elements to this list using the `embark-select'
   3413 action.")
   3414 
   3415 (defun embark--selection-indicator ()
   3416   "Mode line indicator showing number of selected items."
   3417   (when-let ((sel
   3418               (buffer-local-value
   3419                'embark--selection
   3420                (or (when-let ((win (active-minibuffer-window)))
   3421                      (window-buffer win))
   3422                    (current-buffer)))))
   3423     (format embark-selection-indicator (length sel))))
   3424 
   3425 (cl-defun embark--select
   3426     (&key orig-target orig-type bounds &allow-other-keys)
   3427   "Add or remove ORIG-TARGET of given ORIG-TYPE to the selection.
   3428 If BOUNDS are given, also highlight the target when selecting it."
   3429   (cl-flet ((multi-type (x) (car (get-text-property 0 'multi-category x))))
   3430     (if-let* ((existing (seq-find
   3431                          (pcase-lambda (`(,cand . ,ov))
   3432                            (and
   3433                             (equal cand orig-target)
   3434                             (if (and bounds ov)
   3435                                 (and (= (car bounds) (overlay-start ov))
   3436                                      (= (cdr bounds) (overlay-end ov)))
   3437                               (let ((cand-type (multi-type cand)))
   3438                                 (or (eq cand-type orig-type)
   3439                                     (eq cand-type (multi-type orig-target)))))))
   3440                          embark--selection)))
   3441         (progn
   3442           (when (cdr existing) (delete-overlay (cdr existing)))
   3443           (setq embark--selection (delq existing embark--selection)))
   3444       (let ((target (copy-sequence orig-target)) overlay)
   3445         (when bounds
   3446           (setq overlay (make-overlay (car bounds) (cdr bounds)))
   3447           (overlay-put overlay 'category 'embark-selected-overlay))
   3448         (add-text-properties 0 (length orig-target)
   3449                              `(multi-category ,(cons orig-type orig-target))
   3450                              target)
   3451         (push (cons target overlay) embark--selection))))
   3452   (when embark-selection-indicator
   3453     (add-to-list 'mode-line-misc-info '(:eval (embark--selection-indicator)))
   3454     (force-mode-line-update t)))
   3455 
   3456 ;;;###autoload
   3457 (defun embark-select ()
   3458   "Add or remove the target from the current buffer's selection.
   3459 You can act on all selected targets at once with `embark-act-all'.
   3460 When called from outside `embark-act' this command will select
   3461 the first target at point."
   3462   (interactive)
   3463   (if-let ((target (car (embark--targets))))
   3464       (apply #'embark--select target)
   3465     (user-error "No target to select")))
   3466 
   3467 (defun embark-selected-candidates ()
   3468   "Return currently selected candidates in the buffer."
   3469   (when embark--selection
   3470     (cl-flet ((unwrap (x) (get-text-property 0 'multi-category x)))
   3471       (let* ((first-type (car (unwrap (caar embark--selection))))
   3472              (same (cl-every (lambda (item)
   3473                                (eq (car (unwrap (car item))) first-type))
   3474                              embark--selection))
   3475              (extract (if same
   3476                           (pcase-lambda (`(,cand . ,overlay))
   3477                             (cons (cdr (unwrap cand)) overlay))
   3478                         #'identity)))
   3479         (cons
   3480          (if same first-type 'multi-category)
   3481          (nreverse
   3482           (mapcar
   3483            (lambda (item)
   3484              (pcase-let ((`(,cand . ,ov) (funcall extract item)))
   3485                (if ov `(,cand ,(overlay-start ov) . ,(overlay-end ov)) cand)))
   3486            embark--selection)))))))
   3487 
   3488 ;;; Integration with external packages, mostly completion UIs
   3489 
   3490 ;; marginalia
   3491 
   3492 ;; Ensure that the Marginalia cache is reset, such that
   3493 ;; `embark-toggle-variable-value' updates the display (See #540).
   3494 (with-eval-after-load 'marginalia
   3495   (push 'marginalia--cache-reset (alist-get :always embark-post-action-hooks)))
   3496 
   3497 ;; vertico
   3498 
   3499 (declare-function vertico--candidate "ext:vertico")
   3500 (declare-function vertico--update "ext:vertico")
   3501 (defvar vertico--input)
   3502 (defvar vertico--candidates)
   3503 (defvar vertico--base)
   3504 
   3505 (defun embark--vertico-selected ()
   3506   "Target the currently selected item in Vertico.
   3507 Return the category metadatum as the type of the target."
   3508   (when vertico--input
   3509     ;; Force candidate computation, if candidates are not yet available.
   3510     (vertico--update)
   3511     (cons (completion-metadata-get (embark--metadata) 'category)
   3512           (vertico--candidate))))
   3513 
   3514 (defun embark--vertico-candidates ()
   3515   "Collect the current Vertico candidates.
   3516 Return the category metadatum as the type of the candidates."
   3517   (when vertico--input
   3518     ;; Force candidate computation, if candidates are not yet available.
   3519     (vertico--update)
   3520     (cons (completion-metadata-get (embark--metadata) 'category)
   3521           vertico--candidates)))
   3522 
   3523 (defun embark--vertico-indicator ()
   3524   "Embark indicator highlighting the current Vertico candidate."
   3525   (let ((fr face-remapping-alist))
   3526     (lambda (&optional keymap _targets _prefix)
   3527       (when vertico--input
   3528         (setq-local face-remapping-alist
   3529                     (if keymap
   3530                         (cons '(vertico-current . embark-target) fr)
   3531                       fr))))))
   3532 
   3533 (with-eval-after-load 'vertico
   3534   (cl-defmethod vertico--format-candidate
   3535     :around (cand prefix suffix index start &context (embark--selection cons))
   3536     (when (cl-find (concat vertico--base (nth index vertico--candidates))
   3537                    embark--selection
   3538                    :test #'equal :key #'car)
   3539       (setq cand (copy-sequence cand))
   3540       (add-face-text-property 0 (length cand) 'embark-selected t cand))
   3541     (cl-call-next-method cand prefix suffix index start))
   3542   (add-hook 'embark-indicators #'embark--vertico-indicator)
   3543   (add-hook 'embark-target-finders #'embark--vertico-selected)
   3544   (add-hook 'embark-candidate-collectors #'embark--vertico-candidates)
   3545   (remove-hook 'embark-candidate-collectors #'embark-selected-candidates)
   3546   (add-hook 'embark-candidate-collectors #'embark-selected-candidates))
   3547 
   3548 ;; ivy
   3549 
   3550 (declare-function ivy--expand-file-name "ext:ivy")
   3551 (declare-function ivy-state-current "ext:ivy")
   3552 (defvar ivy-text)
   3553 (defvar ivy-last)
   3554 (defvar ivy--old-cands) ; this stores the current candidates :)
   3555 (defvar ivy--length)
   3556 
   3557 (defun embark--ivy-selected ()
   3558   "Target the currently selected item in Ivy.
   3559 Return the category metadatum as the type of the target."
   3560   ;; my favorite way of detecting Ivy
   3561   (when (memq 'ivy--queue-exhibit post-command-hook)
   3562     (cons
   3563      (completion-metadata-get (embark--metadata) 'category)
   3564      (ivy--expand-file-name
   3565       (if (and (> ivy--length 0)
   3566                (stringp (ivy-state-current ivy-last)))
   3567           (ivy-state-current ivy-last)
   3568         ivy-text)))))
   3569 
   3570 (defun embark--ivy-candidates ()
   3571   "Return all current Ivy candidates."
   3572   ;; my favorite way of detecting Ivy
   3573   (when (memq 'ivy--queue-exhibit post-command-hook)
   3574     (cons
   3575      ;; swiper-isearch uses swiper-isearch-function as a completion
   3576      ;; table, but it doesn't understand metadata queries
   3577      (ignore-errors
   3578        (completion-metadata-get (embark--metadata) 'category))
   3579      ivy--old-cands)))
   3580 
   3581 (with-eval-after-load 'ivy
   3582   (add-hook 'embark-target-finders #'embark--ivy-selected)
   3583   (add-hook 'embark-candidate-collectors #'embark--ivy-candidates)
   3584   (remove-hook 'embark-candidate-collectors #'embark-selected-candidates)
   3585   (add-hook 'embark-candidate-collectors #'embark-selected-candidates))
   3586 
   3587 ;;; Custom actions
   3588 
   3589 (defvar embark-separator-history nil
   3590   "Input history for the separators used by some embark commands.
   3591 The commands that prompt for a string separator are
   3592 `embark-insert' and `embark-copy-as-kill'.")
   3593 
   3594 (defun embark-keymap-help ()
   3595   "Prompt for an action to perform or command to become and run it."
   3596   (interactive)
   3597   (user-error "Not meant to be called directly"))
   3598 
   3599 (defun embark-toggle-quit ()
   3600   "Toggle whether the following action quits the minibuffer."
   3601   (interactive)
   3602   (when (minibufferp)
   3603     (setq embark--toggle-quit (not embark--toggle-quit))
   3604     (if (consp embark-quit-after-action)
   3605         (message "Will %sobey embark-quit-after-action."
   3606                  (if embark--toggle-quit "dis" ""))
   3607       (message
   3608        "Will %squit minibuffer after action"
   3609        (if (eq embark--toggle-quit embark-quit-after-action) "not " "")))))
   3610 
   3611 (defun embark--separator (strings)
   3612   "Return a separator to join the STRINGS together.
   3613 With a prefix argument, prompt the user (unless STRINGS has 0 or
   3614 1 elements, in which case a separator is not needed)."
   3615   (if (and current-prefix-arg (cdr strings))
   3616       (read-string "Separator: " nil 'embark-separator-history)
   3617     "\n"))
   3618 
   3619 (defun embark-copy-as-kill (strings)
   3620   "Join STRINGS and save on the `kill-ring'.
   3621 With a prefix argument, prompt for the separator to join the
   3622 STRINGS, which defaults to a newline."
   3623   (kill-new (string-join strings (embark--separator strings))))
   3624 
   3625 (defun embark-insert (strings)
   3626   "Join STRINGS and insert the result at point.
   3627 With a prefix argument, prompt for the separator to join the
   3628 STRINGS, which defaults to a newline.
   3629 
   3630 Some whitespace is also inserted if necessary to avoid having the
   3631 inserted string blend into the existing buffer text.  More
   3632 precisely:
   3633 
   3634 1. If the inserted string does not contain newlines, a space may
   3635 be added before or after it as needed to avoid inserting a word
   3636 constituent character next to an existing word constituent.
   3637 
   3638 2. For a multiline inserted string, newlines may be added before
   3639 or after as needed to ensure the inserted string is on lines of
   3640 its own."
   3641   (let* ((separator (embark--separator strings))
   3642          (multiline
   3643           (or (and (cdr strings) (string-match-p "\n" separator))
   3644               (and (null (cdr strings))
   3645                    (equal (buffer-substring (line-beginning-position)
   3646                                             (line-end-position))
   3647                           (car strings)))
   3648               (seq-some (lambda (s) (string-match-p "\n" s)) strings))))
   3649     (cl-labels ((maybe-space ()
   3650                   (and (looking-at "\\w") (looking-back "\\w" 1)
   3651                        (insert " ")))
   3652                 (maybe-newline ()
   3653                   (or (looking-back "^[ \t]*" 40) (looking-at "\n")
   3654                       (newline-and-indent)))
   3655                 (maybe-whitespace ()
   3656                   (if multiline (maybe-newline) (maybe-space)))
   3657                 (ins-string ()
   3658                   (let ((start (point)))
   3659                     (insert
   3660                      (mapconcat #'substring-no-properties strings separator))
   3661                     (save-excursion (goto-char start) (maybe-whitespace))
   3662                     (when (looking-back "\n" 1) (delete-char -1))
   3663                     (save-excursion (maybe-whitespace)))))
   3664       (if buffer-read-only
   3665           (with-selected-window (other-window-for-scrolling)
   3666             (ins-string))
   3667         (ins-string)))))
   3668 
   3669 ;; For Emacs 28 dired-jump will be moved to dired.el, but it seems
   3670 ;; that since it already has an autoload in Emacs 28, this next
   3671 ;; autoload is ignored.
   3672 (autoload 'dired-jump "dired-x" nil t)
   3673 
   3674 (defun embark-dired-jump (file &optional other-window)
   3675   "Open Dired buffer in directory containing FILE and move to its line.
   3676 When called with a prefix argument OTHER-WINDOW, open Dired in other window."
   3677   (interactive "fJump to Dired file: \nP")
   3678   (dired-jump other-window file))
   3679 
   3680 (defun embark--read-from-history (prompt candidates &optional category)
   3681   "Read with completion from list of history CANDIDATES of CATEGORY.
   3682 Sorting and history are disabled.  PROMPT is the prompt message."
   3683   (completing-read prompt
   3684                    (embark--with-category category candidates)
   3685                    nil t nil t))
   3686 
   3687 (defun embark-kill-ring-remove (text)
   3688   "Remove TEXT from `kill-ring'."
   3689   (interactive (list (embark--read-from-history
   3690                       "Remove from kill-ring: " kill-ring 'kill-ring)))
   3691   (embark-history-remove text)
   3692   (setq kill-ring (delete text kill-ring)))
   3693 
   3694 (defvar recentf-list)
   3695 (defun embark-recentf-remove (file)
   3696   "Remove FILE from the list of recent files."
   3697   (interactive (list (embark--read-from-history
   3698                       "Remove recent file: " recentf-list 'file)))
   3699   (embark-history-remove (expand-file-name file))
   3700   (embark-history-remove (abbreviate-file-name file))
   3701   (when (and (boundp 'recentf-list) (fboundp 'recentf-expand-file-name))
   3702     (setq recentf-list (delete (recentf-expand-file-name file) recentf-list))))
   3703 
   3704 (defun embark-history-remove (str)
   3705   "Remove STR from `minibuffer-history-variable'.
   3706 Many completion UIs sort by history position.  This command can be used
   3707 to remove entries from the history, such that they are not sorted closer
   3708 to the top."
   3709   (interactive (list (embark--read-from-history
   3710                       "Remove history item: "
   3711                       (if (eq minibuffer-history-variable t)
   3712                           (user-error "No minibuffer history")
   3713                         (symbol-value minibuffer-history-variable)))))
   3714   (unless (eq minibuffer-history-variable t)
   3715     (set minibuffer-history-variable
   3716          (delete str (symbol-value minibuffer-history-variable)))))
   3717 
   3718 (defvar xref-backend-functions)
   3719 
   3720 (defun embark-find-definition (symbol)
   3721   "Find definition of Emacs Lisp SYMBOL."
   3722   (interactive "sSymbol: ")
   3723   (let ((xref-backend-functions (lambda () 'elisp)))
   3724     (xref-find-definitions symbol)))
   3725 
   3726 (defun embark-info-lookup-symbol (symbol)
   3727   "Display the definition of SYMBOL, from the Elisp manual."
   3728   (interactive "SSymbol: ")
   3729   (info-lookup-symbol symbol 'emacs-lisp-mode))
   3730 
   3731 (defun embark-rename-buffer (buffer newname &optional unique)
   3732   "Rename BUFFER to NEWNAME, optionally making it UNIQUE.
   3733 Interactively, you can set UNIQUE with a prefix argument.
   3734 Returns the new name actually used."
   3735   (interactive "bBuffer: \nBRename %s to: \nP")
   3736   (when-let ((buf (get-buffer buffer)))
   3737     (with-current-buffer buf
   3738       (rename-buffer newname unique))))
   3739 
   3740 (defun embark--package-url (pkg)
   3741   "Return homepage for package PKG."
   3742   (when-let (desc (embark--package-desc pkg))
   3743     (alist-get :url (package-desc-extras desc))))
   3744 
   3745 (defun embark--prompt-for-package ()
   3746   "Prompt user for a package name."
   3747   ;; this code is taken from the interactive spec of describe-package
   3748   (unless package--initialized
   3749     (package-initialize t))
   3750   (intern
   3751    (completing-read "Package: "
   3752                     (append (mapcar #'car package-alist)
   3753                             (mapcar #'car package-archive-contents)
   3754                             (mapcar #'car package--builtins)))))
   3755 
   3756 (defun embark-browse-package-url (pkg)
   3757   "Open homepage for package PKG with `browse-url'."
   3758   (interactive (list (embark--prompt-for-package)))
   3759   (if-let ((url (embark--package-url pkg)))
   3760       (browse-url url)
   3761     (user-error "No homepage found for `%s'" pkg)))
   3762 
   3763 (defun embark-save-package-url (pkg)
   3764   "Save URL of homepage for package PKG on the `kill-ring'."
   3765   (interactive (list (embark--prompt-for-package)))
   3766   (if-let ((url (embark--package-url pkg)))
   3767       (kill-new url)
   3768     (user-error "No homepage found for `%s'" pkg)))
   3769 
   3770 (defun embark-save-variable-value (var)
   3771   "Save value of VAR in the `kill-ring'."
   3772   (interactive "SVariable: ")
   3773   (kill-new (string-trim (pp-to-string (symbol-value var)))))
   3774 
   3775 (defun embark-insert-variable-value (var)
   3776   "Insert value of VAR."
   3777   (interactive "SVariable: ")
   3778   (embark-insert (list (string-trim (pp-to-string (symbol-value var))))))
   3779 
   3780 (defun embark-toggle-variable (var &optional local)
   3781   "Toggle value of boolean variable VAR.
   3782 If prefix LOCAL is non-nil make variable local."
   3783   (interactive "SVariable: \nP")
   3784   (let ((val (symbol-value var)))
   3785     (unless (memq val '(nil t))
   3786       (user-error "Not a boolean variable"))
   3787     (when local
   3788       (make-local-variable var))
   3789     (funcall (or (get var 'custom-set) 'set) var (not val))))
   3790 
   3791 (defun embark-insert-relative-path (file)
   3792   "Insert relative path to FILE.
   3793 The insert path is relative to `default-directory'."
   3794   (interactive "FFile: ")
   3795   (embark-insert (list (file-relative-name (substitute-in-file-name file)))))
   3796 
   3797 (defun embark-save-relative-path (file)
   3798   "Save the relative path to FILE in the kill ring.
   3799 The insert path is relative to `default-directory'."
   3800   (interactive "FFile: ")
   3801   (kill-new (file-relative-name (substitute-in-file-name file))))
   3802 
   3803 (defun embark-shell-command-on-buffer (buffer command &optional replace)
   3804   "Run shell COMMAND on contents of BUFFER.
   3805 Called with \\[universal-argument], replace contents of buffer
   3806 with command output.  For replacement behavior see
   3807 `shell-command-dont-erase-buffer' setting."
   3808   (interactive
   3809    (list
   3810     (read-buffer "Buffer: " nil t)
   3811     (read-shell-command "Shell command: ")
   3812     current-prefix-arg))
   3813   (with-current-buffer buffer
   3814     (shell-command-on-region (point-min) (point-max)
   3815                              command
   3816                              (and replace (current-buffer)))))
   3817 
   3818 (defun embark-open-externally (file)
   3819   "Open FILE or url using system's default application."
   3820   (interactive "sOpen externally: ")
   3821   (unless (string-match-p "\\`[a-z]+://" file)
   3822     (setq file (expand-file-name file)))
   3823   (message "Opening `%s' externally..." file)
   3824   (if (and (eq system-type 'windows-nt)
   3825            (fboundp 'w32-shell-execute))
   3826       (w32-shell-execute "open" file)
   3827     (call-process (pcase system-type
   3828                     ('darwin "open")
   3829                     ('cygwin "cygstart")
   3830                     (_ "xdg-open"))
   3831                   nil 0 nil file)))
   3832 
   3833 (declare-function bookmark-prop-get "bookmark")
   3834 (declare-function bookmark-completing-read "bookmark")
   3835 
   3836 (defun embark-bookmark-open-externally (bookmark)
   3837   "Open BOOKMARK in external application."
   3838   (interactive (list (bookmark-completing-read "Open externally: ")))
   3839   (embark-open-externally
   3840    (or (bookmark-prop-get bookmark 'location)
   3841        (bookmark-prop-get bookmark 'filename)
   3842        (user-error "Bookmark `%s' does not have a location" bookmark))))
   3843 
   3844 (defun embark-bury-buffer (buf)
   3845   "Bury buffer BUF."
   3846   (interactive "bBuffer: ")
   3847   (if-let (win (get-buffer-window buf))
   3848       (with-selected-window win
   3849         (bury-buffer))
   3850     (bury-buffer)))
   3851 
   3852 (defun embark-kill-buffer-and-window (buf)
   3853   "Kill buffer BUF and delete its window."
   3854   (interactive "bBuffer: ")
   3855   (when-let (buf (get-buffer buf))
   3856     (if-let (win (get-buffer-window buf))
   3857         (with-selected-window win
   3858           (kill-buffer-and-window))
   3859       (kill-buffer buf))))
   3860 
   3861 (defun embark-save-unicode-character (char)
   3862   "Save Unicode character CHAR to kill ring."
   3863   (interactive
   3864    (list (read-char-by-name "Insert character  (Unicode name or hex): ")))
   3865   (kill-new (format "%c" char)))
   3866 
   3867 (defun embark-isearch-forward ()
   3868   "Prompt for string in the minibuffer and start isearch forwards.
   3869 Unlike isearch, this command reads the string from the
   3870 minibuffer, which means it can be used as an Embark action."
   3871   (interactive)
   3872   (isearch-mode t)
   3873   (isearch-edit-string))
   3874 
   3875 (defun embark-isearch-backward ()
   3876   "Prompt for string in the minibuffer and start isearch backwards.
   3877 Unlike isearch, this command reads the string from the
   3878 minibuffer, which means it can be used as an Embark action."
   3879   (interactive)
   3880   (isearch-mode nil)
   3881   (isearch-edit-string))
   3882 
   3883 (defun embark-toggle-highlight ()
   3884   "Toggle symbol highlighting using `highlight-symbol-at-point'."
   3885   (interactive)
   3886   (let ((regexp (find-tag-default-as-symbol-regexp))
   3887         (highlighted (cl-find-if #'boundp
   3888                                  '(hi-lock-interactive-lighters
   3889                                    hi-lock-interactive-patterns))))
   3890     (if (and highlighted (assoc regexp (symbol-value highlighted)))
   3891         (unhighlight-regexp regexp)
   3892       (highlight-symbol-at-point))))
   3893 
   3894 (defun embark-next-symbol ()
   3895   "Jump to next occurrence of symbol at point.
   3896 The search respects symbol boundaries."
   3897   (interactive)
   3898   (if-let ((symbol (thing-at-point 'symbol)))
   3899       (let ((regexp (format "\\_<%s\\_>" (regexp-quote symbol))))
   3900         (when (looking-at regexp)
   3901           (forward-symbol 1))
   3902         (unless (re-search-forward regexp nil t)
   3903           (user-error "Symbol `%s' not found" symbol)))
   3904     (user-error "No symbol at point")))
   3905 
   3906 (defun embark-previous-symbol ()
   3907   "Jump to previous occurrence of symbol at point.
   3908 The search respects symbol boundaries."
   3909   (interactive)
   3910   (if-let ((symbol (thing-at-point 'symbol)))
   3911       (let ((regexp (format "\\_<%s\\_>" (regexp-quote symbol))))
   3912         (when (looking-back regexp (- (point) (length symbol)))
   3913           (forward-symbol -1))
   3914         (unless (re-search-backward regexp nil t)
   3915           (user-error "Symbol `%s' not found" symbol)))
   3916     (user-error "No symbol at point")))
   3917 
   3918 (defun embark-compose-mail (address)
   3919   "Compose email to ADDRESS."
   3920   ;; The only reason we cannot use compose-mail directly is its
   3921   ;; interactive specification, which just supplies nil for the
   3922   ;; address (and several other arguments).
   3923   (interactive "sTo: ")
   3924   (compose-mail address))
   3925 
   3926 (autoload 'pp-display-expression "pp")
   3927 
   3928 (defun embark-pp-eval-defun (edebug)
   3929   "Run `eval-defun' and pretty print the result.
   3930 With a prefix argument EDEBUG, instrument the code for debugging."
   3931   (interactive "P")
   3932   (cl-letf (((symbol-function #'eval-expression-print-format)
   3933              (lambda (result)
   3934                (pp-display-expression result "*Pp Eval Output*"))))
   3935     (eval-defun edebug)))
   3936 
   3937 (defun embark-eval-replace (noquote)
   3938   "Evaluate region and replace with evaluated result.
   3939 If NOQUOTE is non-nil (interactively, if called with a prefix
   3940 argument), no quoting is used for strings."
   3941   (interactive "P")
   3942   (let ((beg (region-beginning))
   3943         (end (region-end)))
   3944     (save-excursion
   3945       (goto-char end)
   3946       (insert (format (if noquote "%s" "%S")
   3947                (eval (read (buffer-substring beg end)) lexical-binding)))
   3948       (delete-region beg end))))
   3949 
   3950 (when (< emacs-major-version 29)
   3951   (defun embark-elp-restore-package (prefix)
   3952     "Remove instrumentation from functions with names starting with PREFIX."
   3953     (interactive "SPrefix: ")
   3954     (when (fboundp 'elp-restore-list)
   3955       (elp-restore-list
   3956        (mapcar #'intern
   3957                (all-completions (symbol-name prefix)
   3958                                 obarray 'elp-profilable-p))))))
   3959 
   3960 (defmacro embark--define-hash (algorithm)
   3961   "Define command which computes hash from a string.
   3962 ALGORITHM is the hash algorithm symbol understood by `secure-hash'."
   3963   `(defun ,(intern (format "embark-hash-%s" algorithm)) (str)
   3964      ,(format "Compute %s hash of STR and store it in the kill ring." algorithm)
   3965      (interactive "sString: ")
   3966      (let ((hash (secure-hash ',algorithm str)))
   3967        (kill-new hash)
   3968        (message "%s: %s" ',algorithm hash))))
   3969 
   3970 (embark--define-hash md5)
   3971 (embark--define-hash sha1)
   3972 (embark--define-hash sha224)
   3973 (embark--define-hash sha256)
   3974 (embark--define-hash sha384)
   3975 (embark--define-hash sha512)
   3976 
   3977 (defun embark-encode-url (start end)
   3978   "Properly URI-encode the region between START and END in current buffer."
   3979   (interactive "r")
   3980   (let ((encoded (url-encode-url (buffer-substring-no-properties start end))))
   3981     (delete-region start end)
   3982     (insert encoded)))
   3983 
   3984 (defun embark-decode-url (start end)
   3985   "Decode the URI-encoded region between START and END in current buffer."
   3986   (interactive "r")
   3987   (let ((decoded (url-unhex-string (buffer-substring-no-properties start end))))
   3988     (delete-region start end)
   3989     (insert decoded)))
   3990 
   3991 (defvar epa-replace-original-text)
   3992 (defun embark-epa-decrypt-region (start end)
   3993   "Decrypt region between START and END."
   3994   (interactive "r")
   3995   (let ((epa-replace-original-text t))
   3996     (epa-decrypt-region start end)))
   3997 
   3998 (defvar eww-download-directory)
   3999 (autoload 'eww-download-callback "eww")
   4000 
   4001 (defun embark-download-url (url)
   4002   "Download URL to `eww-download-directory'."
   4003   (interactive "sDownload URL: ")
   4004   (let ((dir eww-download-directory))
   4005     (when (functionp dir) (setq dir (funcall dir)))
   4006     (access-file dir "Download failed")
   4007     (url-retrieve
   4008      url #'eww-download-callback
   4009      (if (>= emacs-major-version 28) (list url dir) (list url)))))
   4010 
   4011 ;;; Setup and pre-action hooks
   4012 
   4013 (defun embark--restart (&rest _)
   4014   "Restart current command with current input.
   4015 Use this to refresh the list of candidates for commands that do
   4016 not handle that themselves."
   4017   (when (minibufferp)
   4018     (embark--become-command embark--command (minibuffer-contents))))
   4019 
   4020 (defun embark--shell-prep (&rest _)
   4021   "Prepare target for use as argument for a shell command.
   4022 This quotes the spaces, inserts an extra space at the beginning
   4023 and leaves the point to the left of it."
   4024   (let ((contents (minibuffer-contents)))
   4025     (delete-minibuffer-contents)
   4026     (insert " " (shell-quote-wildcard-pattern contents))
   4027     (goto-char (minibuffer-prompt-end))))
   4028 
   4029 (defun embark--force-complete (&rest _)
   4030   "Select first minibuffer completion candidate matching target."
   4031   (minibuffer-force-complete))
   4032 
   4033 (cl-defun embark--eval-prep (&key type &allow-other-keys)
   4034   "If target's TYPE is variable, skip edit; if function, wrap in ()."
   4035   (when (memq type '(command function))
   4036     (embark--allow-edit)
   4037     (goto-char (minibuffer-prompt-end))
   4038     (insert "(")
   4039     (goto-char (point-max))
   4040     (insert ")")
   4041     (backward-char)))
   4042 
   4043 (cl-defun embark--beginning-of-target (&key bounds &allow-other-keys)
   4044   "Go to beginning of the target BOUNDS."
   4045   (when (number-or-marker-p (car bounds))
   4046     (goto-char (car bounds))))
   4047 
   4048 (cl-defun embark--end-of-target (&key bounds &allow-other-keys)
   4049   "Go to end of the target BOUNDS."
   4050   (when (number-or-marker-p (cdr bounds))
   4051     (goto-char (cdr bounds))))
   4052 
   4053 (cl-defun embark--mark-target (&rest rest &key run bounds &allow-other-keys)
   4054   "Mark the target if its BOUNDS are known.
   4055 After marking the target, call RUN with the REST of its arguments."
   4056   (cond
   4057    ((and bounds run)
   4058     (save-mark-and-excursion
   4059       (set-mark (cdr bounds))
   4060       (goto-char (car bounds))
   4061       (apply run :bounds bounds rest)))
   4062    (bounds ;; used as pre- or post-action hook
   4063     (set-mark (cdr bounds))
   4064     (goto-char (car bounds)))
   4065    (run (apply run rest))))
   4066 
   4067 (cl-defun embark--unmark-target (&rest _)
   4068   "Deactivate the region target."
   4069   (deactivate-mark t))
   4070 
   4071 (cl-defun embark--narrow-to-target
   4072     (&rest rest &key run bounds &allow-other-keys)
   4073   "Narrow buffer to target if its BOUNDS are known.
   4074 Intended for use as an Embark around-action hook.  This function
   4075 runs RUN with the buffer narrowed to given BOUNDS passing along
   4076 the REST of the arguments."
   4077   (if bounds
   4078     (save-excursion
   4079       (save-restriction
   4080         (narrow-to-region (car bounds) (cdr bounds))
   4081         (goto-char (car bounds))
   4082         (apply run :bounds bounds rest)))
   4083     (apply run rest)))
   4084 
   4085 (defun embark--allow-edit (&rest _)
   4086   "Allow editing the target."
   4087   (remove-hook 'post-command-hook #'exit-minibuffer t)
   4088   (remove-hook 'post-command-hook 'ivy-immediate-done t))
   4089 
   4090 (defun embark--ignore-target (&rest _)
   4091   "Ignore the target."
   4092   (let ((contents
   4093          (get-text-property (minibuffer-prompt-end) 'embark--initial-input)))
   4094     (delete-minibuffer-contents)
   4095     (when contents (insert contents)))
   4096   (embark--allow-edit))
   4097 
   4098 (autoload 'xref-push-marker-stack "xref")
   4099 (defun embark--xref-push-marker (&rest _)
   4100   "Push a marker onto the xref marker stack."
   4101   (xref-push-marker-stack))
   4102 
   4103 (cl-defun embark--confirm (&key action target &allow-other-keys)
   4104   "Ask for confirmation before running the ACTION on the TARGET."
   4105   (unless (y-or-n-p (format "Run %s on %s? " action target))
   4106     (user-error "Canceled")))
   4107 
   4108 (defconst embark--associated-file-fn-alist
   4109   `((file . identity)
   4110     (buffer . ,(lambda (target)
   4111                  (let ((buffer (get-buffer target)))
   4112                    (or (buffer-file-name buffer)
   4113                        (buffer-local-value 'default-directory buffer)))))
   4114     (bookmark . bookmark-location)
   4115     (library . locate-library))
   4116   "Alist of functions that extract a file path from targets of a given type.")
   4117 
   4118 (defun embark--associated-directory (target type)
   4119   "Return directory associated to TARGET of given TYPE.
   4120 The supported values of TYPE are file, buffer, bookmark and
   4121 library, which have an obvious notion of associated directory."
   4122   (when-let ((file-fn (alist-get type embark--associated-file-fn-alist))
   4123              (file (funcall file-fn target)))
   4124     (if (file-directory-p file)
   4125         (file-name-as-directory file)
   4126       (file-name-directory file))))
   4127 
   4128 (cl-defun embark--cd (&rest rest &key run target type &allow-other-keys)
   4129   "Run action with `default-directory' set to the directory of TARGET.
   4130 The supported values of TYPE are file, buffer, bookmark and
   4131 library, which have an obvious notion of associated directory.
   4132 The REST of the arguments are also passed to RUN."
   4133   (let ((default-directory
   4134           (or (embark--associated-directory target type) default-directory)))
   4135     (apply run :target target :type type rest)))
   4136 
   4137 (cl-defun embark--save-excursion (&rest rest &key run &allow-other-keys)
   4138   "Run action without moving point.
   4139 This simply calls RUN with the REST of its arguments inside
   4140 `save-excursion'."
   4141   (save-excursion (apply run rest)))
   4142 
   4143 (defun embark--universal-argument (&rest _)
   4144   "Run action with a universal prefix argument."
   4145   (setq prefix-arg '(4)))
   4146 
   4147 ;;; keymaps
   4148 
   4149 (defvar-keymap embark-meta-map
   4150   :doc "Keymap for non-action Embark functions."
   4151   "-" #'negative-argument
   4152   "0" #'digit-argument
   4153   "1" #'digit-argument
   4154   "2" #'digit-argument
   4155   "3" #'digit-argument
   4156   "4" #'digit-argument
   4157   "5" #'digit-argument
   4158   "6" #'digit-argument
   4159   "7" #'digit-argument
   4160   "8" #'digit-argument
   4161   "9" #'digit-argument)
   4162 
   4163 (defvar-keymap embark-general-map
   4164   :doc "Keymap for Embark general actions."
   4165   :parent embark-meta-map
   4166   "i" #'embark-insert
   4167   "w" #'embark-copy-as-kill
   4168   "q" #'embark-toggle-quit
   4169   "E" #'embark-export
   4170   "S" #'embark-collect
   4171   "L" #'embark-live
   4172   "B" #'embark-become
   4173   "A" #'embark-act-all
   4174   "C-s" #'embark-isearch-forward
   4175   "C-r" #'embark-isearch-backward
   4176   "C-SPC" #'mark
   4177   "DEL" #'delete-region
   4178   "SPC" #'embark-select)
   4179 
   4180 (defvar-keymap embark-encode-map
   4181   :doc "Keymap for Embark region encoding actions."
   4182   "r" #'rot13-region
   4183   "." #'morse-region
   4184   "-" #'unmorse-region
   4185   "s" #'studlify-region
   4186   "m" #'embark-hash-md5
   4187   "1" #'embark-hash-sha1
   4188   "2" #'embark-hash-sha256
   4189   "3" #'embark-hash-sha384
   4190   "4" #'embark-hash-sha224
   4191   "5" #'embark-hash-sha512
   4192   "f" #'format-encode-region
   4193   "F" #'format-decode-region
   4194   "b" #'base64-encode-region
   4195   "B" #'base64-decode-region
   4196   "u" #'embark-encode-url
   4197   "U" #'embark-decode-url
   4198   "c" #'epa-encrypt-region
   4199   "C" #'embark-epa-decrypt-region)
   4200 
   4201 (fset 'embark-encode-map embark-encode-map)
   4202 
   4203 (defvar-keymap embark-sort-map
   4204   :doc "Keymap for Embark actions that sort the region"
   4205   "l" #'sort-lines
   4206   "P" #'sort-pages
   4207   "f" #'sort-fields
   4208   "c" #'sort-columns
   4209   "p" #'sort-paragraphs
   4210   "r" #'sort-regexp-fields
   4211   "n" #'sort-numeric-fields)
   4212 
   4213 (fset 'embark-sort-map embark-sort-map)
   4214 
   4215 ;; these will have autoloads in Emacs 28
   4216 (autoload 'calc-grab-sum-down "calc" nil t)
   4217 (autoload 'calc-grab-sum-across "calc" nil t)
   4218 
   4219 ;; this has had an autoload cookie since at least Emacs 26
   4220 ;; but that autoload doesn't seem to work for me
   4221 (autoload 'org-table-convert-region "org-table" nil t)
   4222 
   4223 (defvar-keymap embark-region-map
   4224   :doc "Keymap for Embark actions on the active region."
   4225   :parent embark-general-map
   4226   "u" #'upcase-region
   4227   "l" #'downcase-region
   4228   "c" #'capitalize-region
   4229   "|" #'shell-command-on-region
   4230   "e" #'eval-region
   4231   "<" #'embark-eval-replace
   4232   "a" #'align
   4233   "A" #'align-regexp
   4234   "<left>" #'indent-rigidly
   4235   "<right>" #'indent-rigidly
   4236   "TAB" #'indent-region
   4237   "f" #'fill-region
   4238   "p" #'fill-region-as-paragraph
   4239   "$" #'ispell-region
   4240   "=" #'count-words-region
   4241   "F" #'whitespace-cleanup-region
   4242   "t" #'transpose-regions
   4243   "o" #'org-table-convert-region
   4244   ";" #'comment-or-uncomment-region
   4245   "W" #'write-region
   4246   "+" #'append-to-file
   4247   "m" #'apply-macro-to-region-lines
   4248   "n" #'narrow-to-region
   4249   "*" #'calc-grab-region
   4250   ":" #'calc-grab-sum-down
   4251   "_" #'calc-grab-sum-across
   4252   "r" #'reverse-region
   4253   "d" #'delete-duplicate-lines
   4254   "b" #'browse-url-of-region
   4255   "h" #'shr-render-region
   4256   "'" #'expand-region-abbrevs
   4257   "v" #'vc-region-history
   4258   "R" #'repunctuate-sentences
   4259   "s" 'embark-sort-map
   4260   ">" 'embark-encode-map)
   4261 
   4262 (defvar-keymap embark-vc-file-map
   4263   :doc "Keymap for Embark VC file actions."
   4264   "d" #'vc-delete-file
   4265   "r" #'vc-rename-file
   4266   "i" #'vc-ignore)
   4267 
   4268 (fset 'embark-vc-file-map embark-vc-file-map)
   4269 
   4270 (defvar-keymap embark-file-map
   4271   :doc "Keymap for Embark file actions."
   4272   :parent embark-general-map
   4273   "RET" #'find-file
   4274   "f" #'find-file
   4275   "F" #'find-file-literally
   4276   "o" #'find-file-other-window
   4277   "d" #'delete-file
   4278   "D" #'delete-directory
   4279   "r" #'rename-file
   4280   "c" #'copy-file
   4281   "s" #'make-symbolic-link
   4282   "j" #'embark-dired-jump
   4283   "!" #'shell-command
   4284   "&" #'async-shell-command
   4285   "$" #'eshell
   4286   "<" #'insert-file
   4287   "m" #'chmod
   4288   "=" #'ediff-files
   4289   "+" #'make-directory
   4290   "\\" #'embark-recentf-remove
   4291   "I" #'embark-insert-relative-path
   4292   "W" #'embark-save-relative-path
   4293   "x" #'embark-open-externally
   4294   "e" #'eww-open-file
   4295   "l" #'load-file
   4296   "b" #'byte-compile-file
   4297   "R" #'byte-recompile-directory
   4298   "v" 'embark-vc-file-map)
   4299 
   4300 (defvar-keymap embark-kill-ring-map
   4301   :doc "Keymap for `kill-ring' commands."
   4302   :parent embark-general-map
   4303   "\\" #'embark-kill-ring-remove)
   4304 
   4305 (defvar-keymap embark-url-map
   4306   :doc "Keymap for Embark url actions."
   4307   :parent embark-general-map
   4308   "RET" #'browse-url
   4309   "b" #'browse-url
   4310   "d" #'embark-download-url
   4311   "x" #'embark-open-externally
   4312   "e" #'eww)
   4313 
   4314 (defvar-keymap embark-email-map
   4315   :doc "Keymap for Embark email actions."
   4316   :parent embark-general-map
   4317   "RET" #'embark-compose-mail
   4318   "c" #'embark-compose-mail)
   4319 
   4320 (defvar-keymap embark-library-map
   4321   :doc "Keymap for operations on Emacs Lisp libraries."
   4322   :parent embark-general-map
   4323   "RET" #'find-library
   4324   "l" #'load-library
   4325   "f" #'find-library
   4326   "h" #'finder-commentary
   4327   "a" #'apropos-library
   4328   "L" #'locate-library
   4329   "m" #'info-display-manual
   4330   "$" #'eshell)
   4331 
   4332 (defvar-keymap embark-buffer-map
   4333   :doc "Keymap for Embark buffer actions."
   4334   :parent embark-general-map
   4335   "RET" #'switch-to-buffer
   4336   "k" #'kill-buffer
   4337   "b" #'switch-to-buffer
   4338   "o" #'switch-to-buffer-other-window
   4339   "z" #'embark-bury-buffer
   4340   "K" #'embark-kill-buffer-and-window
   4341   "r" #'embark-rename-buffer
   4342   "=" #'ediff-buffers
   4343   "|" #'embark-shell-command-on-buffer
   4344   "<" #'insert-buffer
   4345   "$" #'eshell)
   4346 
   4347 (defvar-keymap embark-tab-map
   4348   :doc "Keymap for actions for tab-bar tabs."
   4349   :parent embark-general-map
   4350   "RET" #'tab-bar-select-tab-by-name
   4351   "s" #'tab-bar-select-tab-by-name
   4352   "r" #'tab-bar-rename-tab-by-name
   4353   "k" #'tab-bar-close-tab-by-name)
   4354 
   4355 (defvar-keymap embark-identifier-map
   4356   :doc "Keymap for Embark identifier actions."
   4357   :parent embark-general-map
   4358   "RET" #'xref-find-definitions
   4359   "h" #'display-local-help
   4360   "H" #'embark-toggle-highlight
   4361   "d" #'xref-find-definitions
   4362   "r" #'xref-find-references
   4363   "a" #'xref-find-apropos
   4364   "s" #'info-lookup-symbol
   4365   "n" #'embark-next-symbol
   4366   "p" #'embark-previous-symbol
   4367   "'" #'expand-abbrev
   4368   "$" #'ispell-word
   4369   "o" #'occur)
   4370 
   4371 (defvar-keymap embark-expression-map
   4372   :doc "Keymap for Embark expression actions."
   4373   :parent embark-general-map
   4374   "RET" #'pp-eval-expression
   4375   "e" #'pp-eval-expression
   4376   "<" #'embark-eval-replace
   4377   "m" #'pp-macroexpand-expression
   4378   "TAB" #'indent-region
   4379   "r" #'raise-sexp
   4380   ";" #'comment-dwim
   4381   "t" #'transpose-sexps
   4382   "k" #'kill-region
   4383   "u" #'backward-up-list
   4384   "n" #'forward-list
   4385   "p" #'backward-list)
   4386 
   4387 (defvar-keymap embark-defun-map
   4388   :doc "Keymap for Embark defun actions."
   4389   :parent embark-expression-map
   4390   "RET" #'embark-pp-eval-defun
   4391   "e" #'embark-pp-eval-defun
   4392   "c" #'compile-defun
   4393   "D" #'edebug-defun
   4394   "o" #'checkdoc-defun
   4395   "N" #'narrow-to-defun)
   4396 
   4397 ;; Use quoted symbols to avoid byte-compiler warnings.
   4398 (defvar-keymap embark-heading-map
   4399   :doc "Keymap for Embark heading actions."
   4400   :parent embark-general-map
   4401   "RET" 'outline-show-subtree
   4402   "TAB" 'outline-cycle ;; New in Emacs 28!
   4403   "C-SPC" 'outline-mark-subtree
   4404   "n" 'outline-next-visible-heading
   4405   "p" 'outline-previous-visible-heading
   4406   "f" 'outline-forward-same-level
   4407   "b" 'outline-backward-same-level
   4408   "^" 'outline-move-subtree-up
   4409   "v" 'outline-move-subtree-down
   4410   "u" 'outline-up-heading
   4411   "+" 'outline-show-subtree
   4412   "-" 'outline-hide-subtree
   4413   ">" 'outline-demote
   4414   "<" 'outline-promote)
   4415 
   4416 (defvar-keymap embark-symbol-map
   4417   :doc "Keymap for Embark symbol actions."
   4418   :parent embark-identifier-map
   4419   "RET" #'embark-find-definition
   4420   "h" #'describe-symbol
   4421   "s" #'embark-info-lookup-symbol
   4422   "d" #'embark-find-definition
   4423   "e" #'pp-eval-expression
   4424   "a" #'apropos
   4425   "\\" #'embark-history-remove)
   4426 
   4427 (defvar-keymap embark-face-map
   4428   :doc "Keymap for Embark face actions."
   4429   :parent embark-symbol-map
   4430   "h" #'describe-face
   4431   "c" #'customize-face
   4432   "+" #'make-face-bold
   4433   "-" #'make-face-unbold
   4434   "/" #'make-face-italic
   4435   "|" #'make-face-unitalic
   4436   "!" #'invert-face
   4437   "f" #'set-face-foreground
   4438   "b" #'set-face-background)
   4439 
   4440 (defvar-keymap embark-variable-map
   4441   :doc "Keymap for Embark variable actions."
   4442   :parent embark-symbol-map
   4443   "=" #'set-variable
   4444   "c" #'customize-set-variable
   4445   "u" #'customize-variable
   4446   "v" #'embark-save-variable-value
   4447   "<" #'embark-insert-variable-value
   4448   "t" #'embark-toggle-variable)
   4449 
   4450 (defvar-keymap embark-function-map
   4451   :doc "Keymap for Embark function actions."
   4452   :parent embark-symbol-map
   4453   "m" #'elp-instrument-function ;; m=measure
   4454   "M" 'elp-restore-function ;; quoted, not autoloaded
   4455   "k" #'debug-on-entry ;; breaKpoint (running out of letters, really)
   4456   "K" #'cancel-debug-on-entry
   4457   "t" #'trace-function
   4458   "T" 'untrace-function) ;; quoted, not autoloaded
   4459 
   4460 (defvar-keymap embark-command-map
   4461   :doc "Keymap for Embark command actions."
   4462   :parent embark-function-map
   4463   "x" #'execute-extended-command
   4464   "I" #'Info-goto-emacs-command-node
   4465   "b" #'where-is
   4466   "g" #'global-set-key
   4467   "l" #'local-set-key)
   4468 
   4469 (defvar-keymap embark-package-map
   4470   :doc "Keymap for Embark package actions."
   4471   :parent embark-general-map
   4472   "RET" #'describe-package
   4473   "h" #'describe-package
   4474   "i" #'package-install
   4475   "I" #'embark-insert
   4476   "d" #'package-delete
   4477   "r" #'package-reinstall
   4478   "u" #'embark-browse-package-url
   4479   "W" #'embark-save-package-url
   4480   "a" #'package-autoremove
   4481   "g" #'package-refresh-contents
   4482   "m" #'elp-instrument-package ;; m=measure
   4483   "M" (if (fboundp 'embark-elp-restore-package)
   4484         'embark-elp-restore-package
   4485         'elp-restore-package))
   4486 
   4487 (defvar-keymap embark-bookmark-map
   4488   :doc "Keymap for Embark bookmark actions."
   4489   :parent embark-general-map
   4490   "RET" #'bookmark-jump
   4491   "s" #'bookmark-set
   4492   "d" #'bookmark-delete
   4493   "r" #'bookmark-rename
   4494   "R" #'bookmark-relocate
   4495   "l" #'bookmark-locate
   4496   "<" #'bookmark-insert
   4497   "j" #'bookmark-jump
   4498   "o" #'bookmark-jump-other-window
   4499   "f" #'bookmark-jump-other-frame
   4500   "a" 'bookmark-show-annotation
   4501   "e" 'bookmark-edit-annotation
   4502   "x" #'embark-bookmark-open-externally
   4503   "$" #'eshell)
   4504 
   4505 (defvar-keymap embark-unicode-name-map
   4506   :doc "Keymap for Embark Unicode name actions."
   4507   :parent embark-general-map
   4508   "RET" #'insert-char
   4509   "I" #'insert-char
   4510   "W" #'embark-save-unicode-character)
   4511 
   4512 (defvar-keymap embark-prose-map
   4513   :doc "Keymap for Embark actions for dealing with prose."
   4514   :parent embark-general-map
   4515   "$" #'ispell-region
   4516   "f" #'fill-region
   4517   "u" #'upcase-region
   4518   "l" #'downcase-region
   4519   "c" #'capitalize-region
   4520   "F" #'whitespace-cleanup-region
   4521   "=" #'count-words-region)
   4522 
   4523 (defvar-keymap embark-sentence-map
   4524   :doc "Keymap for Embark actions for dealing with sentences."
   4525   :parent embark-prose-map
   4526   "t" #'transpose-sentences
   4527   "n" #'forward-sentence
   4528   "p" #'backward-sentence)
   4529 
   4530 (defvar-keymap embark-paragraph-map
   4531   :doc "Keymap for Embark actions for dealing with paragraphs."
   4532   :parent embark-prose-map
   4533   "t" #'transpose-paragraphs
   4534   "n" #'forward-paragraph
   4535   "p" #'backward-paragraph
   4536   "R" #'repunctuate-sentences)
   4537 
   4538 (defvar-keymap embark-flymake-map
   4539   :doc "Keymap for Embark actions on Flymake diagnostics."
   4540   :parent embark-general-map
   4541   "RET" 'flymake-show-buffer-diagnostics
   4542   "n" 'flymake-goto-next-error
   4543   "p" 'flymake-goto-prev-error)
   4544 
   4545 (defvar-keymap embark-become-help-map
   4546   :doc "Keymap for Embark help actions."
   4547   :parent embark-meta-map
   4548   "V" #'apropos-variable
   4549   "U" #'apropos-user-option
   4550   "C" #'apropos-command
   4551   "v" #'describe-variable
   4552   "f" #'describe-function
   4553   "s" #'describe-symbol
   4554   "F" #'describe-face
   4555   "p" #'describe-package
   4556   "i" #'describe-input-method)
   4557 
   4558 (autoload 'recentf-open-files "recentf" nil t)
   4559 
   4560 (defvar-keymap embark-become-file+buffer-map
   4561   :doc "Embark become keymap for files and buffers."
   4562   :parent embark-meta-map
   4563   "f" #'find-file
   4564   "4 f" #'find-file-other-window
   4565   "." #'find-file-at-point
   4566   "p" #'project-find-file
   4567   "r" #'recentf-open-files
   4568   "b" #'switch-to-buffer
   4569   "4 b" #'switch-to-buffer-other-window
   4570   "l" #'locate
   4571   "L" #'find-library
   4572   "v" #'vc-dir)
   4573 
   4574 (defvar-keymap embark-become-shell-command-map
   4575   :doc "Embark become keymap for shell commands."
   4576   :parent embark-meta-map
   4577   "!" #'shell-command
   4578   "&" #'async-shell-command
   4579   "c" #'comint-run
   4580   "t" #'term)
   4581 
   4582 (defvar-keymap embark-become-match-map
   4583   :doc "Embark become keymap for search."
   4584   :parent embark-meta-map
   4585   "o" #'occur
   4586   "k" #'keep-lines
   4587   "f" #'flush-lines
   4588   "c" #'count-matches)
   4589 
   4590 (provide 'embark)
   4591 
   4592 ;; Check that embark-consult is installed. If Embark is used in
   4593 ;; combination with Consult, you should install the integration package,
   4594 ;; such that features like embark-export from consult-grep work as
   4595 ;; expected.
   4596 
   4597 (with-eval-after-load 'consult
   4598   (unless (require 'embark-consult nil 'noerror)
   4599     (warn "The package embark-consult should be installed if you use both Embark and Consult")))
   4600 
   4601 (with-eval-after-load 'org
   4602   (require 'embark-org))
   4603 
   4604 ;;; embark.el ends here