summaryrefslogtreecommitdiff
path: root/embark.el
diff options
context:
space:
mode:
Diffstat (limited to 'embark.el')
-rw-r--r--embark.el59
1 files changed, 35 insertions, 24 deletions
diff --git a/embark.el b/embark.el
index acaeb9e..bc35629 100644
--- a/embark.el
+++ b/embark.el
@@ -1983,7 +1983,8 @@ arguments are passed to the hooks as keyword arguments."
(mapc (lambda (h) (apply h :action action :quit quit target))
(alist-get :always hooks)))
-(defun embark--run-around-action-hooks (action target quit)
+(defun embark--run-around-action-hooks
+ (action target quit &optional non-interactive)
"Run the `embark-around-action-hooks' for ACTION.
All the applicable around hooks are composed in the order they
are present in `embark-around-action-hooks'. The keys t and
@@ -1991,7 +1992,11 @@ are present in `embark-around-action-hooks'. The keys t and
The :always hooks are executed always (outermost) and the t hooks
are the default hooks, for when there are no command-specific
hooks for ACTION. The QUIT, ACTION and TARGET arguments are
-passed to the hooks as keyword arguments."
+passed to the hooks as keyword arguments.
+
+The optional argument NON-INTERACTIVE controls whether the action
+is run with `command-execute' or with `funcall' passing the
+target as argument."
(apply
(seq-reduce
(lambda (fn hook)
@@ -2000,8 +2005,12 @@ passed to the hooks as keyword arguments."
(reverse
(append (or (alist-get action hooks) (alist-get t hooks))
(alist-get :always hooks))))
- (lambda (&rest args)
- (command-execute (plist-get args :action))))
+ (if non-interactive
+ (lambda (&rest args)
+ (funcall (plist-get args :action)
+ (or (plist-get args :candidates) (plist-get args :target))))
+ (lambda (&rest args)
+ (command-execute (plist-get args :action)))))
:action action :quit quit target))
(defun embark--act (action target &optional quit)
@@ -2076,12 +2085,11 @@ minibuffer before executing the action."
(when dedicate (set-window-dedicated-p dedicate nil)))
(unless (eq final-window action-window)
(select-window final-window))))
- ;; TODO uniformize the command and non-interactive cases?
- (let ((argument
- (if multi
- (or (plist-get target :candidates) ; embark-act-all
- (list (plist-get target :target)))
- (plist-get target :target))))
+ (let ((target
+ (if (and multi (null (plist-get target :candidates)))
+ (plist-put
+ target :candidates (list (plist-get target :target)))
+ target)))
(lambda ()
(with-selected-window action-window
(embark--run-action-hooks embark-pre-action-hooks
@@ -2089,7 +2097,8 @@ minibuffer before executing the action."
(unwind-protect
(let ((current-prefix-arg prefix)
(default-directory directory))
- (funcall action argument))
+ (embark--run-around-action-hooks
+ action target quit :non-interactive))
(embark--run-action-hooks embark-post-action-hooks
action target quit))))))))
(setq prefix-arg nil)
@@ -4089,23 +4098,25 @@ the REST of the arguments."
(unless (y-or-n-p (format "Run %s on %s? " action target))
(user-error "Canceled")))
+(defconst embark--associated-file-fn-alist
+ `((file . identity)
+ (buffer . ,(lambda (target)
+ (let ((buffer (get-buffer target)))
+ (or (buffer-file-name buffer)
+ (buffer-local-value 'default-directory buffer)))))
+ (bookmark . bookmark-location)
+ (library . locate-library))
+ "Alist of functions that extract a file path from targets of a given type.")
+
(defun embark--associated-directory (target type)
"Return directory associated to TARGET of given TYPE.
The supported values of TYPE are file, buffer, bookmark and
library, which have an obvious notion of associated directory."
- (setq target (pcase type
- ('file
- target)
- ('buffer
- (buffer-local-value 'default-directory (get-buffer target)))
- ('bookmark
- (bookmark-prop-get target 'filename))
- ('library
- (locate-library target))))
- (when target
- (if (file-directory-p target)
- (file-name-as-directory target)
- (file-name-directory target))))
+ (when-let ((file-fn (alist-get type embark--associated-file-fn-alist))
+ (file (funcall file-fn target)))
+ (if (file-directory-p file)
+ (file-name-as-directory file)
+ (file-name-directory file))))
(cl-defun embark--cd (&rest rest &key run target type &allow-other-keys)
"Run action with `default-directory' set to the directory of TARGET.