[Emacs-diffs] master 6d14e0d: elisp-xref-find: Don't create buffers eagerly

[Dmitry Gutov]

branch: master
commit 6d14e0d361cfb3589874fe1b559e30b4fd3eb284
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    elisp-xref-find: Don't create buffers eagerly
    
    * lisp/emacs-lisp/find-func.el (find-function-library): New function,
    extracted from `find-function-noselect'.
    
    * lisp/progmodes/elisp-mode.el (elisp--identifier-location): Fold back
    into `elisp--company-location'.
    (elisp--identifier-completion-table): Rename to
    `elisp--identifier-completion-table', and do not include just any
    symbols with a property list.
    (elisp-completion-at-point): Revert the 2014-12-25 change.
    (elisp--xref-identifier-file): New function.
    (elisp--xref-find-definitions): Use it.
    
    * lisp/progmodes/xref.el (xref-elisp-location): New class.
    (xref-make-elisp-location): New function.
    (xref-location-marker): New implementation.
---
 lisp/ChangeLog               |   20 +++++++++
 lisp/emacs-lisp/find-func.el |   59 ++++++++++++++++-----------
 lisp/progmodes/elisp-mode.el |   90 +++++++++++++++++++++++-------------------
 lisp/progmodes/xref.el       |   25 ++++++++++++
 4 files changed, 129 insertions(+), 65 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5a42e50..5829ec2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,23 @@
+2014-12-27  Dmitry Gutov  <address@hidden>
+
+       elisp-xref-find: Don't create buffers eagerly.
+
+       * progmodes/elisp-mode.el (elisp--identifier-location): Fold back
+       into `elisp--company-location'.
+       (elisp--identifier-completion-table): Rename to
+       `elisp--identifier-completion-table', and do not include just any
+       symbols with a property list.
+       (elisp-completion-at-point): Revert the 2014-12-25 change.
+       (elisp--xref-identifier-file): New function.
+       (elisp--xref-find-definitions): Use it.
+
+       * emacs-lisp/find-func.el (find-function-library): New function,
+       extracted from `find-function-noselect'.
+
+       * progmodes/xref.el (xref-elisp-location): New class.
+       (xref-make-elisp-location): New function.
+       (xref-location-marker): New implementation.
+
 2014-12-27  Juri Linkov  <address@hidden>
 
        * minibuffer.el (minibuffer-completion-help):
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index c372117..e1586a9 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -311,6 +311,39 @@ The search is done in the source for library LIBRARY."
                  (cons (current-buffer) (point)))
              (cons (current-buffer) nil))))))))
 
