+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):
(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.
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.
(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'."
: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
;;; 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)))
(`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
(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
(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)))))
+
\f
;;; Cross-reference
projects / emacs.git / commitdiff