From: Juri Linkov <juri@linkov.net>
Date: Wed, 10 Jan 2024 07:34:47 +0000 (+0200)
Subject: Support :category in completion-extra-properties (bug#68214)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9f05b67d26134f3503fa94613ed8001fb35a993f;p=emacs.git

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.

(cherry picked from commit 7755f7172748b2d337fa53434c1f678269cc5c45)
---

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 296fa90b0af..2e77f252362 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2038,6 +2038,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 5a7cfefb100..3ccb95be0bb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -785,8 +785,8 @@ command, and completion styles in general.
 
 +++
 *** '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 a90ba93f9ae..d99905c3627 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -153,6 +153,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
@@ -164,15 +172,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.
@@ -2549,6 +2552,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