+(defun find-function-library (function &optional lisp-only verbose)
+  "Return the library FUNCTION is defined in.
+
+If FUNCTION is a built-in function and LISP-ONLY is non-nil,
+signal an error.
+
+If VERBOSE is non-nil, and FUNCTION is an alias, display a
+message about the whole chain of aliases."
+  (let ((def (symbol-function (find-function-advised-original function)))
+        aliases)
+    ;; FIXME for completeness, it might be nice to print something like:
+    ;; foo (which is advised), which is an alias for bar (which is advised).
+    (while (symbolp def)
+      (or (eq def function)
+          (not verbose)
+          (if aliases
+              (setq aliases (concat aliases
+                                    (format ", which is an alias for `%s'"
+                                            (symbol-name def))))
+            (setq aliases (format "`%s' is an alias for `%s'"
+                                  function (symbol-name def)))))
+      (setq function (symbol-function (find-function-advised-original 
function))
+            def (symbol-function (find-function-advised-original function))))
+    (if aliases
+        (message "%s" aliases))
+    (cond
+     ((autoloadp def) (nth 1 def))
+     ((subrp def)
+      (if lisp-only
+          (error "%s is a built-in function" function))
+      (help-C-file-name def 'subr))
+     ((symbol-file function 'defun)))))
+
 ;;;###autoload
 (defun find-function-noselect (function &optional lisp-only)
   "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
@@ -329,30 +362,8 @@ searched for in `find-function-source-path' if non-nil, 
otherwise
 in `load-path'."
   (if (not function)
     (error "You didn't specify a function"))
-  (let ((def (symbol-function (find-function-advised-original function)))
-       aliases)
-    ;; FIXME for completeness, it might be nice to print something like:
-    ;; foo (which is advised), which is an alias for bar (which is advised).
-    (while (symbolp def)
-      (or (eq def function)
-         (if aliases
-             (setq aliases (concat aliases
-                                   (format ", which is an alias for `%s'"
-                                           (symbol-name def))))
-           (setq aliases (format "`%s' is an alias for `%s'"
-                                 function (symbol-name def)))))
-      (setq function (symbol-function (find-function-advised-original 
function))
-           def (symbol-function (find-function-advised-original function))))
-    (if aliases
-       (message "%s" aliases))
-    (let ((library
-          (cond ((autoloadp def) (nth 1 def))
-                ((subrp def)
-                 (if lisp-only
-                     (error "%s is a built-in function" function))
-                 (help-C-file-name def 'subr))
-                ((symbol-file function 'defun)))))
-      (find-function-search-for-symbol function nil library))))
+  (let ((library (find-function-library function lisp-only t)))
+    (find-function-search-for-symbol function nil library)))
 
 (defun find-function-read (&optional type)
   "Read and return an interned symbol, defaulting to the one near point.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ef619f0..347560a 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -418,40 +418,19 @@ It can be quoted, or be inside a quoted form."
          (match-string 0 doc))))
 
 (declare-function find-library-name "find-func" (library))
-
-(defvar elisp--identifier-types '(defun defvar feature defface))
-
-(defun elisp--identifier-location (type sym)
-  (pcase (cons type sym)
-    (`(defun . ,(pred fboundp))
-     (find-definition-noselect sym nil))
-    (`(defvar . ,(pred boundp))
-     (find-definition-noselect sym 'defvar))
-    (`(defface . ,(pred facep))
-     (find-definition-noselect sym 'defface))
-    (`(feature . ,(pred featurep))
-     (require 'find-func)
-     (cons (find-file-noselect (find-library-name
-                                (symbol-name sym)))
-           1))))
+(declare-function find-function-library "find-func" (function &optional l-o v))
 
 (defun elisp--company-location (str)
-  (catch 'res
-    (let ((sym (intern-soft str)))
-      (when sym
-        (dolist (type elisp--identifier-types)
-          (let ((loc (elisp--identifier-location type sym)))
-            (and loc (throw 'res loc))))))))
-
-(defvar elisp--identifier-completion-table
-  (apply-partially #'completion-table-with-predicate
-                   obarray
-                   (lambda (sym)
-                     (or (boundp sym)
-                         (fboundp sym)
-                         (featurep sym)
-                         (symbol-plist sym)))
-                   'strict))
+  (let ((sym (intern-soft str)))
+    (cond
+     ((fboundp sym) (find-definition-noselect sym nil))
+     ((boundp sym) (find-definition-noselect sym 'defvar))
+     ((featurep sym)
+      (require 'find-func)
+      (cons (find-file-noselect (find-library-name
+                                 (symbol-name sym)))
+            0))
+     ((facep sym) (find-definition-noselect sym 'defface)))))
 
 (defun elisp-completion-at-point ()
   "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
@@ -493,8 +472,13 @@ It can be quoted, or be inside a quoted form."
                            :company-docsig #'elisp--company-doc-string
                            :company-location #'elisp--company-location))
                     ((elisp--form-quoted-p beg)
-                     ;; Don't include all symbols (bug#16646).
-                     (list nil elisp--identifier-completion-table
+                     (list nil obarray
+                           ;; Don't include all symbols (bug#16646).
+                           :predicate (lambda (sym)
+                                        (or (boundp sym)
+                                            (fboundp sym)
+                                            (featurep sym)
+                                            (symbol-plist sym)))
                            :annotation-function
                            (lambda (str) (if (fboundp (intern-soft str)) " 
<f>"))
                            :company-doc-buffer #'elisp--company-doc-buffer
@@ -572,11 +556,12 @@ It can be quoted, or be inside a quoted form."
 
 ;;; Xref backend
 
-(declare-function xref-make-buffer-location "xref" (buffer position))
+(declare-function xref-make-elisp-location "xref" (symbol type file))
 (declare-function xref-make-bogus-location "xref" (message))
 (declare-function xref-make "xref" (description location))
 
 (defun elisp-xref-find (action id)
+  (require 'find-func)
   (pcase action
     (`definitions
       (let ((sym (intern-soft id)))
@@ -585,16 +570,29 @@ It can be quoted, or be inside a quoted form."
     (`apropos
      (elisp--xref-find-apropos id))))
 
+(defun elisp--xref-identifier-file (type sym)
+  (pcase type
+    (`defun (when (fboundp sym)
+              (find-function-library sym)))
+    (`defvar (when (boundp sym)
+               (or (symbol-file sym 'defvar)
+                   (help-C-file-name sym 'var))))
+    (`feature (when (featurep sym)
+                (find-library-name (symbol-name sym))))
+    (`defface (when (facep sym)
+                (symbol-file sym 'defface)))))
+
 (defun elisp--xref-find-definitions (symbol)
   (save-excursion
     (let (lst)
-      (dolist (type elisp--identifier-types)
+      (dolist (type '(feature defface defvar defun))
         (let ((loc
                (condition-case err
-                   (let ((buf-pos (elisp--identifier-location type symbol)))
-                     (when buf-pos
-                       (xref-make-buffer-location (car buf-pos)
-                                                  (or (cdr buf-pos) 1))))
+                   (let ((file (elisp--xref-identifier-file type symbol)))
+                     (when file
+                       (when (string-match-p "\\.elc\\'" file)
+                         (setq file (substring file 0 -1)))
+                       (xref-make-elisp-location symbol type file)))
                  (error
                   (xref-make-bogus-location (error-message-string err))))))
           (when loc
@@ -611,8 +609,18 @@ It can be quoted, or be inside a quoted form."
             (push (elisp--xref-find-definitions sym) lst))
            (nreverse lst))))
 
+(defvar elisp--xref-identifier-completion-table
+  (apply-partially #'completion-table-with-predicate
+                   obarray
+                   (lambda (sym)
+                     (or (boundp sym)
+                         (fboundp sym)
+                         (featurep sym)
+                         (facep sym)))
+                   'strict))
+
 (defun elisp--xref-identifier-completion-table ()
-  elisp--identifier-completion-table)
+  elisp--xref-identifier-completion-table)
 
 ;;; Elisp Interaction mode
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 21c0d6a..8221aeb 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -136,6 +136,31 @@ actual location is not known.")
 
 (defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
 
+;; This should be in elisp-mode.el, but it's preloaded, and we can't
+;; preload defclass and defmethod (at least, not yet).
+(defclass xref-elisp-location (xref-location)
+  ((symbol :type symbol :initarg :symbol)
+   (type   :type symbol :initarg :type)
+   (file   :type string :initarg :file
+           :reader xref-location-group))
+  :documentation "Location of an Emacs Lisp symbol definition.")
+
+(defun xref-make-elisp-location (symbol type file)
+  (make-instance 'xref-elisp-location :symbol symbol :type type :file file))
+
+(defmethod xref-location-marker ((l xref-elisp-location))
+  (with-slots (symbol type file) l
+    (let ((buffer-point
+           (pcase type
+             (`defun (find-function-search-for-symbol symbol nil file))
+             ((or `defvar `defface)
+              (find-function-search-for-symbol symbol type file))
+             (`feature
+              (cons (find-file-noselect file) 1)))))
+      (with-current-buffer (car buffer-point)
+        (goto-char (or (cdr buffer-point) (point-min)))
+        (point-marker)))))
+
 
 ;;; Cross-reference