diff options
Diffstat (limited to 'embark.el')
-rw-r--r-- | embark.el | 59 |
1 files changed, 35 insertions, 24 deletions
@@ -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. |