Commit 6d14e0d3 authored by Dmitry Gutov's avatar Dmitry Gutov

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.
parent 09d2e847
2014-12-27 Dmitry Gutov <dgutov@yandex.ru>
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 <juri@linkov.net>
* minibuffer.el (minibuffer-completion-help):
......
......@@ -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.
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment