aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-12-04 22:35:07 -0500
committerStefan Monnier2019-12-04 22:35:07 -0500
commit67a29115ba7748629cf6a1ba41f28e25195d1958 (patch)
tree8b14142800c1d53e8c099980eaaac7e7c214d8bc
parent8f22251e595d7598d6643b0d24bf5f409dc59fa8 (diff)
downloademacs-scratch/completion-api.tar.gz
emacs-scratch/completion-api.zip
* 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
593 ;; FIXME: For generic functions with a single method (or with 2 methods, 593 ;; FIXME: For generic functions with a single method (or with 2 methods,
594 ;; one of which always matches), using a tagcode + hash-table is 594 ;; one of which always matches), using a tagcode + hash-table is
595 ;; overkill: better just use a `cl-typep' test. 595 ;; overkill: better just use a `cl-typep' test.
596 (byte-compile 596 (funcall
597 ;; (featurep 'cl-generic) is only nil when we're called from
598 ;; cl--generic-prefill-dispatchers during the dump, at which
599 ;; point it's not worth loading the byte-compiler.
600 (if (featurep 'cl-generic)
601 #'byte-compile (lambda (exp) (eval (macroexpand-all exp) 'lexical)))
597 `(lambda (generic dispatches-left methods) 602 `(lambda (generic dispatches-left methods)
598 (let ((method-cache (make-hash-table :test #'eql))) 603 (let ((method-cache (make-hash-table :test #'eql)))
599 (lambda (,@fixedargs &rest args) 604 (lambda (,@fixedargs &rest args)
@@ -1117,6 +1122,9 @@ These match if the argument is `eql' to VAL."
1117 (eql nil)) 1122 (eql nil))
1118(cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection) 1123(cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection)
1119 (eql nil)) 1124 (eql nil))
1125;; For lisp/minibuffer.el.
1126(cl--generic-prefill-dispatchers 1 (head regexp))
1127(cl--generic-prefill-dispatchers 0 (head old-styles-api))
1120 1128
1121;;; Support for cl-defstructs specializers. 1129;;; Support for cl-defstructs specializers.
1122 1130
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."
3736;; not a completion-table feature. 3736;; not a completion-table feature.
3737;; - The methods should not be affected by `completion-regexp-list'. 3737;; - The methods should not be affected by `completion-regexp-list'.
3738 3738
3739;; TODO:
3740;; - Async support (maybe via a `completion-table-fetch-async' method)
3741;; - Support try-completion filtering (maybe by having fetch-matches
3742;; return a filtering function to be applied for try-completion).
3743
3744(defun completion-table--call-method (table methodname args)
3745 (if (functionp table)
3746 (funcall table methodname args)
3747 (signal 'wrong-number-of-arguments nil)))
3748
3739(cl-defgeneric completion-table-test (table string) 3749(cl-defgeneric completion-table-test (table string)
3740 (condition-case nil 3750 (condition-case nil
3741 (if (functionp table) 3751 (completion-table--call-method table 'test (list string))
3742 (funcall table 'test (list string))
3743 (with-suppressed-warnings ((callargs car)) (car)))
3744 (wrong-number-of-arguments 3752 (wrong-number-of-arguments
3745 (test-completion string table)))) 3753 (test-completion string table))))
3746 3754
3747(cl-defgeneric completion-table-category (table string) 3755(cl-defgeneric completion-table-category (table string)
3756 "Return a description of the kind of completion taking place.
3757Return value should be either nil or of the form (CATEGORY . ALIST) where
3758CATEGORY should be a symbol (such as ‘buffer’ and ‘file’, used when
3759completing buffer and file names, respectively).
3760ALIST specifies the default settings to use for that category among:
3761- ‘styles’: the list of ‘completion-styles’ to use for that category.
3762- ‘cycle’: the ‘completion-cycle-threshold’ to use for that category."
3748 (condition-case nil 3763 (condition-case nil
3749 (if (functionp table) 3764 (completion-table--call-method table 'category (list string))
3750 (funcall table 'category ())
3751 (with-suppressed-warnings ((callargs car)) (car)))
3752 (wrong-number-of-arguments 3765 (wrong-number-of-arguments
3753 (let ((md (completion-metadata string table nil))) 3766 (let ((category
3754 (alist-get 'category md))))) 3767 (let ((md (completion-metadata string table nil)))
3768 (alist-get 'category md))))
3769 (when category
3770 (cons category
3771 (alist-get category completion-category-defaults)))))))
3755 3772
3756(cl-defgeneric completion-table-boundaries (table string point) 3773(cl-defgeneric completion-table-boundaries (table string point)
3757 ;; FIXME: We should return an additional information to indicate 3774 ;; 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))
3781and for file names the result is the positions delimited by 3798and for file names the result is the positions delimited by
3782the closest directory separators." 3799the closest directory separators."
3783 (condition-case nil 3800 (condition-case nil
3784 (if (functionp table) 3801 (completion-table--call-method table 'boundaries (list string point))
3785 (funcall table 'boundaries (list string point))
3786 (with-suppressed-warnings ((callargs car)) (car)))
3787 (wrong-number-of-arguments 3802 (wrong-number-of-arguments
3788 (pcase-let ((`(,prepos . ,postpos) 3803 (pcase-let ((`(,prepos . ,postpos)
3789 (completion-boundaries (substring string 0 point) table nil 3804 (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."
3805 (let ((len (length pre))) 3820 (let ((len (length pre)))
3806 (equal (completion-table-boundaries table pre len) (cons len len)))) 3821 (equal (completion-table-boundaries table pre len) (cons len len))))
3807 (condition-case nil 3822 (condition-case nil
3808 (if (functionp table) 3823 (completion-table--call-method
3809 (funcall table 'fetch-matches (list pre pattern session)) 3824 table 'fetch-matches (list pre pattern session))
3810 (with-suppressed-warnings ((callargs car)) (car)))
3811 (wrong-number-of-arguments 3825 (wrong-number-of-arguments
3812 (let ((completion-regexp-list nil)) 3826 (let ((completion-regexp-list nil))
3813 (all-completions (concat pre pattern) table))))) 3827 (all-completions (concat pre pattern) table)))))