mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-16 17:19:41 +00:00
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.
This commit is contained in:
parent
09d2e8477a
commit
6d14e0d361
@ -1,3 +1,23 @@
|
||||
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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user