New commands for minibuffer history control

* lisp/minibuffer.el (minibuffer-alternate-history)
(minibuffer-kill-from-history): New commands.
(minibuffer-local-map): Bind them.
(minibuffer-hint-mode): Make interactive.
(minibuffer-action-history): New variable.
(minibuffer-set-completion-action): Use it, new command.
(minibuffer-local-completion-map): Bind them.
(minibuffer-apply): Use 'completion-identity', if present.
(read-history-variable-history): New variable.
(read-history-variable): Use it.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f4d7e2cdef73c839cf35b7e3bf33044fc252ddc3..f42a721887b34607c364ef4e9989793f73bf5520 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3436,7 +3436,8 @@ The completion method is determined by `completion-at-point-functions'."
 (let ((map minibuffer-local-map))
   (define-key map "\C-g" 'abort-minibuffers)
   (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)
@@ -3465,8 +3466,10 @@ 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-hint-mode
   "C-j"       #'minibuffer-apply
   "C-p"       #'minibuffer-previous-line-or-completion
   "C-n"       #'minibuffer-next-line-or-completion
@@ -4267,8 +4270,14 @@ possible completions."
     (with-current-buffer buf
       (save-excursion
         (goto-char (point-min))
-        (when-let ((pm (text-property-search-forward
-                        'completion--string input t)))
+        (when-let ((pm (or (and
+                            (get-text-property 0 'completion-identity input)
+                            (text-property-search-forward
+                             'completion-identity
+                             (get-text-property 0 'completion-identity input)
+                             #'eq))
+                           (text-property-search-forward
+                            'completion--string input t))))
           (goto-char (prop-match-beginning pm))
           (setq pm (text-property-search-forward 'cursor-face))
           (let ((inhibit-read-only t))
@@ -4314,6 +4323,23 @@ possible completions."
           (setq done t)
           (message "Done"))))))
 
+(defvar minibuffer-action-history nil
+  "History list for `minibuffer-set-completion-action'.")
+
+(defun minibuffer-set-completion-action (action-fn)
+  "Set minibuffer completion action 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
+              (cons action-fn
+                    (or (and (symbolp action-fn)
+                             (cdr (minibuffer--get-action action-fn)))
+                        "custom action"))))
+
 ;;; Old-style completion, used in Emacs-21 and Emacs-22.
 
 (defun completion-emacs21-try-completion (string table pred _point)
@@ -6143,7 +6169,7 @@ number of matching candidates in case there is more than one.  To exit
 the minibuffer with the candidate that the hint shows, use \
 \\<minibuffer-local-completion-map>\\[minibuffer-force-complete-and-exit].
 If there are no matching completion candidates, the hint tells you so."
-  :interactive nil
+  :interactive (minibuffer-mode)
   (if minibuffer-hint-mode
       (if (not minibuffer-completion-table)
           (setq minibuffer-hint-mode nil)
@@ -6177,5 +6203,89 @@ If there are no matching completion candidates, the hint tells you so."
 ;;                   (put-text-property (point-min) (point) prop val)))
 ;;     (goto-char (- (point-max) tniop))))
 
+(defvar read-history-variable-history nil
+  "History list for `read-history-variable-history'.")
+
+(defun read-history-variable (prompt)
+  "Prompt with PROMPT for a history variable and return its name as a string."
+  (completing-read prompt obarray
+                   (lambda (s)
+                     (and (boundp s)
+                          (consp (symbol-value s))
+                          (stringp (car (symbol-value s)))
+                          (string-match "-\\(history\\|ring\\)\\'"
+                                        (symbol-name s))))
+                   t nil 'read-history-variable-history))
+
+(defun minibuffer-alternate-history (hist-var)
+  "Set history variable of current minibuffer to HIST-VAR."
+  (interactive (let ((enable-recursive-minibuffers t))
+                 (list (read-history-variable "Use history variable: ")))
+               minibuffer-mode)
+  ;; TODO: Make `minibuffer-history-variable' (mini)buffer-local.
+  (setq minibuffer-history-variable (if (stringp hist-var)
+                                        (intern hist-var)
+                                      hist-var)))
+
+(defun minibuffer-kill-from-history (input)
+  "Remove INPUT from current minibuffer history."
+  (interactive
+   (if (eq minibuffer-history-variable t)
+       (user-error "No history available")
+     (list
+      (let ((enable-recursive-minibuffers t))
+        (minibuffer-with-setup-hook
+            (lambda ()
+              (setq-local history-add-new-input nil
+                          ;; All candidates are previous inputs by
+                          ;; definition, so no need to highlight them.
+                          completions-highlight-previous-inputs nil))
+          (completing-read
+           "Delete from history: "
+           (completion-table-dynamic
+            (lambda (&rest _)
+              (mapcar
+               (lambda (cand)
+                 (if (and (stringp cand) (not (string-empty-p cand)))
+                     (propertize cand 'completion-identity cand)
+                   cand))
+               (symbol-value minibuffer-history-variable))))
+           nil t nil
+           ;; HACK: Use the history variable of the original minibuffer
+           ;; also in the recursive minibuffer s.t. `minibuffer-apply' in
+           ;; the recursive minibuffer deletes from the original history.
+           minibuffer-history-variable)))))
+   minibuffer-mode)
+  (if (eq minibuffer-history-variable t) (error "No history available")
+    (let* ((hist (cons nil (symbol-value minibuffer-history-variable)))
+           (temp hist)
+           (res nil))
+      ;; First check with `eq' in favor of `minibuffer-apply' on a
+      ;; non-first occurrence of a history entry.
+      (while (and temp (not res))
+        (if (not (eq (get-text-property 0 'completion-identity input)
+                     (cadr temp)))
+            (setq temp (cdr temp))
+          ;; It's a match, delete it.
+          (setcdr temp (cddr temp))
+          (setq res t)))
+      ;; If `res' is still nil that means we found nothing when
+      ;; comparing with `eq', so try again with `equal'.
+      (setq temp hist)
+      (while (and temp (not res))
+        (if (not (equal input (cadr temp)))
+            (setq temp (cdr temp))
+          (setcdr temp (cddr temp))
+          (setq res t)))
+      (if res
+          (progn
+            (set minibuffer-history-variable (cdr hist))
+            (message "Deleted \"%s\" from history `%s'"
+                     input minibuffer-history-variable))
+        (message "Input \"%s\" not in history `%s'"
+                 input minibuffer-history-variable)))))
+
+(put 'minibuffer-kill-from-history 'minibuffer-action "delete")
+
 (provide 'minibuffer)
 ;;; minibuffer.el ends here