From 7755f7172748b2d337fa53434c1f678269cc5c45 Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri@linkov.net>
Date: Wed, 10 Jan 2024 09:34:47 +0200
Subject: [PATCH] Support :category in completion-extra-properties (bug#68214)

* doc/lispref/minibuf.texi (Completion Variables): Add :category
to the table of completion-extra-properties.

* lisp/minibuffer.el (completion--metadata-get-1): New internal function.
(completion-metadata-get): Use 'completion--metadata-get-1'.
Thanks to Daniel Mendler <mail@daniel-mendler.de>.
(completion-extra-properties): Mention :category in the docstring.

* lisp/calendar/calendar.el (calendar-read-date): Use more
user-friendly let-binding of completion-extra-properties
with :category.
---
 doc/lispref/minibuf.texi  |  6 ++++++
 etc/NEWS                  |  4 ++--
 lisp/calendar/calendar.el | 14 ++++++--------
 lisp/minibuffer.el        | 20 +++++++++++++-------
 4 files changed, 27 insertions(+), 17 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 18df44256a8..aa27de72ba0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1912,6 +1912,12 @@ completion commands.  Its value should be a list of property and value
 pairs.  The following properties are supported:
 
 @table @code
+@item :category
+The value should be a symbol describing what kind of text the
+completion function is trying to complete.  If the symbol matches one
+of the keys in @code{completion-category-overrides}, the usual
+completion behavior is overridden.  @xref{Completion Variables}.
+
 @item :annotation-function
 The value should be a function to add annotations in the completions
 buffer.  This function must accept one argument, a completion, and
diff --git a/etc/NEWS b/etc/NEWS
index fcec2ca715a..4559c67d4ae 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -754,8 +754,8 @@ defined in completion metadata.
 
 +++
 *** 'completion-extra-properties' supports more metadata.
-The new supported completion properties are 'group-function',
-'display-sort-function', 'cycle-sort-function'.
+The new supported completion properties are 'category',
+'group-function', 'display-sort-function', 'cycle-sort-function'.
 
 ** Pcomplete
 
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index e01d5d792a6..2c3e7d28301 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -2337,14 +2337,12 @@ returned is (month year)."
          (defmon (aref month-array (1- (calendar-extract-month default-date))))
          (completion-ignore-case t)
          (month (cdr (assoc-string
-                      (completing-read
-                       (format-prompt "Month name" defmon)
-                       (lambda (string pred action)
-	                 (if (eq action 'metadata)
-		             '(metadata (category . calendar-month))
-	                   (complete-with-action
-                            action (append month-array nil) string pred)))
-                       nil t nil nil defmon)
+                      (let ((completion-extra-properties
+                             '(:category calendar-month)))
+                        (completing-read
+                         (format-prompt "Month name" defmon)
+                         (append month-array nil)
+                         nil t nil nil defmon))
                       (calendar-make-alist month-array 1) t)))
          (defday (calendar-extract-day default-date))
          (last (calendar-last-day-of-month month year)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 42d04e0ff96..45aab398078 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -150,6 +150,14 @@ The metadata of a completion table should be constant between two boundaries."
                        minibuffer-completion-table
                        minibuffer-completion-predicate))
 
+(defun completion--metadata-get-1 (metadata prop)
+  (or (alist-get prop metadata)
+      (plist-get completion-extra-properties
+                 ;; Cache the keyword
+                 (or (get prop 'completion-extra-properties--keyword)
+                     (put prop 'completion-extra-properties--keyword
+                          (intern (concat ":" (symbol-name prop))))))))
+
 (defun completion-metadata-get (metadata prop)
   "Get property PROP from completion METADATA.
 If the metadata specifies a completion category, the variables
@@ -161,15 +169,10 @@ consulted.  Note that the keys of the
 `completion-extra-properties' plist are keyword symbols, not
 plain symbols."
   (if-let (((not (eq prop 'category)))
-           (cat (alist-get 'category metadata))
+           (cat (completion--metadata-get-1 metadata 'category))
            (over (completion--category-override cat prop)))
       (cdr over)
-    (or (alist-get prop metadata)
-        (plist-get completion-extra-properties
-                   ;; Cache the keyword
-                   (or (get prop 'completion-extra-properties--keyword)
-                       (put prop 'completion-extra-properties--keyword
-                            (intern (concat ":" (symbol-name prop)))))))))
+    (completion--metadata-get-1 metadata prop)))
 
 (defun complete-with-action (action collection string predicate)
   "Perform completion according to ACTION.
@@ -2442,6 +2445,9 @@ candidates."
   "Property list of extra properties of the current completion job.
 These include:
 
+`:category': the kind of objects returned by `all-completions'.
+   Used by `completion-category-overrides'.
+
 `:annotation-function': Function to annotate the completions buffer.
    The function must accept one argument, a completion string,
    and return either nil or a string which is to be displayed
-- 
2.39.5