mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-03 14:10:47 -08:00
Consider shorthands in Elisp's elisp-completion-at-point
Instead of referencing obarray directly, that function has to consider a collection of completions which includes the shorthand versions of some of the symbols. That collection changes from buffer to buffer, depending on the choice of elisp-shorthands. To make this process efficient, and avoid needless recalculation of the above collection, a new obarray-specific cache was invented. The Elisp variable obarray-cache is immediately nullified if something touches the obarray. * lisp/progmodes/elisp-mode.el : New helper. (elisp-completion-at-point): Use new helpers. (elisp--completion-local-symbols) (elisp--fboundp-considering-shorthands) (elisp--bboundp-considering-shorthands): New helpers * src/lread.c (intern_driver): Nullify Qobarray_cache. (syms_of_lread): Add Qobarray_cache. * test/lisp/progmodes/elisp-mode-tests.el (elisp-shorthand-completion-at-point): New test. * test/lisp/progmodes/elisp-resources/simple-shorthand-test.el (f-test-complete-me): New fixture.
This commit is contained in:
João Távora
parent
68d73eb154
commit
90cbf0cb8d
4 changed files with 87 additions and 16 deletions
|
|
@ -532,6 +532,54 @@ It can be quoted, or be inside a quoted form."
|
|||
0))
|
||||
((facep sym) (find-definition-noselect sym 'defface)))))
|
||||
|
||||
(defvar obarray-cache nil
|
||||
"Hash table of obarray-related cache, or nil.
|
||||
If non-nil this variable is a hash-table holding information
|
||||
specific to the current state of the Elisp obarray. If the
|
||||
obarray changes by any means (interning or uninterning a symbol),
|
||||
the variable is immediately set to nil.")
|
||||
|
||||
(defun elisp--completion-local-symbols ()
|
||||
"Compute collections all Elisp symbols for completion purposes.
|
||||
The return value is compatible with the COLLECTION form described
|
||||
in `completion-at-point-functions' (which see)."
|
||||
(cl-flet ((obarray-plus-shorthands ()
|
||||
(let (retval)
|
||||
(mapatoms
|
||||
(lambda (s)
|
||||
(push s retval)
|
||||
(cl-loop
|
||||
for (shorthand . longhand) in elisp-shorthands
|
||||
for full-name = (symbol-name s)
|
||||
when (string-prefix-p longhand full-name)
|
||||
do (let ((sym (make-symbol
|
||||
(concat shorthand
|
||||
(substring full-name
|
||||
(length longhand))))))
|
||||
(put sym 'shorthand t)
|
||||
(push sym retval)
|
||||
retval))))
|
||||
retval)))
|
||||
(cond ((null elisp-shorthands) obarray)
|
||||
((and obarray-cache
|
||||
(gethash (cons (current-buffer) elisp-shorthands)
|
||||
obarray-cache)))
|
||||
(obarray-cache
|
||||
(puthash (cons (current-buffer) elisp-shorthands)
|
||||
(obarray-plus-shorthands)
|
||||
obarray-cache))
|
||||
(t
|
||||
(setq obarray-cache (make-hash-table :test #'equal))
|
||||
(puthash (cons (current-buffer) elisp-shorthands)
|
||||
(obarray-plus-shorthands)
|
||||
obarray-cache)))))
|
||||
|
||||
(defun elisp--shorthand-aware-fboundp (sym)
|
||||
(fboundp (intern-soft (symbol-name sym))))
|
||||
|
||||
(defun elisp--shorthand-aware-boundp (sym)
|
||||
(boundp (intern-soft (symbol-name sym))))
|
||||
|
||||
(defun elisp-completion-at-point ()
|
||||
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'.
|
||||
If the context at point allows only a certain category of
|
||||
|
|
@ -579,24 +627,27 @@ functions are annotated with \"<f>\" via the
|
|||
;; the current form and use it to provide a more
|
||||
;; specific completion table in more cases.
|
||||
((eq fun-sym 'ignore-error)
|
||||
(list t obarray
|
||||
(list t (elisp--completion-local-symbols)
|
||||
:predicate (lambda (sym)
|
||||
(get sym 'error-conditions))))
|
||||
((elisp--expect-function-p beg)
|
||||
(list nil obarray
|
||||
:predicate #'fboundp
|
||||
(list nil (elisp--completion-local-symbols)
|
||||
:predicate
|
||||
#'elisp--shorthand-aware-fboundp
|
||||
:company-kind #'elisp--company-kind
|
||||
:company-doc-buffer #'elisp--company-doc-buffer
|
||||
:company-docsig #'elisp--company-doc-string
|
||||
:company-location #'elisp--company-location))
|
||||
(quoted
|
||||
(list nil obarray
|
||||
(list nil (elisp--completion-local-symbols)
|
||||
;; Don't include all symbols (bug#16646).
|
||||
:predicate (lambda (sym)
|
||||
(or (boundp sym)
|
||||
(fboundp sym)
|
||||
(featurep sym)
|
||||
(symbol-plist sym)))
|
||||
;; shorthand-aware
|
||||
(let ((sym (intern-soft (symbol-name sym))))
|
||||
(or (boundp sym)
|
||||
(fboundp sym)
|
||||
(featurep sym)
|
||||
(symbol-plist sym))))
|
||||
:annotation-function
|
||||
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
|
||||
:company-kind #'elisp--company-kind
|
||||
|
|
@ -607,8 +658,8 @@ functions are annotated with \"<f>\" via the
|
|||
(list nil (completion-table-merge
|
||||
elisp--local-variables-completion-table
|
||||
(apply-partially #'completion-table-with-predicate
|
||||
obarray
|
||||
#'boundp
|
||||
(elisp--completion-local-symbols)
|
||||
#'elisp--shorthand-aware-boundp
|
||||
'strict))
|
||||
:company-kind
|
||||
(lambda (s)
|
||||
|
|
@ -645,11 +696,11 @@ functions are annotated with \"<f>\" via the
|
|||
(ignore-errors
|
||||
(forward-sexp 2)
|
||||
(< (point) beg)))))
|
||||
(list t obarray
|
||||
(list t (elisp--completion-local-symbols)
|
||||
:predicate (lambda (sym) (get sym 'error-conditions))))
|
||||
;; `ignore-error' with a list CONDITION parameter.
|
||||
('ignore-error
|
||||
(list t obarray
|
||||
(list t (elisp--completion-local-symbols)
|
||||
:predicate (lambda (sym)
|
||||
(get sym 'error-conditions))))
|
||||
((and (or ?\( 'let 'let*)
|
||||
|
|
@ -659,14 +710,14 @@ functions are annotated with \"<f>\" via the
|
|||
(up-list -1))
|
||||
(forward-symbol -1)
|
||||
(looking-at "\\_<let\\*?\\_>"))))
|
||||
(list t obarray
|
||||
:predicate #'boundp
|
||||
(list t (elisp--completion-local-symbols)
|
||||
:predicate #'elisp--shorthand-aware-boundp
|
||||
:company-kind (lambda (_) 'variable)
|
||||
:company-doc-buffer #'elisp--company-doc-buffer
|
||||
:company-docsig #'elisp--company-doc-string
|
||||
:company-location #'elisp--company-location))
|
||||
(_ (list nil obarray
|
||||
:predicate #'fboundp
|
||||
(_ (list nil (elisp--completion-local-symbols)
|
||||
:predicate #'elisp--shorthand-aware-fboundp
|
||||
:company-kind #'elisp--company-kind
|
||||
:company-doc-buffer #'elisp--company-doc-buffer
|
||||
:company-docsig #'elisp--company-doc-string
|
||||
|
|
|
|||
|
|
@ -4356,6 +4356,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
|
|||
Lisp_Object
|
||||
intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
|
||||
{
|
||||
SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
|
||||
return intern_sym (Fmake_symbol (string), obarray, index);
|
||||
}
|
||||
|
||||
|
|
@ -5427,4 +5428,5 @@ that are loaded before your customizations are read! */);
|
|||
DEFVAR_LISP ("elisp-shorthands", Velisp_shorthands,
|
||||
doc: /* Alist of known symbol name shorthands*/);
|
||||
Velisp_shorthands = Qnil;
|
||||
DEFSYM (Qobarray_cache, "obarray-cache");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1080,5 +1080,21 @@ evaluation of BODY."
|
|||
(should (intern-soft "elisp--foo-test"))
|
||||
(should-not (intern-soft "f-test"))))
|
||||
|
||||
(ert-deftest elisp-shorthand-completion-at-point ()
|
||||
(let ((test-file (expand-file-name "simple-shorthand-test.el"
|
||||
elisp--test-resources-dir)))
|
||||
(load test-file)
|
||||
(with-current-buffer (find-file-noselect test-file)
|
||||
(revert-buffer t t)
|
||||
(goto-char (point-min))
|
||||
(insert "f-test-compl")
|
||||
(completion-at-point)
|
||||
(goto-char (point-min))
|
||||
(should (search-forward "f-test-complete-me" (line-end-position) t))
|
||||
(goto-char (point-min))
|
||||
(should (string= (symbol-name (read (current-buffer)))
|
||||
"elisp--foo-test-complete-me"))
|
||||
(revert-buffer t t))))
|
||||
|
||||
(provide 'elisp-mode-tests)
|
||||
;;; elisp-mode-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -14,6 +14,8 @@
|
|||
(let ((elisp-shorthands '(("foo-" . "bar-"))))
|
||||
(intern "foo-bar")))
|
||||
|
||||
(defvar f-test-complete-me 42)
|
||||
|
||||
(when nil
|
||||
(f-test3)
|
||||
(f-test2)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue