summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2019-12-04 22:35:07 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2019-12-04 22:35:07 -0500
commit67a29115ba7748629cf6a1ba41f28e25195d1958 (patch)
tree8b14142800c1d53e8c099980eaaac7e7c214d8bc
parent8f22251e595d7598d6643b0d24bf5f409dc59fa8 (diff)
downloademacs-scratch/completion-api.tar.gz
* lisp/emacs-lisp/cl-generic.el: Fix bootstrap.scratch/completion-api
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.
-rw-r--r--lisp/emacs-lisp/cl-generic.el10
-rw-r--r--lisp/minibuffer.el42
2 files changed, 37 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b0173dc991b..1c4b3fcd228 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 10c7e64df7e..2dc340e08c7 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)))))