feature/minibuffer-completion-enhancements ca72ed2f7a7 15/35: New command 'minibuffer-set-completion-styles'

[Eshel Yaron]

branch: feature/minibuffer-completion-enhancements
commit ca72ed2f7a773fe41f6eab19bb3eabc56be35cbc
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    New command 'minibuffer-set-completion-styles'
    
    Add an interactive command for setting completion styles in the
    current minibuffer.
    
    * lisp/minibuffer.el (completion-style)
    (completion--matching-style, completion-local-styles): New vars.
    (completion--styles): Use 'completion-local-styles' when it's non-nil.
    (completion--nth-completion): Set 'completion--matching-style' to the
    matching completion style.
    (completion-styles-affixation, completion-styles-table): New funs.
    (minibuffer-set-completion-styles): New command.
    (minibuffer-local-completion-map): Bind it.
    (minibuffer-completion-help): Set 'completion-style' in the
    "*Completions*" buffer.
    * lisp/simple.el (completion-setup-function): Keep 'completion-style'.
    (completion-list-mode): Display 'completion-style' in mode line.
    
    * doc/emacs/mini.texi (Completion Commands, Completion Styles):
    Document new command.
    
    * doc/lispref/minibuf.texi (Completion Commands)
    (Completion Variables): Document new command and variable.
    
    * etc/NEWS: Announce new command.
---
 doc/emacs/mini.texi      |  46 ++++++++++++++++--
 doc/lispref/minibuf.texi |  19 ++++++++
 etc/NEWS                 |   7 +++
 lisp/minibuffer.el       | 121 ++++++++++++++++++++++++++++++++++++++++++-----
 lisp/simple.el           |  15 +++++-
 5 files changed, 192 insertions(+), 16 deletions(-)

diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index d8d57c25007..fea9adc9caf 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -353,6 +353,8 @@ arguments that often include spaces, such as file names.
 @item @key{RET}
 Submit the text in the minibuffer as the argument, possibly completing
 first (@code{minibuffer-complete-and-exit}).  @xref{Completion Exit}.
+@item ?
+Display a list of completions (@code{minibuffer-completion-help}).
 @item C-x C-v
 Change the order of the list of possible completions
 (@code{minibuffer-sort-completions}).
@@ -366,8 +368,9 @@ Narrow the list of possible completions in a 
command-specific manner
 @item C-x n w
 Remove restrictions on the list of possible completions
 (@code{minibuffer-widen-completions}).
-@item ?
-Display a list of completions (@code{minibuffer-completion-help}).
+@item C-x /
+Change or reorder completion styles for the current minibuffer
+(@code{minibuffer-set-completion-styles}).
 @end table
 
 @kindex TAB @r{(completion)}
@@ -429,6 +432,21 @@ If you invoke this command with a prefix argument 
(@kbd{C-u C-x n w}),
 it removes all restrictions without prompting, regardless of how many
 there are.
 
+@kindex C-x / @r{(completion)}
+@findex minibuffer-set-completion-styles
+  @kbd{C-x /} (minibuffer-set-completion-styles) lets you set the
+completion styles for the current minibuffer.  @xref{Completion
+Styles}.  This command prompts you for a list of completion styles,
+and sets that list as the effective completion styles for following
+completion operations in the current minibuffer.  With a plain prefix
+argument (@kbd{C-u C-x /}), it instead discards all changes that you
+made to the current completion styles.  With a zero numeric prefix
+argument (@kbd{C-0 C-x /}), it keeps all current completion styles
+except the style that produced that current completions list.
+Conversely, a numeric prefix argument of one (@kbd{C-1 C-x /}) says to
+keep only the completion style that produced the current completions
+list, disabling other completion styles for the current minibuffer.
+
 @kindex ? @r{(completion)}
 @cindex completion list
   If @key{TAB} or @key{SPC} is unable to complete, it displays a list
@@ -585,7 +603,12 @@ styles}---sets of criteria for matching minibuffer text to 
completion
 alternatives.  During completion, Emacs tries each completion style in
 turn.  If a style yields one or more matches, that is used as the list
 of completion alternatives.  If a style produces no matches, Emacs
-falls back on the next style.
+falls back on the next style.  The mode line of the
+@file{*Completions*} buffer indicates which completion style produced
+the listed completion candidates, by showing the name of that style.
+(For example, the mode line says @samp{Completions[basic]} when the
+@code{basic} completion style is in effect.)  You can hover over the
+mode line style indicator with the mouse to see its full description.
 
 @vindex completion-styles
   The list variable @code{completion-styles} specifies the completion
@@ -664,6 +687,23 @@ by setting the variable 
@code{completion-category-overrides}.
 For example, the default setting says to use only @code{basic}
 and @code{substring} completion for buffer names.
 
+  You can also set the completion styles interactively for the current
+minibuffer invocation, temporarily overriding the completion styles
+that @code{completion-styles} and the completion category prescribe.
+To do that, type @kbd{C-x /} in the minibuffer---this invokes command
+@code{minibuffer-set-completion-styles}, which prompts you for a list
+of completion styles and sets that list as the effective completion
+styles for following completion operations in the current minibuffer.
+With a plain prefix argument (@kbd{C-u C-x /}), this command instead
+discards all changes that you made to the current completion styles.
+With a zero numeric prefix argument (@kbd{C-0 C-x /}), this command
+keeps all current completion styles except the style that produced
+that current completions list---use this if a completion style yields
+a @file{*Completions*} buffer that is not what you're looking for.
+Conversely, a numeric prefix argument of one (@kbd{C-1 C-x /}) says to
+keep only the completion style that produced the current completions
+list, disabling other completion styles for the current minibuffer.
+
 @node Narrow Completions
 @subsection Completions Narrowing
 
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 0c0365ca74c..bd62c473f61 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1408,6 +1408,12 @@ possible completions to only include candidates that 
match the current
 minibuffer input.
 @end deffn
 
