Generalize minibuffer-action/apply to non-completion minibuffers

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 5176e86c84e69ab83cd34ff139cae734134de794..425497674cb191d2e55af897d5120fb95f845fb4 100644 (file)
--- 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 dde68ca614a00ebb14b55fede06a967375acf82b..3e46a6522b4424dda0e3c63f435e5ffc3aafa7ee 100644 (file)
--- 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 bcb8a2d9ecacbe153f59144ab1880cafd46f6ded..b8c7d59760ce7b555b8e44309b9b1dfde55397e8 100644 (file)
--- 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 6c09aecdeed9df24d12c4bb4970eadccd0abcebe..aaf6a8065a849c9c701635c187542a98a7baf70e 100644 (file)
--- 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-local-map>\\[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 1af9666e5a4cf00941d856f116f7bb0ee057726f..99e46130977577ce9c52a8589c7af0dfddebb63a 100644 (file)
--- 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 d49aa7d2ee8f9c25688f00aadd62d339daa0cace..6dfe6723aec04a93efaf0cb5067b273f6e2e3d3f 100644 (file)
--- 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.