scratch/completion-api 67a2911: * lisp/emacs-lisp/cl-generic.el: Fix bootstrap.

[Stefan Monnier]

branch: scratch/completion-api
commit 67a29115ba7748629cf6a1ba41f28e25195d1958
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/emacs-lisp/cl-generic.el: Fix bootstrap.
    
    Most importantly, prefill dispatchers for the new minibuffer.el methods.
    
    * lisp/minibuffer.el (completion-table-category): Return both the
    category and the default style.
    (completion-table--call-method): New function.
    (completion-table-test, completion-table-category)
    (completion-table-boundaries, completion-table-fetch-matches): Use it.
---
 lisp/emacs-lisp/cl-generic.el | 10 +++++++++-
 lisp/minibuffer.el            | 42 ++++++++++++++++++++++++++++--------------
 2 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b0173dc..1c4b3fc 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -593,7 +593,12 @@ The set of acceptable TYPEs (also called \"specializers\") 
is defined
       ;; FIXME: For generic functions with a single method (or with 2 methods,
       ;; one of which always matches), using a tagcode + hash-table is
       ;; overkill: better just use a `cl-typep' test.
-      (byte-compile
+      (funcall
+       ;; (featurep 'cl-generic) is only nil when we're called from
+       ;; cl--generic-prefill-dispatchers during the dump, at which
+       ;; point it's not worth loading the byte-compiler.
+       (if (featurep 'cl-generic)
+           #'byte-compile (lambda (exp) (eval (macroexpand-all exp) 'lexical)))
        `(lambda (generic dispatches-left methods)
           (let ((method-cache (make-hash-table :test #'eql)))
             (lambda (,@fixedargs &rest args)
@@ -1117,6 +1122,9 @@ These match if the argument is `eql' to VAL."
                                  (eql nil))
 (cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection)
                                  (eql nil))
+;; For lisp/minibuffer.el.
+(cl--generic-prefill-dispatchers 1 (head regexp))
+(cl--generic-prefill-dispatchers 0 (head old-styles-api))
 
 ;;; Support for cl-defstructs specializers.
 
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 10c7e64..2dc340e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3736,22 +3736,39 @@ the minibuffer was activated, and execute the forms."
 ;;   not a completion-table feature.
 ;; - The methods should not be affected by `completion-regexp-list'.
 
+;; TODO:
+;; - Async support (maybe via a `completion-table-fetch-async' method)
+;; - Support try-completion filtering (maybe by having fetch-matches
+;;   return a filtering function to be applied for try-completion).
+
+(defun completion-table--call-method (table methodname args)
+  (if (functionp table)
+      (funcall table methodname args)
+    (signal 'wrong-number-of-arguments nil)))
+
 (cl-defgeneric completion-table-test (table string)
   (condition-case nil
-      (if (functionp table)
-          (funcall table 'test (list string))
-        (with-suppressed-warnings ((callargs car)) (car)))
+      (completion-table--call-method table 'test (list string))
     (wrong-number-of-arguments
      (test-completion string table))))
 
 (cl-defgeneric completion-table-category (table string)
+  "Return a description of the kind of completion taking place.
+Return value should be either nil or of the form (CATEGORY . ALIST) where
+CATEGORY should be a symbol (such as ‘buffer’ and ‘file’, used when
+completing buffer and file names, respectively).
+ALIST specifies the default settings to use for that category among:
+- ‘styles’: the list of ‘completion-styles’ to use for that category.
+- ‘cycle’: the ‘completion-cycle-threshold’ to use for that category."
   (condition-case nil
-      (if (functionp table)
-          (funcall table 'category ())
-        (with-suppressed-warnings ((callargs car)) (car)))
+      (completion-table--call-method table 'category (list string))
     (wrong-number-of-arguments
-     (let ((md (completion-metadata string table nil)))
-       (alist-get 'category md)))))
+     (let ((category
+            (let ((md (completion-metadata string table nil)))
+              (alist-get 'category md))))
+       (when category
+         (cons category
+               (alist-get category completion-category-defaults)))))))
 
 (cl-defgeneric completion-table-boundaries (table string point)
   ;; FIXME: We should return an additional information to indicate
@@ -3781,9 +3798,7 @@ E.g. for simple completion tables, the result is always 
(0 . (length STRING))
 and for file names the result is the positions delimited by
 the closest directory separators."
   (condition-case nil
-      (if (functionp table)
-          (funcall table 'boundaries (list string point))
-        (with-suppressed-warnings ((callargs car)) (car)))
+      (completion-table--call-method table 'boundaries (list string point))
     (wrong-number-of-arguments
      (pcase-let ((`(,prepos . ,postpos)
                   (completion-boundaries (substring string 0 point) table nil
@@ -3805,9 +3820,8 @@ Return either a list of strings or an alist whose `car's 
are strings."
    (let ((len (length pre)))
      (equal (completion-table-boundaries table pre len) (cons len len))))
   (condition-case nil
-      (if (functionp table)
-          (funcall table 'fetch-matches (list pre pattern session))
-        (with-suppressed-warnings ((callargs car)) (car)))
+      (completion-table--call-method
+       table 'fetch-matches (list pre pattern session))
     (wrong-number-of-arguments
      (let ((completion-regexp-list nil))
        (all-completions (concat pre pattern) table)))))