Commit 394ce951 authored by Dmitry Gutov's avatar Dmitry Gutov

Consolidate cross-referencing commands

Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and
`C-x 5 .' from etags.el to xref.el.

* progmodes/xref.el: New file.

* progmodes/elisp-mode.el (elisp--identifier-types): New variable.
(elisp--identifier-location): New function, extracted from
`elisp--company-location'.
(elisp--company-location): Use it.
(elisp--identifier-completion-table): New variable.
(elisp-completion-at-point): Use it.
(emacs-lisp-mode): Set the local values of `xref-find-function'
and `xref-identifier-completion-table-function'.
(elisp-xref-find, elisp--xref-find-definitions)
(elisp--xref-identifier-completion-table): New functions.

* progmodes/etags.el (find-tag-marker-ring): Mark obsolete in
favor of `xref--marker-ring'.
(tags-lazy-completion-table): Autoload.
(tags-reset-tags-tables): Use `xref-clear-marker-stack'.
(find-tag-noselect): Use `xref-push-marker-stack'.
(pop-tag-mark): Make an alias for `xref-pop-marker-stack'.
(etags--xref-limit): New constant.
(etags-xref-find, etags--xref-find-definitions): New functions.
parent ac549019
......@@ -434,6 +434,25 @@ By default, 32 spaces and four TABs are considered to be too much but
`tildify-ignored-environments-alist' variables (as well as a few
helper functions) obsolete.
** xref
The new package provides generic framework and new commands to find
and move to definitions, as well as pop back to the original location.
*** New key bindings
`xref-find-definitions' replaces `find-tag' and provides an interface
to pick one destination among several. Hence, `tags-toop-continue' is
unbound. `xref-pop-marker-stack' replaces `pop-tag-mark', but uses an
easier binding, which is now unoccupied (`M-,').
`xref-find-definitions-other-window' replaces `find-tag-other-window'.
`xref-find-definitions-other-frame' replaces `find-tag-other-frame'.
`xref-find-apropos' replaces `find-tag-regexp'.
*** New variables
`find-tag-marker-ring-length' is now an obsolete alias for
`xref-marker-ring-length'. `find-tag-marker-ring' is now an obsolete
alias for a private variable. `xref-push-marker-stack' and
`xref-pop-marker-stack' should be used to mutate it instead.
** Obsolete packages
---
......
2014-12-25 Helmut Eller <eller.helmut@gmail.com>
Dmitry Gutov <dgutov@yandex.ru>
Consolidate cross-referencing commands.
Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and
`C-x 5 .' from etags.el to xref.el.
* progmodes/xref.el: New file.
* progmodes/elisp-mode.el (elisp--identifier-types): New variable.
(elisp--identifier-location): New function, extracted from
`elisp--company-location'.
(elisp--company-location): Use it.
(elisp--identifier-completion-table): New variable.
(elisp-completion-at-point): Use it.
(emacs-lisp-mode): Set the local values of `xref-find-function'
and `xref-identifier-completion-table-function'.
(elisp-xref-find, elisp--xref-find-definitions)
(elisp--xref-identifier-completion-table): New functions.
* progmodes/etags.el (find-tag-marker-ring): Mark obsolete in
favor of `xref--marker-ring'.
(tags-lazy-completion-table): Autoload.
(tags-reset-tags-tables): Use `xref-clear-marker-stack'.
(find-tag-noselect): Use `xref-push-marker-stack'.
(pop-tag-mark): Make an alias for `xref-pop-marker-stack'.
(etags--xref-limit): New constant.
(etags-xref-find, etags--xref-find-definitions): New functions.
2014-12-25 Martin Rudalics <rudalics@gmx.at>
* cus-start.el (resize-mini-windows): Make it customizable.
......
......@@ -227,10 +227,15 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{emacs-lisp-mode-map}"
:group 'lisp
(defvar xref-find-function)
(defvar xref-identifier-completion-table-function)
(lisp-mode-variables nil nil 'elisp)
(setq imenu-case-fold-search nil)
(setq-local eldoc-documentation-function
#'elisp-eldoc-documentation-function)
(setq-local xref-find-function #'elisp-xref-find)
(setq-local xref-identifier-completion-table-function
#'elisp--xref-identifier-completion-table)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local))
......@@ -414,17 +419,39 @@ It can be quoted, or be inside a quoted form."
(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))))
(defun elisp--company-location (str)
(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)))))
(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))
(defun elisp-completion-at-point ()
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
......@@ -466,13 +493,8 @@ 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)
(list nil obarray
;; Don't include all symbols
;; (bug#16646).
:predicate (lambda (sym)
(or (boundp sym)
(fboundp sym)
(symbol-plist sym)))
;; Don't include all symbols (bug#16646).
(list nil elisp--identifier-completion-table
:annotation-function
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
:company-doc-buffer #'elisp--company-doc-buffer
......@@ -548,6 +570,38 @@ It can be quoted, or be inside a quoted form."
(define-obsolete-function-alias
'lisp-completion-at-point 'elisp-completion-at-point "25.1")
;;; Xref backend
(declare-function xref-make-buffer-location "xref" (buffer position))
(declare-function xref-make-bogus-location "xref" (message))
(declare-function xref-make "xref" (description location))
(defun elisp-xref-find (action id)
(when (eq action 'definitions)
(let ((sym (intern-soft id)))
(when sym
(remove nil (elisp--xref-find-definitions sym))))))
(defun elisp--xref-find-definitions (symbol)
(save-excursion
(mapcar
(lambda (type)
(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))))
(error
(xref-make-bogus-location (error-message-string err))))))
(when loc
(xref-make (format "(%s %s)" type symbol)
loc))))
elisp--identifier-types)))
(defun elisp--xref-identifier-completion-table ()
elisp--identifier-completion-table)
;;; Elisp Interaction mode
(defvar lisp-interaction-mode-map
......
......@@ -28,6 +28,7 @@
(require 'ring)
(require 'button)
(require 'xref)
;;;###autoload
(defvar tags-file-name nil
......@@ -141,11 +142,8 @@ Otherwise, `find-tag-default' is used."
:group 'etags
:type '(choice (const nil) function))
(defcustom find-tag-marker-ring-length 16
"Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
:group 'etags
:type 'integer
:version "20.3")
(define-obsolete-variable-alias 'find-tag-marker-ring-length
'xref-marker-ring-length "25.1")
(defcustom tags-tag-face 'default
"Face for tags in the output of `tags-apropos'."
......@@ -182,15 +180,18 @@ Example value:
(sexp :tag "Tags to search")))
:version "21.1")
(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
"Ring of markers which are locations from which \\[find-tag] was invoked.")
(defvaralias 'find-tag-marker-ring 'xref--marker-ring)
(make-obsolete-variable
'find-tag-marker-ring
"use `xref-push-marker-stack' or `xref-pop-marker-stack' instead."
"25.1")
(defvar default-tags-table-function nil
"If non-nil, a function to choose a default tags file for a buffer.
This function receives no arguments and should return the default
tags table file to use for the current buffer.")
(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
(defvar tags-location-ring (make-ring xref-marker-ring-length)
"Ring of markers which are locations visited by \\[find-tag].
Pop back to the last location with \\[negative-argument] \\[find-tag].")
......@@ -713,15 +714,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(interactive)
;; Clear out the markers we are throwing away.
(let ((i 0))
(while (< i find-tag-marker-ring-length)
(while (< i xref-marker-ring-length)
(if (aref (cddr tags-location-ring) i)
(set-marker (aref (cddr tags-location-ring) i) nil))
(if (aref (cddr find-tag-marker-ring) i)
(set-marker (aref (cddr find-tag-marker-ring) i) nil))
(setq i (1+ i))))
(xref-clear-marker-stack)
(setq tags-file-name nil
tags-location-ring (make-ring find-tag-marker-ring-length)
find-tag-marker-ring (make-ring find-tag-marker-ring-length)
tags-location-ring (make-ring xref-marker-ring-length)
tags-table-list nil
tags-table-computed-list nil
tags-table-computed-list-for nil
......@@ -780,6 +779,7 @@ tags table and its (recursively) included tags tables."
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
;;;###autoload
(defun tags-lazy-completion-table ()
(let ((buf (current-buffer)))
(lambda (string pred action)
......@@ -898,7 +898,7 @@ See documentation of variable `tags-file-name'."
;; Run the user's hook. Do we really want to do this for pop?
(run-hooks 'local-find-tag-hook))))
;; Record whence we came.
(ring-insert find-tag-marker-ring (point-marker))
(xref-push-marker-stack)
(if (and next-p last-tag)
;; Find the same table we last used.
(visit-tags-table-buffer 'same)
......@@ -954,7 +954,6 @@ See documentation of variable `tags-file-name'."
(switch-to-buffer buf)
(error (pop-to-buffer buf)))
(goto-char pos)))
;;;###autoload (define-key esc-map "." 'find-tag)
;;;###autoload
(defun find-tag-other-window (tagname &optional next-p regexp-p)
......@@ -995,7 +994,6 @@ See documentation of variable `tags-file-name'."
;; the window's point from the buffer.
(set-window-point (selected-window) tagpoint))
window-point)))
;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
;;;###autoload
(defun find-tag-other-frame (tagname &optional next-p)
......@@ -1020,7 +1018,6 @@ See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag other frame: "))
(let ((pop-up-frames t))
(find-tag-other-window tagname next-p)))
;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
;;;###autoload
(defun find-tag-regexp (regexp &optional next-p other-window)
......@@ -1044,25 +1041,10 @@ See documentation of variable `tags-file-name'."
;; We go through find-tag-other-window to do all the display hair there.
(funcall (if other-window 'find-tag-other-window 'find-tag)
regexp next-p t))
;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
;;;###autoload
(defun pop-tag-mark ()
"Pop back to where \\[find-tag] was last invoked.
(defalias 'pop-tag-mark 'xref-pop-marker-stack)
This is distinct from invoking \\[find-tag] with a negative argument
since that pops a stack of markers at which tags were found, not from
where they were found."
(interactive)
(if (ring-empty-p find-tag-marker-ring)
(error "No previous locations for find-tag invocation"))
(let ((marker (ring-remove find-tag-marker-ring 0)))
(switch-to-buffer (or (marker-buffer marker)
(error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
(set-marker marker nil nil)))
(defvar tag-lines-already-matched nil
"Matches remembered between calls.") ; Doc string: calls to what?
......@@ -1859,7 +1841,6 @@ nil, we exit; otherwise we scan the next file."
(and messaged
(null tags-loop-operate)
(message "Scanning file %s...found" buffer-file-name))))
;;;###autoload (define-key esc-map "," 'tags-loop-continue)
;;;###autoload
(defun tags-search (regexp &optional file-list-form)
......@@ -2077,6 +2058,54 @@ for \\[find-tag] (which see)."
(completion-in-region (car comp-data) (cadr comp-data)
(nth 2 comp-data)
(plist-get (nthcdr 3 comp-data) :predicate)))))
;;; Xref backend
;; Stop searching if we find more than xref-limit matches, as the xref
;; infrastracture is not designed to handle very long lists.
;; Switching to some kind of lazy list might be better, but hopefully
;; we hit the limit rarely.
(defconst etags--xref-limit 1000)
;;;###autoload
(defun etags-xref-find (action id)
(pcase action
(`definitions (etags--xref-find-definitions id))
(`apropos (etags--xref-find-definitions id t))))
(defun etags--xref-find-definitions (pattern &optional regexp?)
;; This emulates the behaviour of `find-tag-in-order' but instead of
;; returning one match at a time all matches are returned as list.
;; NOTE: find-tag-tag-order is typically a buffer-local variable.
(let* ((xrefs '())
(first-time t)
(search-fun (if regexp? #'re-search-forward #'search-forward))
(marks (make-hash-table :test 'equal))
(case-fold-search (if (memq tags-case-fold-search '(nil t))
tags-case-fold-search
case-fold-search)))
(save-excursion
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
(dolist (order-fun (cond (regexp? find-tag-regexp-tag-order)
(t find-tag-tag-order)))
(goto-char (point-min))
(while (and (funcall search-fun pattern nil t)
(< (hash-table-count marks) etags--xref-limit))
(when (funcall order-fun pattern)
(beginning-of-line)
(cl-destructuring-bind (hint line &rest pos) (etags-snarf-tag)
(unless (eq hint t) ; hint==t if we are in a filename line
(let* ((file (file-of-tag))
(mark-key (cons file line)))
(unless (gethash mark-key marks)
(let ((loc (xref-make-file-location
(expand-file-name file) line 0)))
(push (xref-make hint loc) xrefs)
(puthash mark-key t marks)))))))))))
(nreverse xrefs)))
(provide 'etags)
......
;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides a somewhat generic infrastructure for cross
;; referencing commands, in particular "find-definition".
;;
;; Some part of the functionality must be implemented in a language
;; dependent way and that's done by defining `xref-find-function',
;; `xref-identifier-at-point-function' and
;; `xref-identifier-completion-table-function', which see.
;;
;; A major mode should make these variables buffer-local first.
;;
;; `xref-find-function' can be called in several ways, see its
;; description. It has to operate with "xref" and "location" values.
;;
;; One would usually call `make-xref' and `xref-make-file-location',
;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
;; them.
;;
;; Each identifier must be represented as a string. Implementers can
;; use string properties to store additional information about the
;; identifier, but they should keep in mind that values returned from
;; `xref-identifier-completion-table-function' should still be
;; distinct, because the user can't see the properties when making the
;; choice.
;;
;; See the functions `etags-xref-find' and `elisp-xref-find' for full
;; examples.
;;; Code:
(require 'cl-lib)
(require 'eieio)
(require 'ring)
(defgroup xref nil "Cross-referencing commands"
:group 'tools)
;;; Locations
(defclass xref-location () ()
:documentation "A location represents a position in a file or buffer.")
;; If a backend decides to subclass xref-location it can provide
;; methods for some of the following functions:
(defgeneric xref-location-marker (location)
"Return the marker for LOCATION.")
(defgeneric xref-location-group (location)
"Return a string used to group a set of locations.
This is typically the filename.")
;;;; Commonly needed location classes are defined here:
;; FIXME: might be useful to have an optional "hint" i.e. a string to
;; search for in case the line number is sightly out of date.
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
(line :type fixnum :initarg :line)
(column :type fixnum :initarg :column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
(defun xref-make-file-location (file line column)
"Create and return a new xref-file-location."
(make-instance 'xref-file-location :file file :line line :column column))
(defmethod xref-location-marker ((l xref-file-location))
(with-slots (file line column) l
(with-current-buffer
(or (get-file-buffer file)
(let ((find-file-suppress-same-file-warnings t))
(find-file-noselect file)))
(save-restriction
(widen)
(save-excursion
(goto-char (point-min))
(beginning-of-line line)
(move-to-column column)
(point-marker))))))
(defmethod xref-location-group ((l xref-file-location))
(oref l :file))
(defclass xref-buffer-location (xref-location)
((buffer :type buffer :initarg :buffer)
(position :type fixnum :initarg :position)))
(defun xref-make-buffer-location (buffer position)
"Create and return a new xref-buffer-location."
(make-instance 'xref-buffer-location :buffer buffer :position position))
(defmethod xref-location-marker ((l xref-buffer-location))
(with-slots (buffer position) l
(let ((m (make-marker)))
(move-marker m position buffer))))
(defmethod xref-location-group ((l xref-buffer-location))
(with-slots (buffer) l
(or (buffer-file-name buffer)
(format "(buffer %s)" (buffer-name buffer)))))
(defclass xref-bogus-location (xref-location)
((message :type string :initarg :message
:reader xref-bogus-location-message))
:documentation "Bogus locations are sometimes useful to
indicate errors, e.g. when we know that a function exists but the
actual location is not known.")
(defun xref-make-bogus-location (message)
"Create and return a new xref-bogus-location."
(make-instance 'xref-bogus-location :message message))
(defmethod xref-location-marker ((l xref-bogus-location))
(user-error "%s" (oref l :message)))
(defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
;;; Cross-reference
(defclass xref--xref ()
((description :type string :initarg :description
:reader xref--xref-description)
(location :type xref-location :initarg :location
:reader xref--xref-location))
:comment "An xref is used to display and locate constructs like
variables or functions.")
(defun xref-make (description location)
"Create and return a new xref.
DESCRIPTION is a short string to describe the xref.
LOCATION is an `xref-location'."
(make-instance 'xref--xref :description description :location location))
;;; API
(declare-function etags-xref-find "etags" (action id))
(declare-function tags-lazy-completion-table "etags" ())
;; For now, make the etags backend the default.
(defvar xref-find-function #'etags-xref-find
"Function to look for cross-references.
It can be called in several ways:
(definitions IDENTIFIER): Find definitions of IDENTIFIER. The
result must be a list of xref objects. If no definitions can be
found, return nil.
(references IDENTIFIER): Find references of IDENTIFIER. The
result must be a list of xref objects. If no references can be
found, return nil.
(apropos PATTERN): Find all symbols that match PATTERN. PATTERN
is a regexp.
IDENTIFIER can be any string returned by
`xref-identifier-at-point-function', or from the table returned
by `xref-identifier-completion-table-function'.
To create an xref object, call `xref-make'.")
(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
"Function to get the relevant identifier at point.
The return value must be a string or nil. nil means no
identifier at point found.
If it's hard to determinte the identifier precisely (e.g. because
it's a method call on unknown type), the implementation can
return a simple string (such as symbol at point) marked with a
special text property which `xref-find-function' would recognize
and then delegate the work to an external process.")
(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
"Function that returns the completion table for identifiers.")
(defun xref-default-identifier-at-point ()
(let ((thing (thing-at-point 'symbol)))
(and thing (substring-no-properties thing))))
;;; misc utilities
(defun xref--alistify (list key test)
"Partition the elements of LIST into an alist.
KEY extracts the key from an element and TEST is used to compare
keys."
(let ((alist '()))
(dolist (e list)
(let* ((k (funcall key e))
(probe (cl-assoc k alist :test test)))
(if probe
(setcdr probe (cons e (cdr probe)))
(push (cons k (list e)) alist))))
;; Put them back in order.
(cl-loop for (key . value) in (reverse alist)
collect (cons key (reverse value)))))
(defun xref--insert-propertized (props &rest strings)
"Insert STRINGS with text properties PROPS."
(let ((start (point)))
(apply #'insert strings)
(add-text-properties start (point) props)))
(defun xref--search-property (property &optional backward)
"Search the next text range where text property PROPERTY is non-nil.
Return the value of PROPERTY. If BACKWARD is non-nil, search
backward."
(let ((next (if backward
#'previous-single-char-property-change
#'next-single-char-property-change))
(start (point))
(value nil))
(while (progn
(goto-char (funcall next (point) property))
(not (or (setq value (get-text-property (point) property))
(eobp)
(bobp)))))
(cond (value)
(t (goto-char start) nil))))
;;; Marker stack (M-. pushes, M-, pops)
(defcustom xref-marker-ring-length 16
"Length of the xref marker ring."
:type 'integer
:version "25.1")
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
"Ring of markers to implement the marker stack.")
(defun xref-push-marker-stack ()
"Add point to the marker stack."
(ring-insert xref--marker-ring (point-marker)))
;;;###autoload