From 90cbf0cb8d9959b94ba09f1faa0dcb50c8dbddbd Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Tue, 21 Sep 2021 22:20:17 +0100 Subject: [PATCH] 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. --- lisp/progmodes/elisp-mode.el | 83 +++++++++++++++---- src/lread.c | 2 + test/lisp/progmodes/elisp-mode-tests.el | 16 ++++ .../elisp-resources/simple-shorthand-test.el | 2 + 4 files changed, 87 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4a0abb74b3f..d2ea25d67b0 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -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 \"\" 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)) " ")) :company-kind #'elisp--company-kind @@ -607,8 +658,8 @@ functions are annotated with \"\" 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 \"\" 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 \"\" via the (up-list -1)) (forward-symbol -1) (looking-at "\\_")))) - (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 diff --git a/src/lread.c b/src/lread.c index 4b7fcc2875b..51a7084821e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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"); } diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index d5d3f336fac..9fe583d8cc3 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -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 diff --git a/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el b/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el index 5634926c6d2..cadcb4de89d 100644 --- a/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el +++ b/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el @@ -14,6 +14,8 @@ (let ((elisp-shorthands '(("foo-" . "bar-")))) (intern "foo-bar"))) +(defvar f-test-complete-me 42) + (when nil (f-test3) (f-test2) -- 2.39.2