feature/shorthand-namespacing 881478b 10/11: Consider shorthands in Elisp's elisp-completion-at-point

[João Távora]

branch: feature/shorthand-namespacing
commit 881478bca93efd5acbb08b3a9df7a7ccebef514a
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    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.
---
 lisp/progmodes/elisp-mode.el                       | 77 +++++++++++++++++-----
 src/lread.c                                        |  2 +
 .../elisp-resources/magnars-string-user.el         | 33 ++++++++++
 3 files changed, 96 insertions(+), 16 deletions(-)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a6fb759..4d33c87 100644
--- 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 424d7ac..c68c04e 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);
 }
 
@@ -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
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: