bug#47711: [PATCH] Add new `completion-filter-completions` API and deferred highlighting

[Daniel Mendler <mail@daniel-mendler.de>]

[-- Attachment #1: Type: text/plain, Size: 1747 bytes --]

On 8/11/21 6:11 PM, Daniel Mendler wrote:
> 2. In `completion--nth-completion' set `completion--filter-completions'
>    to nil, unless `(memq style '(emacs21 emacs22 basic
>    partial-completion initials flex))' such that custom completion
>    styles which wrap the completion functions don't see the new return
>    value format, except if the custom style opts in explicitly by
>    binding `completion--filter-completions'. An alternative criterion is
>    `(memq fun '(completion-emacs22-all-completions) ...)'. Unfortunately
>    this approach will still not work if the user has advised a
>    `completion-x-all-completions' function. The only 100% safe approach
>    seems to transparently redirect calls to
>    `completion-x-all-completions' to `completion--x-filter-completions',
>    which returns the results in the new format.

I attached two patch variants which can be placed on top of my previous
patch to improve the backward compatibility of the internal API.

Variant 1: Set 'completion--return-alist-flag' only for the existing
completion styles, such that they transparently upgrade to the alist
return format.  If the variable is not set, the completion styles return
the result as plain list retaining backward compatibility.  The variable
is purely for internal use, new completion styles should return their
results as an alist on Emacs 28 and newer.

Variant 2: Add an optional argument FILTER to each of the completion
styles 'all' functions, e.g., 'completion-basic-all-completions'.  In
'completion--nth-completion' try to call the function with the
additional FILTER argument to upgrade to the alist return format.  If
this fails with a 'wrong-number-of-arguments' error, retry again without
the argument.

Daniel

[-- Attachment #2: variant1-restrict.el --]
[-- Type: text/plain, Size: 7196 bytes --]

From 5539eea7df1570b6b5045be2b383d2bfbd44789e Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Thu, 12 Aug 2021 10:20:10 +0200
Subject: [PATCH] Set 'completion--return-alist-flag' only for the existing
 styles

This avoids problems if a package wraps an existing completion
style function in a custom completion style.
---
 lisp/minibuffer.el | 66 +++++++++++++++++++++++++---------------------
 1 file changed, 36 insertions(+), 30 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index ba8855c4ea..3257349a1a 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1039,16 +1039,16 @@ completion--styles
         (delete-dups (append (cdr over) (copy-sequence completion-styles)))
        completion-styles)))
 
-(defvar completion--filter-completions nil
+(defvar completion--return-alist-flag nil
   "Enable the new completions return value format.
 If this variable is non-nil the `all-completions' function of a
 completion style should return the results in the new alist format of
 `completion-filter-completions'.  This variable is purely needed to
 for backward compatibility of the existing builtin completion style
-functions.  New completion style functions may always return their
-results in the new alist format, since `completion-all-completions'
-transparently converts back to the old improper list of completions
-with base size in the last cdr.")
+functions as of Emacs 28.  New completion style functions should
+always return their results in the new alist format, since
+`completion-all-completions' transparently converts back to the old
+improper list of completions with base size in the last cdr.")
 
 (defun completion--nth-completion (n string table pred point metadata)
   "Call the Nth method of completion styles."
@@ -1084,7 +1084,7 @@ completion--nth-completion
               ;; contrast to plain completion tables, the savings of
               ;; deferred highlighting would be minimal in the case of
               ;; quoted completion tables.
-              (setq completion--filter-completions nil)
+              (setq completion--return-alist-flag nil)
               (setq string (pop new))
               (setq table (pop new))
               (setq point (pop new))
@@ -1093,18 +1093,35 @@ completion--nth-completion
          (result-and-style
           (completion--some
            (lambda (style)
-             (let ((probe (funcall (nth n (assq style
-                                                completion-styles-alist))
-                                   string table pred point)))
+             (let* ((fun (nth n (assq style completion-styles-alist)))
+                    ;; Transparently upgrade the return value for
+                    ;; existing built-in styles as of Emacs 28.  No
+                    ;; new styles should be added here. New completion
+                    ;; styles should directly return the new
+                    ;; completion format.el
+                    (completion--return-alist-flag
+                     (and completion--return-alist-flag
+                          (memq style '(emacs21 emacs22 basic substring
+                                        partial-completion initials flex))))
+                    (probe (funcall fun string table pred point)))
                (and probe (cons probe style))))
            (completion--styles md)))
-         (style-md (get (cdr result-and-style) 'completion--style-metadata)))
+         (style-md (get (cdr result-and-style) 'completion--style-metadata))
+         (result (car result-and-style)))
     (when (and style-md metadata)
       (setcdr metadata (cdr (funcall style-md
                                      string table pred point metadata))))
+    (when (and (not completion--return-alist-flag) (= n 2) (consp (car result)))
+      ;; Give the completion styles some freedom!  If they are
+      ;; targeting Emacs 28 upwards only, they may return a result
+      ;; with deferred highlighting.  We convert back to the old
+      ;; format here by applying the highlighting eagerly.
+      (setq result (nconc (funcall (cdr (assq 'highlight result))
+                                   (cdr (assq 'completions result)))
+                          (cdr (assq 'base result)))))
     (if requote
-        (funcall requote (car result-and-style) n)
-      (car result-and-style))))
+        (funcall requote result n)
+      result)))
 
 (defun completion-try-completion (string table pred point &optional metadata)
   "Try to complete STRING using completion table TABLE.
@@ -1124,19 +1141,8 @@ completion-all-completions
 The METADATA may be modified by the completion style.  This function
 has been superseded by `completion-filter-completions', which returns
 richer information and supports deferred candidate highlighting."
-  (let ((completion--filter-completions nil)
-        (result (completion--nth-completion 2 string table
-                                            pred point metadata)))
-    (if (and result (consp (car result)))
-        ;; Give the completion styles some freedom!
-        ;; If they are targeting Emacs 28 upwards only, they
-        ;; may always return a result with deferred
-        ;; highlighting.  We convert back to the old format
-        ;; here by applying the highlighting eagerly.
-        (nconc (funcall (cdr (assq 'highlight result))
-                        (cdr (assq 'completions result)))
-               (cdr (assq 'base result)))
-      result)))
+  (let ((completion--return-alist-flag nil))
+    (completion--nth-completion 2 string table pred point metadata)))
 
 (defun completion-filter-completions (string table pred point metadata)
   "Filter the possible completions of STRING in completion table TABLE.
@@ -1152,7 +1158,7 @@ completion-filter-completions
 - completions: The list of completions.
 
 This function supersedes the function `completion-all-completions'."
-  (let* ((completion--filter-completions t)
+  (let* ((completion--return-alist-flag t)
          (result (completion--nth-completion 2 string table
                                              pred point metadata)))
     (if (and result (not (consp (car result))))
@@ -2120,8 +2126,8 @@ completion--hilit-commonality
 
 (defun completion--deferred-hilit (completions prefix-len base end)
   "Return completions in old format or new alist format.
-If `completion--filter-completions' is non-nil use the new format."
-  (if completion--filter-completions
+If `completion--return-alist-flag' is non-nil use the new format."
+  (if completion--return-alist-flag
       (when completions
         `((base . ,base)
           (end . ,end)
@@ -3586,9 +3592,9 @@ flex-score-match-tightness
 
 (defun completion-pcm--deferred-hilit (pattern completions base end)
   "Return completions in old format or new alist format.
-If `completion--filter-completions' is non-nil use the new format."
+If `completion--return-alist-flag' is non-nil use the new format."
   (when completions
-    (if completion--filter-completions
+    (if completion--return-alist-flag
         `((base . ,base)
           (end . ,end)
           (highlight . ,(apply-partially
-- 
2.20.1


[-- Attachment #3: variant2-argument.el --]
[-- Type: text/plain, Size: 13882 bytes --]

From f0da1f1d92f20df7d92d9762295ac51390fcee83 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Thu, 12 Aug 2021 10:10:02 +0200
Subject: [PATCH] Use FILTER argument instead of global
 `completion--filter-completions`

---
 lisp/minibuffer.el | 119 ++++++++++++++++++++++++---------------------
 1 file changed, 64 insertions(+), 55 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index ba8855c4ea..0f8b85ddd4 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1039,18 +1039,7 @@ completion--styles
         (delete-dups (append (cdr over) (copy-sequence completion-styles)))
        completion-styles)))
 
-(defvar completion--filter-completions nil
-  "Enable the new completions return value format.
-If this variable is non-nil the `all-completions' function of a
-completion style should return the results in the new alist format of
-`completion-filter-completions'.  This variable is purely needed to
-for backward compatibility of the existing builtin completion style
-functions.  New completion style functions may always return their
-results in the new alist format, since `completion-all-completions'
-transparently converts back to the old improper list of completions
-with base size in the last cdr.")
-
-(defun completion--nth-completion (n string table pred point metadata)
+(defun completion--nth-completion (n string table pred point metadata &optional filter)
   "Call the Nth method of completion styles."
   ;; We provide special support for quoting/unquoting here because it cannot
   ;; reliably be done within the normal completion-table routines: Completion
@@ -1084,7 +1073,7 @@ completion--nth-completion
               ;; contrast to plain completion tables, the savings of
               ;; deferred highlighting would be minimal in the case of
               ;; quoted completion tables.
-              (setq completion--filter-completions nil)
+              (setq filter nil)
               (setq string (pop new))
               (setq table (pop new))
               (setq point (pop new))
@@ -1093,18 +1082,37 @@ completion--nth-completion
          (result-and-style
           (completion--some
            (lambda (style)
-             (let ((probe (funcall (nth n (assq style
-                                                completion-styles-alist))
-                                   string table pred point)))
+             (let* ((fun (nth n (assq style completion-styles-alist)))
+                    (probe
+                     (if filter
+                         ;; In order to retain backward compatibility
+                         ;; of the calling convention of the exisiting
+                         ;; completion styles, add a fourth FILTER
+                         ;; argument to opt-in to the new return value
+                         ;; format.
+                         (condition-case nil
+                             (funcall fun string table pred point filter)
+                           (wrong-number-of-arguments
+                            (funcall fun string table pred point)))
+                       (funcall fun string table pred point))))
                (and probe (cons probe style))))
            (completion--styles md)))
-         (style-md (get (cdr result-and-style) 'completion--style-metadata)))
+         (style-md (get (cdr result-and-style) 'completion--style-metadata))
+         (result (car result-and-style)))
     (when (and style-md metadata)
       (setcdr metadata (cdr (funcall style-md
                                      string table pred point metadata))))
+    (when (and (not filter) (= n 2) (consp (car result)))
+      ;; Give the completion styles some freedom!  If they are
+      ;; targeting Emacs 28 upwards only, they may return a result
+      ;; with deferred highlighting.  We convert back to the old
+      ;; format here by applying the highlighting eagerly.
+      (setq result (nconc (funcall (cdr (assq 'highlight result))
+                                   (cdr (assq 'completions result)))
+                          (cdr (assq 'base result)))))
     (if requote
-        (funcall requote (car result-and-style) n)
-      (car result-and-style))))
+        (funcall requote result n)
+      result)))
 
 (defun completion-try-completion (string table pred point &optional metadata)
   "Try to complete STRING using completion table TABLE.
@@ -1124,19 +1132,7 @@ completion-all-completions
 The METADATA may be modified by the completion style.  This function
 has been superseded by `completion-filter-completions', which returns
 richer information and supports deferred candidate highlighting."
-  (let ((completion--filter-completions nil)
-        (result (completion--nth-completion 2 string table
-                                            pred point metadata)))
-    (if (and result (consp (car result)))
-        ;; Give the completion styles some freedom!
-        ;; If they are targeting Emacs 28 upwards only, they
-        ;; may always return a result with deferred
-        ;; highlighting.  We convert back to the old format
-        ;; here by applying the highlighting eagerly.
-        (nconc (funcall (cdr (assq 'highlight result))
-                        (cdr (assq 'completions result)))
-               (cdr (assq 'base result)))
-      result)))
+  (completion--nth-completion 2 string table pred point metadata))
 
 (defun completion-filter-completions (string table pred point metadata)
   "Filter the possible completions of STRING in completion table TABLE.
@@ -1152,9 +1148,8 @@ completion-filter-completions
 - completions: The list of completions.
 
 This function supersedes the function `completion-all-completions'."
-  (let* ((completion--filter-completions t)
-         (result (completion--nth-completion 2 string table
-                                             pred point metadata)))
+  (let* ((result (completion--nth-completion 2 string table
+                                             pred point metadata 'filter)))
     (if (and result (not (consp (car result))))
         ;; Deferred highlighting has been requested, but the completion
         ;; style returned a non-deferred result. Convert the result to the
@@ -2118,10 +2113,10 @@ completion--hilit-commonality
      elem)
    completions))
 
-(defun completion--deferred-hilit (completions prefix-len base end)
+(defun completion--deferred-hilit (completions prefix-len base end filter)
   "Return completions in old format or new alist format.
-If `completion--filter-completions' is non-nil use the new format."
-  (if completion--filter-completions
+If FILTER is non-nil use the new format."
+  (if filter
       (when completions
         `((base . ,base)
           (end . ,end)
@@ -3300,12 +3295,14 @@ completion-emacs21-try-completion
         (cons completion (length completion))
       completion)))
 
-(defun completion-emacs21-all-completions (string table pred _point)
+(defun completion-emacs21-all-completions (string table pred _point
+                                                  &optional filter)
   (completion--deferred-hilit
    (all-completions string table pred)
    (length string)
    (car (completion-boundaries string table pred ""))
-   (length string)))
+   (length string)
+   filter))
 
 (defun completion-emacs22-try-completion (string table pred point)
   (let ((suffix (substring string point))
@@ -3327,13 +3324,14 @@ completion-emacs22-try-completion
           (setq suffix (substring suffix 1)))
       (cons (concat completion suffix) (length completion)))))
 
-(defun completion-emacs22-all-completions (string table pred point)
+(defun completion-emacs22-all-completions (string table pred point
+                                                  &optional filter)
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))
          (bounds (completion-boundaries beforepoint table pred afterpoint)))
     (completion--deferred-hilit
      (all-completions beforepoint table pred)
-     point (car bounds) (+ point (cdr bounds)))))
+     point (car bounds) (+ point (cdr bounds)) filter)))
 
 ;;; Basic completion.
 
@@ -3381,7 +3379,8 @@ completion-basic-try-completion
             (setq all (completion-pcm--filename-try-filter all)))
         (completion-pcm--merge-try pattern all prefix suffix)))))
 
-(defun completion-basic-all-completions (string table pred point)
+(defun completion-basic-all-completions (string table pred point
+                                                &optional filter)
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))
          (bounds (completion-boundaries beforepoint table pred afterpoint))
@@ -3392,7 +3391,9 @@ completion-basic-all-completions
                             'point
                             (substring afterpoint 0 (cdr bounds)))))
          (all (completion-pcm--all-completions prefix pattern table pred)))
-    (completion--deferred-hilit all point (car bounds) (+ point (cdr bounds)))))
+    (completion--deferred-hilit all point
+                                (car bounds) (+ point (cdr bounds))
+                                filter)))
 
 ;;; Partial-completion-mode style completion.
 
@@ -3584,11 +3585,11 @@ flex-score-match-tightness
 than the latter (which has two \"holes\" and three
 one-letter-long matches).")
 
-(defun completion-pcm--deferred-hilit (pattern completions base end)
+(defun completion-pcm--deferred-hilit (pattern completions base end filter)
   "Return completions in old format or new alist format.
-If `completion--filter-completions' is non-nil use the new format."
+If FILTER is non-nil use the new format."
   (when completions
-    (if completion--filter-completions
+    (if filter
         `((base . ,base)
           (end . ,end)
           (highlight . ,(apply-partially
@@ -3839,12 +3840,14 @@ completion-pcm--find-all-completions
           (signal (car firsterror) (cdr firsterror))
         (list pattern all prefix suffix)))))
 
-(defun completion-pcm-all-completions (string table pred point)
+(defun completion-pcm-all-completions (string table pred point
+                                              &optional filter)
   (pcase-let ((`(,pattern ,all ,prefix ,suffix)
                (completion-pcm--find-all-completions string table pred point)))
     (completion-pcm--deferred-hilit pattern all
                                     (length prefix)
-                                    (- (length string) (length suffix)))))
+                                    (- (length string) (length suffix))
+                                    filter)))
 
 (defun completion--common-suffix (strs)
   "Return the common suffix of the strings STRS."
@@ -4067,13 +4070,15 @@ completion-substring-try-completion
         (setq all (completion-pcm--filename-try-filter all)))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
-(defun completion-substring-all-completions (string table pred point)
+(defun completion-substring-all-completions (string table pred point
+                                                    &optional filter)
   (pcase-let ((`(,all ,pattern ,prefix ,suffix)
                (completion-substring--all-completions
                 string table pred point)))
     (completion-pcm--deferred-hilit pattern all
                                     (length prefix)
-                                    (- (length string) (length suffix)))))
+                                    (- (length string) (length suffix))
+                                    filter)))
 
 ;;; "flex" completion, also known as flx/fuzzy/scatter completion
 ;; Completes "foo" to "frodo" and "farfromsober"
@@ -4152,7 +4157,8 @@ completion-flex-try-completion
       ;; "farfromsober".
       (completion-pcm--merge-try pattern all prefix suffix))))
 
-(defun completion-flex-all-completions (string table pred point)
+(defun completion-flex-all-completions (string table pred point
+                                               &optional filter)
   "Get flex-completions of STRING in TABLE, given PRED and POINT."
   (unless (and completion-flex-nospace (string-search " " string))
     (pcase-let ((`(,all ,pattern ,prefix ,suffix)
@@ -4161,7 +4167,8 @@ completion-flex-all-completions
                   #'completion-flex--make-flex-pattern)))
       (completion-pcm--deferred-hilit pattern all
                                     (length prefix)
-                                    (- (length string) (length suffix))))))
+                                    (- (length string) (length suffix))
+                                    filter))))
 
 ;; Initials completion
 ;; Complete /ums to /usr/monnier/src or lch to list-command-history.
@@ -4195,14 +4202,16 @@ completion-initials-expand
             (concat (substring str 0 (car bounds))
                     (mapconcat 'string (substring str (car bounds)) sep))))))))
 
-(defun completion-initials-all-completions (string table pred _point)
+(defun completion-initials-all-completions (string table pred _point
+                                                   &optional filter)
   (let ((newstr (completion-initials-expand string table pred)))
     (when newstr
       (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
                    (completion-pcm--find-all-completions newstr table
                                                          pred (length newstr))))
         (completion-pcm--deferred-hilit pattern all
-                                        (length prefix) (length string))))))
+                                        (length prefix) (length string)
+                                        filter)))))
 
 (defun completion-initials-try-completion (string table pred _point)
   (let ((newstr (completion-initials-expand string table pred)))
-- 
2.20.1