From: Dmitry Gutov Date: Sat, 27 Dec 2014 14:06:37 +0000 (+0200) Subject: elisp-xref-find: Don't create buffers eagerly X-Git-Tag: emacs-25.0.90~2631^2~15^2~22 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6d14e0d361cfb3589874fe1b559e30b4fd3eb284;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5a42e506d35..5829ec2fae5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2014-12-27 Dmitry Gutov + + 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 * minibuffer.el (minibuffer-completion-help): diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index c372117b104..e1586a96716 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 ef619f0899a..347560a484e 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)) " ")) :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 21c0d6aa6a4..8221aebd871 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