Skip to content

Commit

Permalink
Implement multiple targets at point (Fix oantolin#92)
Browse files Browse the repository at this point in the history
When not acting in the minibuffer all target finders are executed. The action
indicator will then indicate that multiple targets exist. By pressing the
`embark-act` key again, the user can cycle to the next target.

The alternative approach discussed in oantolin#92 was to merge the keymaps. This
approach has disadvantages: Multiple targets are active at the same time and
depending on the selected action, the target is selected. This complicates the
current `embark--act` implementation, which is untouched by this PR. Furthermore
keybindings are shadowed, which makes the individual keymaps a lot less useful.
This shadowing will lead to confusion and it will not be obvious to the user
which target is actually being used.

The current approach is also easy to implement, it fits well within the existing
codebase. This is a good indication to go this route.
  • Loading branch information
minad committed Jul 24, 2021
1 parent bf98556 commit 1e8864d
Showing 1 changed file with 125 additions and 63 deletions.
188 changes: 125 additions & 63 deletions embark.el
Original file line number Diff line number Diff line change
Expand Up @@ -192,6 +192,16 @@ prompts for an action with completion."
(defcustom embark-keymap-prompter-key "@"
"Key to switch to the keymap prompter from `embark-completing-read-prompter'.
The key must be either a string or a vector.
This is the key representation accepted by `define-key'."
:type '(choice key-sequence (const nil)))

(defcustom embark-cycle-key nil
"Key used for `embark-cycle'.
If the key is set to nil it defaults to the global binding of
`embark-act'.
The key must be either a string or a vector.
This is the key representation accepted by `define-key'."
:type '(choice key-sequence (const nil)))
Expand All @@ -202,7 +212,9 @@ Used by `embark-completing-read-prompter' and `embark-keymap-help'.")

(defcustom embark-action-indicator
(let ((act (propertize "Act" 'face 'highlight)))
(cons act (concat act " on %2$s '%1$s'")))
(cons act (concat act " on %2$s"
(propertize "%3$s" 'face 'shadow)
" '%1$s'")))
"Indicator to use when embarking upon an action.
If set to a string it is used as a format string where %1$s will
be replaced by the target of `embark-act' and %2$s will be
Expand Down Expand Up @@ -603,46 +615,61 @@ relative path."
(abbreviate-file-name (expand-file-name raw))
raw)))))))

(defun embark--action-keymap (type)
"Return action keymap for targets of given TYPE."
(defun embark--action-keymap (type cycle)
"Return action keymap for targets of given TYPE.
If CYCLE is non-nil bind `embark-cycle'."
(make-composed-keymap
`(keymap (13 . ,(embark--default-action type)))
(let ((map (make-sparse-keymap)))
(define-key map [13] (embark--default-action type))
(when cycle
(define-key map
(or embark-cycle-key
(car (where-is-internal #'embark-act)))
#'embark-cycle))
map)
(symbol-value (or (alist-get type embark-keymap-alist)
(alist-get t embark-keymap-alist)))))

(defun embark--show-indicator (indicator keymap target type)
(defun embark--show-indicator (indicator keymap targets)
"Show INDICATOR for a pending action or a instance of becoming.
If INDICATOR is a string it is used as a format string, %1$s is
replaced by the target and %2$s by the TYPE of the target. If the
minibuffer is active, the formatted string is put in an overlay
in the minibuffer prompt. If the minibuffer is inactive, then the
formatted string is shown in the echo area and returned.
replaced by the first target and %2$s by its type. Furthermore if
additional shadowed TARGETS exist, %3$s is replaced by their types.
If the minibuffer is active, the formatted string is put in an
overlay in the minibuffer prompt. If the minibuffer is inactive,
then the formatted string is shown in the echo area and returned.
If INDICATOR is a cons of two strings, they are used as format
strings as described above: if the minibuffer is active the first
string is used and if not, the second is used.
Finally, if INDICATOR is a function, this function is called with
the KEYMAP, TARGET and TYPE. The function should return either
nil, or a function to be called when the indicator is no longer
needed."
the :keymap KEYMAP and :targets TARGETS keyword arguments. The
function should return either nil, or a function to be called when
the indicator is no longer needed."
(cond
((functionp indicator)
(condition-case nil
(funcall indicator keymap target type)
(funcall indicator :keymap keymap :targets targets)
(wrong-number-of-arguments
(message "Embark: The action indicator takes three arguments, KEYMAP, TARGET and TYPE.")
(funcall indicator keymap target))))
(message "Embark: The new action indicator takes keyword arguments.")
(funcall indicator keymap (cdar targets)))))
((or (stringp indicator) (consp indicator))
(unless (stringp target)
(setq target (format "%s" target)))
(when-let (pos (string-match-p "\n" target))
(setq target (concat (substring target 0 pos) "")))
(let* ((mini (active-minibuffer-window))
(ind (format (if (consp indicator)
(pcase-let ((`((,type . ,target) . _) targets)
(mini (active-minibuffer-window))
(ind nil))
(unless (stringp target)
(setq target (format "%s" target)))
(when-let (pos (string-match-p "\n" target))
(setq target (concat (substring target 0 pos) "")))
(setq ind (format (if (consp indicator)
(if mini (car indicator) (cdr indicator))
indicator)
target type)))
target
type
(if (cdr targets)
(format "%S" (mapcar #'car (cdr targets)))
"")))
(if mini
(let ((indicator-overlay
(make-overlay (point-min) (point-min)
Expand Down Expand Up @@ -730,6 +757,15 @@ If NO-DEFAULT is t, no default value is passed to `completing-read'."
(use-local-map
(make-composed-keymap
(let ((map (make-sparse-keymap)))
;; Rebind `embark-cycle' in order allow cycling
;; from the `completing-read' prompter. Additionally
;; `embark-cycle' can be selected via
;; `completing-read'. The downside is that this breaks
;; recursively acting on the candidates of type
;; embark-keybinding in the `completing-read' prompter.
(when-let (key (where-is-internal
#'embark-cycle keymap))
(define-key map (car key) #'embark-cycle))
(define-key map embark-keymap-prompter-key
(lambda ()
(interactive)
Expand Down Expand Up @@ -792,10 +828,10 @@ be restricted by passing a PREFIX key."
(when-let (command (embark-completing-read-prompter keymap 'no-default))
(call-interactively command))))

(defun embark--with-indicator (indicator prompter keymap target type)
(defun embark--with-indicator (indicator prompter keymap targets)
"Display INDICATOR while calling PROMPTER with KEYMAP.
The TARGET of TYPE is displayed for actions outside the minibuffer."
(let* ((remove-indicator (embark--show-indicator indicator keymap target type))
The TARGETS are displayed for actions outside the minibuffer."
(let* ((remove-indicator (embark--show-indicator indicator keymap targets))
(cmd (condition-case nil
(minibuffer-with-setup-hook
;; if the prompter opens its own minibuffer, show
Expand All @@ -809,7 +845,7 @@ The TARGET of TYPE is displayed for actions outside the minibuffer."
(embark--show-indicator (if (stringp remove-indicator)
remove-indicator
indicator)
keymap target type))
keymap targets))
(let ((enable-recursive-minibuffers t))
(funcall prompter keymap)))
(quit nil))))
Expand Down Expand Up @@ -941,27 +977,41 @@ work on them."
(expand-file-name target root)
target)))

(defun embark--target ()
(defun embark--targets ()
"Retrieve current target.
An initial guess at the current target and its type is determined
by running the functions in `emark-target-finders' until one
returns a non-nil result. Each function should either a pair of
a type symbol and a target string, or nil.
The initial type is then looked up as a key in the variable
`embark-transformer-alist'. If there is a transformer for the
type, it is called with the initial target, and must return a
`cons' of the transformed type and target.
The return value is 3-element list of the possibly transformed
type, the possibly transformed target and the original target."
(pcase (run-hook-with-args-until-success 'embark-target-finders)
(`(,type . ,target)
(if-let (transformer (alist-get type embark-transformer-alist))
(pcase-let ((`(,new-type . ,new-target) (funcall transformer target)))
(list new-type new-target target))
(list type target target)))))
by running the functions in `emark-target-finders'. Each function
should either return a pair of a type symbol and a target string,
or nil.
When run in the minibuffer the first target finder returning
non-nil is taken into account. When finding targets at point,
each target finder function is executed.
For each returned target, the initial type is then looked up as a
key in the variable `embark-transformer-alist'. If there is a
transformer for the type, it is called with the initial target,
and must return a `cons' of the transformed type and target.
The return value is a list of pairs, where each car is
transformed type and target and each cdr is the original type and
target."
(let ((targets))
(run-hook-wrapped
'embark-target-finders
(lambda (fun)
(when-let (target (funcall fun))
(push target targets)
(minibufferp))))
(mapcar
(lambda (orig)
(cons
(if-let (transformer (alist-get (car orig) embark-transformer-alist))
(funcall transformer (cdr orig))
orig)
orig))
(nreverse targets))))

(defun embark--default-action (type)
"Return default action for the given TYPE of target.
Expand Down Expand Up @@ -1000,20 +1050,31 @@ whether calling `embark-act' with nil ARG quits the minibuffer,
and if ARG is non-nil it will do the opposite. Interactively,
ARG is the prefix argument."
(interactive "P")
(pcase-let* ((`(,type ,target ,original) (or (embark--target)
(user-error "No target found")))
(action (or (embark--with-indicator embark-action-indicator
embark-prompter
(embark--action-keymap type)
target type)
(user-error "Canceled")))
(default-action (embark--default-action type)))
(embark--act action
(if (and (eq action default-action)
(eq action embark--command))
original
target)
(if embark-quit-after-action (not arg) arg))))
(let ((targets (or (embark--targets) (user-error "No target found"))))
(while
(and
(catch 'embark--cycle
(pcase-let* ((`((,type . ,target) . (,_ . ,original)) (car targets))
(action (or (embark--with-indicator embark-action-indicator
embark-prompter
(embark--action-keymap
type (cdr targets))
(mapcar #'car targets))
(user-error "Canceled")))
(default-action (embark--default-action type)))
(embark--act action
(if (and (eq action default-action)
(eq action embark--command))
original
target)
(if embark-quit-after-action (not arg) arg)))
nil)
(setq targets (append (cdr targets) (list (car targets))))))))

(defun embark-cycle ()
"Cycle to the next target at point."
(interactive)
(throw 'embark--cycle t))

;;;###autoload
(defun embark-dwim (&optional arg)
Expand All @@ -1032,8 +1093,8 @@ keymap for the target's type.
See `embark-act' for the meaning of the prefix ARG."
(interactive "P")
(pcase-let* ((`(,type ,target ,original)
(or (embark--target) (user-error "No target found")))
(pcase-let* ((`((,type . ,target) . (,_ . ,original))
(or (car (embark--targets)) (user-error "No target found")))
(default-action (embark--default-action type)))
(embark--act default-action
(if (eq default-action embark--command)
Expand Down Expand Up @@ -1083,7 +1144,8 @@ point."
(become (embark--with-indicator embark-become-indicator
embark-prompter
(embark--become-keymap)
target nil)))
;; Pass a fake target list here
`((nil . ,target)))))
(if (null become)
(user-error "Canceled")
(embark--quit-and-run
Expand Down Expand Up @@ -1308,7 +1370,7 @@ Returns the name of the command."
(embark--command-name action)))))
(fset name (lambda ()
(interactive)
(embark--act action (cadr (embark--target)))))
(embark--act action (cdaar (embark--targets)))))
(put name 'function-documentation (documentation action))
name))

Expand Down Expand Up @@ -1340,7 +1402,7 @@ Returns the name of the command."
(let ((map embark-collect-direct-action-minor-mode-map))
(setcdr map nil)
(cl-loop for (key . cmd) in (embark--all-bindings
(embark--action-keymap embark--type))
(embark--action-keymap embark--type nil))
unless (eq cmd 'embark-keymap-help)
do (define-key map key (embark--action-command cmd))))))

Expand Down

0 comments on commit 1e8864d

Please sign in to comment.