From: Eshel Yaron Date: Tue, 18 Jun 2024 17:05:51 +0000 (+0200) Subject: Generalize minibuffer-action/apply to non-completion minibuffers X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=17eaffc4e2494c89a91ca49845be8ed27baffc98;p=emacs.git Generalize minibuffer-action/apply to non-completion minibuffers --- diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5176e86c84e..425497674cb 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1126,10 +1126,8 @@ was specified to run but remapped into another command. @end defvar @defvar current-minibuffer-command -This has the same value as @code{this-command}, but is bound -recursively when entering a minibuffer. This variable can be used -from minibuffer hooks and the like to determine what command opened -the current minibuffer session. +This is a buffer-local variable that is bound in minibuffers to the +command that invoked the minibuffer. @end defvar @defun this-command-keys diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index dde68ca614a..3e46a6522b4 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -681,7 +681,7 @@ otherwise uses `variable-at-point'." (enable-recursive-minibuffers t)) (list (intern (minibuffer-with-setup-hook - (lambda () (setq minibuffer-completion-action + (lambda () (setq minibuffer-action (cons (lambda (s) (save-selected-window (funcall action (intern s)))) diff --git a/lisp/help.el b/lisp/help.el index bcb8a2d9eca..b8c7d59760c 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -614,7 +614,7 @@ a minor mode." help--sort-by-command-name "command name") minibuffer-completions-sort-orders) - minibuffer-completion-action + minibuffer-action (cons (lambda (cand) (let* ((eb (split-string cand " +→ ")) (e (key-parse (car eb))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6c09aecdeed..aaf6a8065a8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2907,7 +2907,7 @@ completions list." (sort-orders minibuffer-completions-sort-orders) (cpred minibuffer-completion-predicate) (ctable minibuffer-completion-table) - (action (minibuffer-completion-action))) + (action (minibuffer-action))) (when last (setcdr last nil)) @@ -3446,9 +3446,8 @@ The completion method is determined by `completion-at-point-functions'." (define-key map "\M-<" 'minibuffer-beginning-of-buffer) (define-key map "\C-x\M-k" 'minibuffer-kill-from-history) (define-key map "\C-x\M-h" 'minibuffer-alternate-history) - ;; Put RET last so that it is shown in doc strings in preference to - ;; C-j, when using the \\[exit-minibuffer] notation. - (define-key map "\n" 'exit-minibuffer) + (define-key map "\C-xj" 'minibuffer-set-action) + (define-key map "\n" 'minibuffer-apply) (define-key map "\r" 'exit-minibuffer)) (defvar-keymap minibuffer-local-completion-map @@ -3475,11 +3474,9 @@ The completion method is determined by `completion-at-point-functions'." "C-x C->" #'minibuffer-last-completion "C-x n" 'minibuffer-narrow-completions-map "C-x /" #'minibuffer-set-completion-styles - "C-x j" #'minibuffer-set-completion-action "C-x ~" #'minibuffer-toggle-exceptional-candidates "C-x C-a" #'minibuffer-toggle-completions-annotations "C-x C-." #'minibuffer-auto-completion-mode - "C-j" #'minibuffer-apply "C-p" #'minibuffer-previous-line-or-completion "C-n" #'minibuffer-next-line-or-completion "C-%" #'minibuffer-query-apply) @@ -4231,10 +4228,7 @@ possible completions." (define-obsolete-function-alias 'internal-complete-buffer 'completion-buffer-name-table "30.1") -(defvar-local minibuffer-completion-action nil) - -(defvar-local minibuffer-completion-command nil - "The command currently reading input from the minibuffer.") +(defvar-local minibuffer-action nil) (defun minibuffer-current-input () (let* ((beg-end (minibuffer--completion-boundaries)) @@ -4256,12 +4250,49 @@ possible completions." ((symbolp action) (minibuffer--get-action action)) (t (cons symbol action))))) -(defun minibuffer-completion-action () - "Return the completion action function for the current minibuffer." - (or minibuffer-completion-action - (and minibuffer-completion-command - (symbolp minibuffer-completion-command) - (minibuffer--get-action minibuffer-completion-command)))) +(defvar-local current-minibuffer-command nil + "Command that invoked the current minibuffer.") + +(defun minibuffer-record-command () + (setq-local current-minibuffer-command this-command)) + +(defvar-local minibuffer-prompt-indications-overlay nil) + +(defun minibuffer-update-prompt-indications () + (let ((cmp minibuffer-completion-table) + (act (minibuffer-action))) + (if (not (or cmp act)) + (when (overlayp minibuffer-prompt-indications-overlay) + (delete-overlay minibuffer-prompt-indications-overlay) + (setq-local minibuffer-prompt-indications-overlay nil)) + (unless (overlayp minibuffer-prompt-indications-overlay) + (setq-local minibuffer-prompt-indications-overlay + (make-overlay (point-min) (point-min)))) + (overlay-put + minibuffer-prompt-indications-overlay 'before-string + ;; TODO: Make indicators clickable, and indicate strictness. + (apply #'propertize + (concat + (when-let ((desc (cdr (minibuffer-action)))) + (propertize "<" 'help-echo + (concat + "mouse-2, \\\\[minibuffer-apply]: " + desc))) + (when minibuffer-completion-table + (propertize ">" 'help-echo "Completion available")) + " ") + (append minibuffer-prompt-properties + (list 'front-sticky t 'rear-nonsticky t 'field t))))))) + +(add-hook 'minibuffer-setup-hook #'minibuffer-record-command) +(add-hook 'minibuffer-setup-hook #'minibuffer-update-prompt-indications 95) + +(defun minibuffer-action () + "Return the minibuffer action function for the current minibuffer." + (or minibuffer-action + (when-let* ((cmd current-minibuffer-command) + (cmd (car (last (cons cmd (function-alias-p cmd)))))) + (when (symbolp cmd) (minibuffer--get-action cmd))))) (defun minibuffer-apply (input &optional prefix) "Apply ACTION to current minibuffer INPUT prefixed by PREFIX." @@ -4271,8 +4302,7 @@ possible completions." (list input prefix)) minibuffer-mode) (funcall - (or (car (minibuffer-completion-action)) - (user-error "No applicable action")) + (or (car (minibuffer-action)) (user-error "No applicable action")) (concat prefix input)) (when-let ((buf (get-buffer completions-buffer-name)) (win (get-buffer-window buf 0))) @@ -4333,21 +4363,22 @@ possible completions." (message "Done")))))) (defvar minibuffer-action-history nil - "History list for `minibuffer-set-completion-action'.") + "History list for `minibuffer-set-action'.") -(defun minibuffer-set-completion-action (action-fn) - "Set minibuffer completion action of current minibuffer to ACTION-FN." +(defun minibuffer-set-action (action-fn) + "Set minibuffer action function of current minibuffer to ACTION-FN." (interactive (let ((enable-recursive-minibuffers t)) (list (completing-read "Action function: " obarray #'fboundp nil nil 'minibuffer-action-history))) minibuffer-mode) (when (stringp action-fn) (setq action-fn (read action-fn))) - (setq-local minibuffer-completion-action + (setq-local minibuffer-action (cons action-fn (or (and (symbolp action-fn) (cdr (minibuffer--get-action action-fn))) - "custom action")))) + "custom action"))) + (minibuffer-update-prompt-indications)) ;;; Old-style completion, used in Emacs-21 and Emacs-22. @@ -5333,9 +5364,6 @@ See `completing-read' for the meaning of the arguments." (number-to-string md)))) (?{ . ,(if (< 1 (minibuffer-depth)) "<" "")) (?} . ,(if (< 1 (minibuffer-depth)) ">" ""))))) - (setq-local minibuffer-completion-command - (car (last (cons this-command - (function-alias-p this-command))))) (setq-local minibuffer-completion-table collection) (setq-local minibuffer-completion-predicate predicate) ;; FIXME: Remove/rename this var, see the next one. diff --git a/src/callint.c b/src/callint.c index 1af9666e5a4..99e46130977 100644 --- a/src/callint.c +++ b/src/callint.c @@ -280,11 +280,6 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object save_real_this_command = Vreal_this_command; Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command); - /* Bound recursively so that code can check the current command from - code running from minibuffer hooks (and the like), without being - overwritten by subsequent minibuffer calls. */ - specbind (Qcurrent_minibuffer_command, Vthis_command); - if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; else diff --git a/src/keyboard.c b/src/keyboard.c index d49aa7d2ee8..6dfe6723aec 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -13220,13 +13220,6 @@ will be in `last-command' during the following command. */); doc: /* This is like `this-command', except that commands should never modify it. */); Vreal_this_command = Qnil; - DEFSYM (Qcurrent_minibuffer_command, "current-minibuffer-command"); - DEFVAR_LISP ("current-minibuffer-command", Vcurrent_minibuffer_command, - doc: /* This is like `this-command', but bound recursively. -Code running from (for instance) a minibuffer hook can check this variable -to see what command invoked the current minibuffer. */); - Vcurrent_minibuffer_command = Qnil; - DEFVAR_LISP ("this-command-keys-shift-translated", Vthis_command_keys_shift_translated, doc: /* Non-nil if the key sequence activating this command was shift-translated.