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.

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 4a0abb74b3f3205527fec02e3013d142cc61bf74..d2ea25d67b04675a4afeed0bd75704e15173d22e 100644 (file)
--- 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 \"<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

diff --git a/src/lread.c b/src/lread.c
index 4b7fcc2875b53d85f93ee4e3965422f9e56585f8..51a7084821e8875afd87b5ac8fbde2f48b2594ec 100644 (file)
--- 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 d5d3f336fac9ea04da2c90882837bfc5d06f13ce..9fe583d8cc32f9abe6af79af9d07dea9425e25f7 100644 (file)
--- 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 5634926c6d212983e2d5cc938c5cdd452ffeaed2..cadcb4de89d4fb8d6934994d5ed931c2f7894a64 100644 (file)
--- 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)