Commit 67a29115 authored by Stefan Monnier's avatar Stefan Monnier

* 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.
parent 8f22251e
Pipeline #4248 failed with stage
in 90 minutes
......@@ -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.
;; (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.
......@@ -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))
(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))
(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))
(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)))
table 'fetch-matches (list pre pattern session))
(let ((completion-regexp-list nil))
(all-completions (concat pre pattern) table)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment