feature/minibuffer-completion-enhancements 68d33f872e9 24/35: Show completions category in heading line

[Eshel Yaron]

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

    Show completions category in heading line
    
    Extend 'completions-header-format' with a placeholder for the
    completions category.  Stop hard-coding the 'shadow' face for the
    heading line default value, instead define a derived face.
    
    * lisp/minibuffer.el (completions-header-format): Extend.
    (completions-heading): New face.
    (completion-category): New variable.
    (minibuffer-completion-help): Let-bind it.
    (display-completion-list): Use it.
    
    * doc/emacs/mini.texi (Completion Options): Elaborate.
    
    * etc/NEWS: Announce.
---
 doc/emacs/mini.texi | 40 ++++++++++++++++++++++++++++++++++------
 etc/NEWS            |  9 +++++++++
 lisp/minibuffer.el  | 46 ++++++++++++++++++++++++++++++++++------------
 3 files changed, 77 insertions(+), 18 deletions(-)

diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 03906322dc2..b1a6e8b6dce 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -948,12 +948,40 @@ Reference Manual}).
 The variable @code{completions-header-format} is a format spec string
 to control the informative line shown before the completions list of
 candidates, called the @dfn{completions heading line}.  Emacs
-substitutes @samp{%s}, @samp{%t} and @samp{%r} constructs that occur
-in this string with the number of completion candidates, the current
-completions sort order, and a description of the current completions
-restriction, respectively.  @xref{Narrow Completions}.  To suppress
-the display of the heading line, customize this variable to
-@code{nil}.  The string that is the value of this variable can have
+substitutes the following @samp{%}-constructs that occur in this
+string with information about the current completions:
+
+@table @samp
+@item %s
+The total number of completion candidates.
+
+@item %c
+The completion category prefixed with @samp{ } (e.g. @samp{ command}),
+or the empty string if the completion table does not specify a
+category.
+
+@item %t
+The completions sort order prefixed with @samp{, }
+(e.g. @samp{, sorted alphabetically}), or the empty string if using
+the default sort order.
+
+@item %r
+A description of the current completion restrictions prefixed with
+@samp{, } (e.g. @samp{, with property disabled}), or the empty string
+if there are no restrictions.  @xref{Narrow Completions}.
+@end table
+
+@noindent
+This option defaults to @samp{%s possible%c completions%t%r:}, so a
+possible heading line may be, for example:
+
+@example
+629 possible command completions, sorted alphabetically, matching "-mode$":
+@end example
+
+@noindent
+To suppress the display of the heading line, customize this variable
+to @code{nil}.  The string that is the value of this variable can have
 text properties to change the visual appearance of the heading line;
 some useful properties are @code{face} or @code{cursor-intangible}
 (@pxref{Special Properties,,Properties with Special Meanings, elisp,
diff --git a/etc/NEWS b/etc/NEWS
index 80c154e10d0..2b148ee0f85 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -824,6 +824,15 @@ completion styles for the current minibuffer.  See Info 
node
 "(emacs)Completion Styles" for more information about this new
 command, and completion styles in general.
 
++++
+*** The completions heading line now displays more information.
+In particular, the heading line now mentions the completions category,
+which you can use to customize completion behavior via
+'completion-category-overrides'.  As is Emacs 29, user option
+'completions-header-format' controls the format of the heading line,
+and you can now customize the face 'completions-heading' to control
+its appearance.
+
 ** Pcomplete
 
 ---
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 58d6f74d96c..bcc60baa42b 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2290,16 +2290,25 @@ completions."
   :type 'boolean
   :version "28.1")
 
-(defcustom completions-header-format
-  (propertize "%s possible completions%t%r:\n" 'face 'shadow)
+(defcustom completions-header-format "%s possible%c completions%t%r:\n"
   "If non-nil, the format string for completions heading line.
 The heading line is inserted before the completions, and is
 intended to summarize the completions.  The format string may
-contain the sequences \"%s\", \"%t\" and \"%r\", which are
-substituted with the total count of possible completions, the
-current completions sort order, and a description of the current
-completions restriction.  If this option is nil, no heading line
-is shown."
+contain the sequences \"%s\", \"%c\", \"%t\" and \"%r\", which
+are substituted as follows:
+
+- \"%s\": the total count of possible completions.
+- \"%c\": the current completion category prefixed with \" \"
+  (e.g. \" command\"), or the empty string when the completion
+  table does not specify a category.
+- \"%t\": the current completions sort order prefixed with
+  \", \" (e.g. \", sorted alphabetically\"), or the empty string
+  when using the default sort order.
+- \"%r\": a description of the current completions restriction
+  prefixed with \", \" (e.g. \", with property disabled\"), or
+  the empty string when there are no restrictions.
+
+If this option is nil, no heading line is shown."
   :type '(choice (const :tag "No heading line" nil)
                  (string :tag "Format string for heading line"))
   :version "30.1")
@@ -2585,6 +2594,12 @@ when you select this sort order."
                 (choice string
                         (const :tag "No description" nil)))))
 
+(defvar completion-category nil
+  "The current completion category.")
+
+(defface completions-heading '((t :inherit shadow))
+  "Face for the completions headling line.")
+
 (defun display-completion-list (completions &optional common-substring 
group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
@@ -2631,14 +2646,20 @@ candidates."
                 (when (advice-function-member-p
                        #'reverse minibuffer-completions-sort-function)
                   ", reversed"))
-             "")))
+             ""))
+          (cat (if completion-category (format " %s" completion-category) "")))
       (with-current-buffer standard-output
         (goto-char (point-max))
         (if completions-header-format
-            (insert (format-spec completions-header-format
-                                 (list (cons ?s (length completions))
-                                       (cons ?t sort-desc)
-                                       (cons ?r pred-desc))))
+            (let ((heading
+                   (format-spec completions-header-format
+                                (list (cons ?s (length completions))
+                                      (cons ?t sort-desc)
+                                      (cons ?r pred-desc)
+                                      (cons ?c cat)))))
+              (add-face-text-property
+               0 (length heading) 'completions-heading t heading)
+              (insert heading))
           (unless completion-show-help
             ;; Ensure beginning-of-buffer isn't a completion.
             (insert (propertize "\n" 'face '(:height 0)))))
@@ -2925,6 +2946,7 @@ completions list."
              (aff-fun (completion-metadata-get all-md 'affixation-function))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
              (group-fun (completion-metadata-get all-md 'group-function))
+             (completion-category (completion-metadata-get all-md 'category))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in