Consider shorthands in Elisp's elisp-completion-at-point

* 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-resources/magnars-string-user.el: New
file to play around with `magnars-string` library.

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a6fb759973f90aaa3831f1ae8ef7ace9c58d4b06..4d33c87ad30b5dfb8f8c98d99aa42b6253fc7a14 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -535,6 +535,45 @@ It can be quoted, or be inside a quoted form."
             0))
      ((facep sym) (find-definition-noselect sym 'defface)))))
 
+(defun elisp--completion-local-symbols ()
+  "Compute list all Elisp symbols for completion purposes."
+  (let* ((calculate
+          (lambda ()
+            (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)))
+         (probe
+          (and obarray-cache
+               (gethash (cons (current-buffer) elisp-shorthands)
+                        obarray-cache))))
+    (cond (probe)
+          (obarray-cache
+           (puthash (cons (current-buffer) elisp-shorthands)
+                    (funcall calculate)
+                    obarray-cache))
+          (t
+           (setq obarray-cache (make-hash-table :test #'equal))
+           (puthash (cons (current-buffer) elisp-shorthands)
+                    (funcall calculate)
+                    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
@@ -582,24 +621,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
@@ -610,8 +652,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)
@@ -648,11 +690,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*)
@@ -662,14 +704,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
@@ -686,6 +728,9 @@ functions are annotated with \"<f>\" via the
                                        " " (cadr table-etc)))
                     (cddr table-etc)))))))))
 
+(defun elisp--fboundp-considering-shorthands (sym)
+  (fboundp (intern-soft (symbol-name sym))))
+
 (defun elisp--company-kind (str)
   (let ((sym (intern-soft str)))
     (cond

diff --git a/src/lread.c b/src/lread.c
index 424d7ac13e24a74e186320e2018eb55d41d32a9c..c68c04e572a089c18da401f77f69ea8ddd2fd210 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);
 }
 
@@ -5428,4 +5429,5 @@ that are loaded before your customizations are read!  */);
           doc: /* Alist of known symbol name shorthands*/);
   Velisp_shorthands = Qnil;
   DEFSYM (Qelisp_shorthands, "elisp-shorthands");
+  DEFSYM (Qobarray_cache, "obarray-cache");
 }

diff --git a/test/lisp/progmodes/elisp-resources/magnars-string-user.el b/test/lisp/progmodes/elisp-resources/magnars-string-user.el
new file mode 100644 (file)
index 0000000..430dc6f
--- /dev/null
+++ b/test/lisp/progmodes/elisp-resources/magnars-string-user.el
@@ -0,0 +1,33 @@
+;;; magnars-string-user.el --- playground file that uses magnars-string.el and shorthands -*- lexical-binding: t; -*-
+
+;; require this library
+(require 'magnars-string)
+
+;; can't live without these
+(show-paren-mode 1)
+(electric-pair-mode 1)
+
+;; will be useful later
+(flymake-mode 1)
+(add-hook 'emacs-lisp-mode-hook 'flymake-mode)
+
+;; just for geeks, watch the echo area when I eval this
+(benchmark-run 1 (elisp--completion-local-symbols))
+(intern (symbol-name (gensym)))
+(benchmark-run 1 (elisp--completion-local-symbols))
+
+(defun silly ()
+
+  )
+
+;; Things to demo:
+;; * C-M-i completion
+;; * Eldoc
+;; * M-. and then M-,
+;; * C-h f
+;; * Changing the shorthand, reload with M-x revert-buffer
+;; * Flymake
+
+;; Local Variables:
+;; elisp-shorthands: (("s-" . "magnars-string-"))
+;; End: