diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2019-12-04 22:35:07 -0500 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2019-12-04 22:35:07 -0500 |
| commit | 67a29115ba7748629cf6a1ba41f28e25195d1958 (patch) | |
| tree | 8b14142800c1d53e8c099980eaaac7e7c214d8bc | |
| parent | 8f22251e595d7598d6643b0d24bf5f409dc59fa8 (diff) | |
| download | emacs-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.el | 10 | ||||
| -rw-r--r-- | 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 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))))) |