compat-30: Add extended completion-metadata-get

See Emacs commit 7755f7172748b2d337fa53434c1f678269cc5c45

5 files changed, 72 insertions, 2 deletions

diff --git a/NEWS.org b/NEWS.org
index 5f20469..4fbb0bc 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -4,14 +4,16 @@
 
 * Development
 
-- compat-30: Add =copy-tree= with support for copying records with non-nil
-  optional second argument.
+- compat-30: Add extended =copy-tree= with support for copying records with
+  non-nil optional second argument.
 - compat-30: New macro =static-if=.
 - compat-30: New function =merge-ordered-lists=.
 - compat-30: New variables =completion-lazy-hilit= and =completion-lazy-hilit-fn=
   and new function =completion-lazy-hilit=.
 - compat-30: New function =require-with-check=.
 - compat-30: New functions =find-buffer= and =get-truename-buffer=.
+- compat-30: Add extended =completion-metadata-get= with support for
+  =completion-category-overrides= and =completion-extra-properties=.
 
 * Release of "Compat" Version 29.1.4.4
 
diff --git a/compat-25.el b/compat-25.el
index 7901091..a90bb02 100644
--- a/compat-25.el
+++ b/compat-25.el
@@ -267,5 +267,11 @@ itself or not."
                 form))))))))
    (t form)))
 
+;;;; Defined in minibuffer.el
+
+(compat-defun completion--category-override (category tag) ;; <compat-tests:completion-metadata-get>
+  "Return completion category override for CATEGORY and TAG."
+  (assq tag (cdr (assq category completion-category-overrides))))
+
 (provide 'compat-25)
 ;;; compat-25.el ends here
diff --git a/compat-30.el b/compat-30.el
index b68cc40..da305bc 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -69,6 +69,32 @@ the new file (if NOERROR is equal to `reload'), or otherwise emit a warning."
 
 ;;;; Defined in minibuffer.el
 
+(compat-defun completion--metadata-get-1 (metadata prop) ;; <compat-tests:completion-metadata-get>
+  "Helper function.
+See for `completion-metadata-get' for METADATA and PROP arguments."
+  (or (alist-get prop metadata)
+      (plist-get completion-extra-properties
+                 (or (get prop 'completion-extra-properties--keyword)
+                     (put prop 'completion-extra-properties--keyword
+                          (intern (concat ":" (symbol-name prop))))))))
+
+(compat-defun completion-metadata-get (metadata prop) ;; <compat-tests:completion-metadata-get>
+  "Get property PROP from completion METADATA.
+If the metadata specifies a completion category, the variables
+`completion-category-overrides' and
+`completion-category-defaults' take precedence for
+category-specific overrides.  If the completion metadata does not
+specify the property, the `completion-extra-properties' plist is
+consulted.  Note that the keys of the
+`completion-extra-properties' plist are keyword symbols, not
+plain symbols."
+  :extended t
+  (if-let ((cat (and (not (eq prop 'category))
+                     (completion--metadata-get-1 metadata 'category)))
+           (over (completion--category-override cat prop)))
+      (cdr over)
+    (completion--metadata-get-1 metadata prop)))
+
 (compat-defvar completion-lazy-hilit nil ;; <compat-tests:completion-lazy-hilit>
   "If non-nil, request lazy highlighting of completion candidates.
 
diff --git a/compat-tests.el b/compat-tests.el
index 6b41482..210d2c9 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -3111,5 +3111,28 @@
                (should-equal buf2 (get-truename-buffer "compat-tests-file2"))
                (should-not (get-truename-buffer "compat-tests-file3")))))
 
+(ert-deftest compat-completion-metadata-get ()
+  ;; TODO enable test on Emacs 30 as soon as the CI supports it.
+  (static-if (< emacs-major-version 30)
+    (progn
+      (let ((md '((a . 1) (b . 2) (c . 3) (category . compat-test))))
+        (should-equal 'compat-test (compat-call completion-metadata-get md 'category))
+        (should-equal 1 (compat-call completion-metadata-get md 'a))
+        (should-equal 2 (compat-call completion-metadata-get md 'b))
+        (should-equal 3 (compat-call completion-metadata-get md 'c))
+        (should-not (compat-call completion-metadata-get md 'd))
+        (let ((completion-extra-properties '(:d 4)))
+          (should-equal 4 (compat-call completion-metadata-get md 'd)))
+        (let ((completion-category-overrides '((compat-test (a . 10)))))
+          (should-equal 10 (compat-call completion-metadata-get md 'a))))
+      (let ((md '((a . 1) (b . 2))))
+        (should-not (compat-call completion-metadata-get md 'category))
+        (let ((completion-extra-properties '(:category compat-test)))
+          (should-equal 1 (compat-call completion-metadata-get md 'a))
+          (should-equal 2 (compat-call completion-metadata-get md 'b))
+          (should-equal 'compat-test (compat-call completion-metadata-get md 'category))
+          (let ((completion-category-overrides '((compat-test (a . 10)))))
+            (should-equal 10 (compat-call completion-metadata-get md 'a))))))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index 3e02cb2..df8b965 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3457,6 +3457,19 @@ Here is an example of its use from CC Mode, which prevents a
 These functions must be called explicitly via @code{compat-call},
 since their calling convention or behavior was extended in Emacs 30.1:
 
+@c based on lisp/minibuffer.el
+@defun compat-call@ completion-metadata-get metadata prop
+Get property @var{prop} from completion @var{metadata}.  If the
+metadata specifies a completion category, the variables
+@code{completion-category-overrides} and
+@code{completion-category-defaults} take precedence for
+category-specific overrides.  If the completion metadata does not
+specify the property, the @code{completion-extra-properties} plist is
+consulted.  Note that the keys of the
+@code{completion-extra-properties} plist are keyword symbols, not
+plain symbols.
+@end defun
+
 @c copied from lispref/lists.texi
 @defun compat-call@ copy-tree tree &optional vectors-and-records
 This function returns a copy of the tree @var{tree}.  If @var{tree} is a