+@deffn Command minibuffer-set-completion-styles
+This function changes the effective list of completion styles for the
+current minibuffer.  It works by setting the local value of
+@code{completion-local-styles}.  @xref{Completion Variables}.
+@end deffn
+
 @defun display-completion-list completions
 This function displays @var{completions} to the stream in
 @code{standard-output}, usually a buffer.  (@xref{Read and Print}, for more
@@ -1456,6 +1462,9 @@ keymap makes the following bindings:
 
 @item C-x n
 @code{minibuffer-narrow-completions-map}
+
+@item C-x /
+@code{minibuffer-set-completion-styles}
 @end table
 
 @noindent
@@ -2012,6 +2021,16 @@ The function to add prefixes and suffixes to completions.
 See @ref{Programmed Completion}, for a complete list of metadata entries.
 @end defopt
 
+@defvar completion-local-styles
+The value of this variable is a list of completion styles, just like
+@code{completion-styles}.  By default, this variable is set to
+@code{nil}, in which case it has no effect.  The command
+@code{minibuffer-set-completion-styles} sets the local value of this
+variable in the minibuffer---when it sets this variable to a
+non-@code{nil} list of completion styles, this variable takes
+precedence over @code{completion-styles} and the completion category.
+@end defvar
+
 @defvar completion-extra-properties
 This variable is used to specify extra properties of the current
 completion command.  It is intended to be let-bound by specialized
diff --git a/etc/NEWS b/etc/NEWS
index 52569940cbd..93dfc158ae3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -805,6 +805,13 @@ This command lets you change the separator that
 strings.  'completing-read-multiple' binds 'C-x ,' to
 'crm-change-separator' in the minibuffer.
 
++++
+*** New command 'minibuffer-set-completion-styles'.
+This command, bound to 'C-x /' in the minibuffer, lets you set the
+completion styles for the current minibuffer.  See Info node
+"(emacs)Completion Styles" for more information about this new
+command, and completion styles in general.
+
 ** Pcomplete
 
 ---
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c288e421206..7eb68737e64 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1246,12 +1246,32 @@ overrides the default specified in 
`completion-category-defaults'."
   (or (assq tag (cdr (assq category completion-category-overrides)))
       (assq tag (cdr (assq category completion-category-defaults)))))
 
+(defvar completion-style nil
+  "The completion style that produced the current completions list.
+
+`minibuffer-completion-help' arranges for this variable to be set
+buffer-locally in the *Completions* buffer.")
+
+(defvar completion--matching-style nil
+  "Last completion style to match user input.")
+
+(defvar completion-local-styles nil
+  "List of completion styles local to the current minibuffer.
+
+You manipulate this variable with command \
+\\<minibuffer-local-completion-map>\\[minibuffer-set-completion-styles]
+in the minibuffer.  When it is non-nil, it takes precedence over
+the global `completion-styles' user option and the completion
+styles that the completion category may prescribe.")
+
 (defun completion--styles (metadata)
-  (let* ((cat (completion-metadata-get metadata 'category))
-         (over (completion--category-override cat 'styles)))
-    (if over
-        (delete-dups (append (cdr over) (copy-sequence completion-styles)))
-       completion-styles)))
+  "Return current list of completion styles, considering completion METADATA."
+  (or completion-local-styles
+      (let* ((cat (completion-metadata-get metadata 'category))
+             (over (completion--category-override cat 'styles)))
+        (if over
+            (delete-dups (append (cdr over) (copy-sequence completion-styles)))
+          completion-styles))))
 
 (defun completion--nth-completion (n string table pred point metadata)
   "Call the Nth method of completion styles."
@@ -1287,13 +1307,13 @@ overrides the default specified in 
`completion-category-defaults'."
          (result-and-style
           (seq-some
            (lambda (style)
-             (let ((probe (funcall
-                           (or (nth n (assq style completion-styles-alist))
-                               (error "Invalid completion style %s" style))
-                           string table pred point)))
-               (and probe (cons probe style))))
+             (when-let ((probe (funcall
+                                (nth n (assq style completion-styles-alist))
+                                string table pred point)))
+               (cons probe style)))
            (completion--styles md)))
          (adjust-fn (get (cdr result-and-style) 'completion--adjust-metadata)))
+    (setq completion--matching-style (cdr result-and-style))
     (when (and adjust-fn metadata)
       (setcdr metadata (cdr (funcall adjust-fn metadata))))
     (if requote
@@ -2677,6 +2697,82 @@ current order instead."
                nil nil minibuffer-read-sort-order-with-completion)))))
   (when completion-auto-help (minibuffer-completion-help)))
 
+(defun completion-styles-affixation (names)
+  "Return completion affixations for completion styles list NAMES."
+  (let ((max-name (seq-max (mapcar #'string-width names))))
+    (mapcar
+     (lambda (name)
+       (list name
+             ""
+             (if-let ((desc (nth 3 (assoc (intern name)
+                                          completion-styles-alist))))
+                 (concat (propertize " " 'display
+                                     `(space :align-to ,(+ max-name 4)))
+                         (propertize
+                          ;; Only use the first line.
+                          (substring desc 0 (string-search "\n" desc))
+                          'face 'completions-annotations))
+               "")))
+     names)))
+
+(defun completion-styles-table (string pred action)
+  "Completion table for completion styles.
+
+See Info node `(elisp)Programmed Completion' for the meaning of
+STRING, PRED and ACTION."
+  (if (eq action 'metadata)
+      '(metadata
+        (category . completion-style)
+        (affixation-function . completion-styles-affixation))
+    (complete-with-action action completion-styles-alist string pred)))
+
+(defun minibuffer-set-completion-styles (styles)
+  "Set the completion styles for the current minibuffer to STYLES.
+
+STYLES is a list of completion styles (symbols).  If STYLES is
+nil, this discards any completion styles changes that you have
+made with this commmand in the current minibuffer.
+
+Interactively, with no prefix argument, prompt for a list of
+completion styles, with completion.  With plain prefix
+\\[universal-argument], discard all changes that you made with
+this commmand in the current minibuffer.  Zero prefix argument
+(C-0 C-x /) says to disable the completion style that produced
+the current completions list.  Prefix argument one (C-1 C-x /)
+says to keep only the completion style that produced the current
+completions list."
+  (interactive
+   (list (let ((styles (completion--styles (completion--field-metadata
+                                            (minibuffer-prompt-end))))
+               (current (when-let ((buf (get-buffer "*Completions*")))
+                          (buffer-local-value 'completion-style buf))))
+           (pcase current-prefix-arg
+             (`(,_ . ,_) nil)           ; \\[universal-argument]
+             (0 (unless current
+                  (user-error "No current completion style"))
+                (or (remove current styles)
+                    (user-error "Cannot disable sole competion style")))
+             (1 (unless current
+                  (user-error "No current completion style"))
+                (list current))
+             (_ (mapcar
+                 #'intern
+                 (minibuffer-with-setup-hook
+                     (lambda ()
+                       (require 'crm)
+                       (setq-local crm-separator "[ \t]*,[ \t]*"))
+                   (completing-read-multiple
+                    "Set completion styles: "
+                    #'completion-styles-table nil t
+                    (concat (mapconcat #'symbol-name styles ",") ","))))))))
+   minibuffer-mode)
+  (setq-local completion-local-styles styles)
+  (when (get-buffer-window "*Completions*" 0)
+    (minibuffer-completion-help))
+  (message (format "Using completion style%s `%s'"
+                   (ngettext "" "s" (length styles))
+                   (mapconcat #'symbol-name styles "', `"))))
+
 (defun minibuffer-completion-help (&optional start end)
   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
@@ -2720,6 +2816,7 @@ current order instead."
                        (or (search-forward "/" nil t) (point-max))))
                    (point-max))
                 ""))
+             (style completion--matching-style)
              (all-md (completion--metadata (buffer-substring-no-properties
                                             start (point))
                                            base-size md
@@ -2808,6 +2905,7 @@ current order instead."
                                       completions))))
 
                       (with-current-buffer standard-output
+                        (setq-local completion-style style)
                         (setq-local completion-base-position
                              (list (+ start base-size)
                                    ;; FIXME: We should pay attention to 
completion
@@ -3200,7 +3298,8 @@ The completion method is determined by 
`completion-at-point-functions'."
   "M-<down>"  #'minibuffer-next-completion
   "M-RET"     #'minibuffer-choose-completion
   "C-x C-v"   #'minibuffer-sort-completions
-  "C-x n"     'minibuffer-narrow-completions-map)
+  "C-x n"     'minibuffer-narrow-completions-map
+  "C-x /"     #'minibuffer-set-completion-styles)
 
 (defvar-keymap minibuffer-local-must-match-map
   :doc "Local keymap for minibuffer input with completion, for exact match."
diff --git a/lisp/simple.el b/lisp/simple.el
index 48b617b17c1..4c95332f2b8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10256,7 +10256,16 @@ back on `completion-list-insert-choice-function' when 
nil."
                        (raise-frame (window-frame mini))))
                  (exit-minibuffer))))))))
 
-(define-derived-mode completion-list-mode nil "Completion List"
+(define-derived-mode completion-list-mode nil
+  `("Completions"
+    (completion-style
+     (:eval (concat "["
+                    (propertize (symbol-name completion-style)
+                                'mouse-face 'mode-line-highlight
+                                'help-echo
+                                (nth 3 (assoc completion-style
+                                              completion-styles-alist)))
+                    "]"))))
   "Major mode for buffers showing lists of possible completions.
 Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
  to select the completion near point.
@@ -10318,11 +10327,13 @@ Called from `temp-buffer-show-hook'."
     (with-current-buffer standard-output
       (let ((base-position completion-base-position)
             (base-affixes completion-base-affixes)
-            (insert-fun completion-list-insert-choice-function))
+            (insert-fun completion-list-insert-choice-function)
+            (style completion-style))
         (completion-list-mode)
         (setq-local completion-base-position base-position)
         (setq-local completion-base-affixes base-affixes)
         (setq-local completion-list-insert-choice-function insert-fun)
+        (setq-local completion-style style)
         (when narrow (completions-narrow-mode)))
       (setq-local completion-reference-buffer mainbuf)
       (if base-dir (setq default-directory base-dir))