branch: externals/compat
commit ab3fbaf31f5fa3bdad270588e34f058e465ac421
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-30: Add extended completion-metadata-get
See Emacs commit 7755f7172748b2d337fa53434c1f678269cc5c45
---
NEWS.org | 6 ++++--
compat-25.el | 6 ++++++
compat-30.el | 26 ++++++++++++++++++++++++++
compat-tests.el | 23 +++++++++++++++++++++++
compat.texi | 13 +++++++++++++
5 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/NEWS.org b/NEWS.org
index 5f20469ea1..4fbb0bcaa2 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 7901091b13..a90bb02856 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 b68cc407e2..da305bc3d2 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 6b41482d5a..210d2c9f60 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 3e02cb2b1e..df8b96577c 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
