[elpa] externals/compat 78e9a6922c 28/77: New Emacs 30 APIs: merge-ordered-lists, completion-lazy-hilit

[ELPA Syncer]

branch: externals/compat
commit 78e9a6922c4f7ab84edc99b2455069fc33a73746
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    New Emacs 30 APIs: merge-ordered-lists, completion-lazy-hilit
---
 NEWS.org        | 11 ++++++--
 compat-30.el    | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat-macs.el  |  3 +-
 compat-tests.el | 37 ++++++++++++++++++++-----
 compat.texi     | 55 +++++++++++++++++++++++++++++++++++++
 5 files changed, 181 insertions(+), 10 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index 37890ce23a..90da0c285d 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -2,6 +2,15 @@
 #+link:    compat-gh   https://github.com/emacs-compat/compat/issues/
 #+options: toc:nil num:nil author:nil
 
+* Development
+
+- compat-30: Add =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=.
+
 * Release of "Compat" Version 29.1.4.4
 
 - Fix ~Package-Requires~ header in compat.el
@@ -21,8 +30,6 @@
 - compat-28: Improve =make-separator-line= visuals on graphic displays.
 - compat-28: Add =native-comp-available-p=, which always returns nil.
 - compat-29: Add variable =lisp-directory=.
-- compat-30: Replace ~copy-tree~ with version from Emacs 30, support
-  copying records with non-nil optional second argument.
 
 (Release <2023-07-30 Sun>)
 
diff --git a/compat-30.el b/compat-30.el
index 3aaf99759e..90b8a11a44 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -27,8 +27,93 @@
 ;; TODO Update to 30.1 as soon as the Emacs emacs-30 branch version bumped
 (compat-version "30.0.50")
 
+;;;; Defined in minibuffer.el
+
+(compat-defvar completion-lazy-hilit nil ;; 
<compat-tests:completion-lazy-hilit>
+  "If non-nil, request lazy highlighting of completion candidates.
+
+Lisp programs (a.k.a. \"front ends\") that present completion
+candidates may opt to bind this variable to a non-nil value when
+calling functions (such as `completion-all-completions') which
+produce completion candidates.  This tells the underlying
+completion styles that they do not need to fontify (i.e.,
+propertize with the `face' property) completion candidates in a
+way that highlights the matching parts.  Then it is the front end
+which presents the candidates that becomes responsible for this
+fontification.  The front end does that by calling the function
+`completion-lazy-hilit' on each completion candidate that is to be
+displayed to the user.
+
+Note that only some completion styles take advantage of this
+variable for optimization purposes.  Other styles will ignore the
+hint and fontify eagerly as usual.  It is still safe for a
+front end to call `completion-lazy-hilit' in these situations.
+
+To author a completion style that takes advantage of this variable,
+see `completion-lazy-hilit-fn' and `completion-pcm--hilit-commonality'.")
+
+(compat-defvar completion-lazy-hilit-fn nil ;; 
<compat-tests:completion-lazy-hilit>
+  "Fontification function set by lazy-highlighting completions styles.
+When a given style wants to enable support for `completion-lazy-hilit'
+\(which see), that style should set this variable to a function of one
+argument.  It will be called with each completion candidate, a string, to
+be displayed to the user, and should destructively propertize these
+strings with the `face' property.")
+
+(compat-defun completion-lazy-hilit (str) ;; 
<compat-tests:completion-lazy-hilit>
+  "Return a copy of completion candidate STR that is `face'-propertized.
+See documentation of the variable `completion-lazy-hilit' for more
+details."
+  (if (and completion-lazy-hilit completion-lazy-hilit-fn)
+      (funcall completion-lazy-hilit-fn (copy-sequence str))
+    str))
+
 ;;;; Defined in subr.el
 
+(compat-defun merge-ordered-lists (lists &optional error-function) ;; 
<compat-tests:merge-ordered-lists>
+  "Merge LISTS in a consistent order.
+LISTS is a list of lists of elements.
+Merge them into a single list containing the same elements (removing
+duplicates), obeying their relative positions in each list.
+The order of the (sub)lists determines the final order in those cases where
+the order within the sublists does not impose a unique choice.
+Equality of elements is tested with `eql'.
+
+If a consistent order does not exist, call ERROR-FUNCTION with
+a remaining list of lists that we do not know how to merge.
+It should return the candidate to use to continue the merge, which
+has to be the head of one of the lists.
+By default we choose the head of the first list."
+  (let ((result '()))
+    (setq lists (remq nil lists))
+    (while (cdr (setq lists (delq nil lists)))
+      (let* ((next nil)
+             (tail lists))
+        (while tail
+          (let ((candidate (caar tail))
+                (other-lists lists))
+            (while other-lists
+              (if (not (memql candidate (cdr (car other-lists))))
+                  (setq other-lists (cdr other-lists))
+                (setq candidate nil)
+                (setq other-lists nil)))
+            (if (not candidate)
+                (setq tail (cdr tail))
+              (setq next candidate)
+              (setq tail nil))))
+        (unless next
+          (setq next (funcall (or error-function #'caar) lists))
+          (unless (funcall
+                   (eval-when-compile (if (fboundp 'compat--assoc) 
'compat--assoc 'assoc))
+                   next lists #'eql)
+            (error "Invalid candidate returned by error-function: %S" next)))
+        (push next result)
+        (setq lists
+              (mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
+                      lists))))
+    (if (null result) (car lists)
+      (append (nreverse result) (car lists)))))
+
 (compat-defun copy-tree (tree &optional vectors-and-records) ;; 
<compat-tests:copy-tree>
   "Handle copying records when optional arg is non-nil."
   :min-version "26.1" ;; recordp is only available on Emacs 26.1 and newer
diff --git a/compat-macs.el b/compat-macs.el
index 41d368a688..41ed2e639a 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -246,7 +246,8 @@ definition is generated.
       ;; The boundp check is performed at runtime to make sure that we never
       ;; redefine an existing definition if Compat is loaded on a newer Emacs
       ;; version.
-      `((unless (boundp ',name)
+      `((defvar ,name)
+        (unless (boundp ',name)
           (,(if constant 'defconst 'defvar)
            ,name ,initval
            ,(compat-macs--docstring 'variable name docstring))
diff --git a/compat-tests.el b/compat-tests.el
index b106c84e51..a8d1f35a4f 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1325,8 +1325,8 @@
                          (list (list) (list) (list) (list)))))
 
 (ert-deftest compat-xor ()
-  (should (equal (xor 'a nil) 'a))
-  (should (equal (xor nil 'b) 'b))
+  (should-equal (xor 'a nil) 'a)
+  (should-equal (xor nil 'b) 'b)
   (should-not (xor nil nil))
   (should-not (xor 'a 'b)))
 
@@ -2950,7 +2950,7 @@
     (should (directory-name-p dir))
     (should (file-directory-p dir)))
   (ert-with-temp-file file :buffer buffer
-    (should (equal (current-buffer) buffer))
+    (should-equal (current-buffer) buffer)
     (should-equal buffer-file-name file)
     (should-not (directory-name-p file))
     (should (file-readable-p file))
@@ -3040,15 +3040,38 @@
   (cl-labels ((prn3 (x y z) (prin1-to-string (list x y z)))
               (cat3 (x y z) (concat "(" x " " y " " z ")")))
     (let ((x '(a (b ((c) . d) e) (f))))
-      (should (equal (prn3 x (compat-call copy-tree x) (compat-call copy-tree 
x t))
-                     (cat3 "(a (b ((c) . d) e) (f))"
-                           "(a (b ((c) . d) e) (f))"
-                           "(a (b ((c) . d) e) (f))"))))))
+      (should-equal (prn3 x (compat-call copy-tree x) (compat-call copy-tree x 
t))
+                    (cat3 "(a (b ((c) . d) e) (f))"
+                          "(a (b ((c) . d) e) (f))"
+                          "(a (b ((c) . d) e) (f))")))))
 
 (ert-deftest compat-static-if ()
   (should-equal "true" (static-if t "true"))
   (should-not (static-if nil "true"))
   (should-equal "else2" (static-if nil "true" "else1" "else2")))
 
+(ert-deftest compat-completion-lazy-hilit ()
+  (let ((completion-lazy-hilit t)
+        (completion-lazy-hilit-fn (lambda (x) (concat "<" x ">"))))
+    (should-equal (completion-lazy-hilit "test") "<test>"))
+  (should-equal (completion-lazy-hilit "test") "test"))
+
+(ert-deftest compat-merge-ordered-lists ()
+  ;; TODO: Reenable this test when `merge-ordered-lists' is available on the CI
+  ;; Emacs version
+  (static-if (< emacs-major-version 30)
+    (progn
+      (should-equal (merge-ordered-lists
+                     '((B A) (C A) (D B) (E D C))
+                     (lambda (_) (error "cycle")))
+                    '(E D B C A))
+      (should-equal (merge-ordered-lists
+                     '((E D C) (B A) (C A) (D B))
+                     (lambda (_) (error "cycle")))
+                    '(E D C B A))
+      (should-error (merge-ordered-lists
+                     '((E C D) (B A) (A C) (D B))
+                     (lambda (_) (error "cycle")))))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index 97d954c2db..39a9c79557 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3348,6 +3348,61 @@ older than 30.1.  Note that due to upstream changes, it 
might happen
 that there will be the need for changes, so use these functions with
 care.
 
+@defun merge-ordered-lists lists &optional error-function
+Merge @var{lists} in a consistent order.  @var{lists} is a list of
+lists of elements.  Merge them into a single list containing the same
+elements (removing duplicates), obeying their relative positions in
+each list.  The order of the (sub)lists determines the final order in
+those cases where the order within the sublists does not impose a
+unique choice.  Equality of elements is tested with @code{eql}.
+
+If a consistent order does not exist, call @var{error-function} with a
+remaining list of lists that we do not know how to merge.  It should
+return the candidate to use to continue the merge, which has to be the
+head of one of the lists.  By default we choose the head of the first
+list.
+@end defun
+
+@defvar completion-lazy-hilit
+If non-nil, request lazy highlighting of completion candidates.
+
+Lisp programs (a.k.a. "front ends") that present completion candidates
+may opt to bind this variable to a non-nil value when calling
+functions (such as @code{completion-all-completions}) which produce
+completion candidates.  This tells the underlying completion styles
+that they do not need to fontify (i.e., propertize with the
+@code{face} property) completion candidates in a way that highlights
+the matching parts.  Then it is the front end which presents the
+candidates that becomes responsible for this fontification.  The front
+end does that by calling the function @code{completion-lazy-hilit} on
+each completion candidate that is to be displayed to the user.
+
+Note that only some completion styles take advantage of this variable
+for optimization purposes.  Other styles will ignore the hint and
+fontify eagerly as usual.  It is still safe for a front end to call
+@code{completion-lazy-hilit} in these situations.
+
+To author a completion style that takes advantage of this variable,
+see @code{completion-lazy-hilit-fn} and
+@code{completion-pcm--hilit-commonality}.
+@end defvar
+
+@defvar completion-lazy-hilit-fn
+Fontification function set by lazy-highlighting completions styles.
+When a given style wants to enable support for
+@code{completion-lazy-hilit} (which see), that style should set this
+variable to a function of one argument.  It will be called with each
+completion candidate, a string, to be displayed to the user, and
+should destructively propertize these strings with the @code{face}
+property.
+@end defvar
+
+@defun completion-lazy-hilit str
+Return a copy of completion candidate @var{str} that is
+face-propertized.  See documentation of the variable
+@code{completion-lazy-hilit} for more details.
+@end defun
+
 @defmac static-if condition then-form else-forms...
 Test @var{condition} at macro-expansion time.  If its value is
 non-@code{nil}, expand the macro to @var{then-form}, otherwise expand