;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;; Commentary:
+;; NOTE: The xref API is still experimental and can change in major,
+;; backward-incompatible ways. Everyone is encouraged to try it, and
+;; report to us any problems or use cases we hadn't anticipated, by
+;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
+;;
;; This file provides a somewhat generic infrastructure for cross
;; referencing commands, in particular "find-definition".
;;
(require 'semantic/symref)) ;; for hit-lines slot
(defgroup xref nil "Cross-referencing commands"
+ :version "25.1"
:group 'tools)
\f
\f
;;; API
-;; We make the etags backend the default for now, until something
-;; better comes along.
-(defvar xref-backend-functions (list #'xref--etags-backend)
+(defvar xref-backend-functions nil
"Special hook to find the xref backend for the current context.
-Each functions on this hook is called in turn with no arguments
+Each function on this hook is called in turn with no arguments,
and should return either nil to mean that it is not applicable,
or an xref backend, which is a value to be used to dispatch the
generic functions.")
+;; We make the etags backend the default for now, until something
+;; better comes along. Use APPEND so that any `add-hook' calls made
+;; before this package is loaded put new items before this one.
+(add-hook 'xref-backend-functions #'etags--xref-backend t)
+
+;;;###autoload
(defun xref-find-backend ()
(run-hook-with-args-until-success 'xref-backend-functions))
-(defun xref--etags-backend () 'etags)
-
(cl-defgeneric xref-backend-definitions (backend identifier)
"Find definitions of IDENTIFIER.
To create an xref object, call `xref-make'.")
-(cl-defgeneric xref-backend-references (backend identifier)
+(cl-defgeneric xref-backend-references (_backend identifier)
"Find references of IDENTIFIER.
The result must be a list of xref objects. If no references can
-be found, return nil.")
+be found, return nil.
+
+The default implementation uses `semantic-symref-tool-alist' to
+find a search tool; by default, this uses \"find | grep\" in the
+`project-current' roots."
+ (cl-mapcan
+ (lambda (dir)
+ (xref-collect-references identifier dir))
+ (let ((pr (project-current t)))
+ (append
+ (project-roots pr)
+ (project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
"Find all symbols that match PATTERN.
(interactive)
(let ((ring xref--marker-ring))
(when (ring-empty-p ring)
- (error "Marker stack is empty"))
+ (user-error "Marker stack is empty"))
(let ((marker (ring-remove ring 0)))
(switch-to-buffer (or (marker-buffer marker)
- (error "The marked buffer has been deleted")))
+ (user-error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
(set-marker marker nil nil)
(run-hooks 'xref-after-return-hook))))
(xref--pop-to-location xref window)))
(defun xref-query-replace (from to)
- "Perform interactive replacement in all current matches."
+ "Perform interactive replacement of FROM with TO in all displayed xrefs.
+
+This command interactively replaces FROM with TO in the names of the
+references displayed in the current *xref* buffer."
(interactive
- (list (read-regexp "Query replace regexp in matches" ".*")
- (read-regexp "Replace with: ")))
- (let (pairs item)
+ (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
+ (list fr
+ (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
+ (let ((reporter (make-progress-reporter (format "Saving search results...")
+ 0 (line-number-at-pos (point-max))))
+ (counter 0)
+ pairs item)
(unwind-protect
(progn
(save-excursion
(goto-char (point-min))
+ ;; TODO: This list should be computed on-demand instead.
+ ;; As long as the UI just iterates through matches one by
+ ;; one, there's no need to compute them all in advance.
+ ;; Then we can throw away the reporter.
(while (setq item (xref--search-property 'xref-item))
(when (xref-match-length item)
(save-excursion
(let* ((loc (xref-item-location item))
(beg (xref-location-marker loc))
- (len (xref-match-length item)))
+ (end (move-marker (make-marker)
+ (+ beg (xref-match-length item))
+ (marker-buffer beg))))
;; Perform sanity check first.
(xref--goto-location loc)
;; FIXME: The check should probably be a generic
(line-end-position))
(xref-item-summary item))
(user-error "Search results out of date"))
- (push (cons beg len) pairs)))))
+ (progress-reporter-update reporter (cl-incf counter))
+ (push (cons beg end) pairs)))))
(setq pairs (nreverse pairs)))
(unless pairs (user-error "No suitable matches here"))
+ (progress-reporter-done reporter)
(xref--query-replace-1 from to pairs))
(dolist (pair pairs)
- (move-marker (car pair) nil)))))
+ (move-marker (car pair) nil)
+ (move-marker (cdr pair) nil)))))
;; FIXME: Write a nicer UI.
(defun xref--query-replace-1 (from to pairs)
(let* ((query-replace-lazy-highlight nil)
- current-beg current-len current-buf
+ current-beg current-end current-buf
;; Counteract the "do the next match now" hack in
;; `perform-replace'. And still, it'll report that those
;; matches were "filtered out" at the end.
(and current-beg
(eq (current-buffer) current-buf)
(>= beg current-beg)
- (<= end (+ current-beg current-len)))))
+ (<= end current-end))))
(replace-re-search-function
(lambda (from &optional _bound noerror)
(let (found pair)
(while (and (not found) pairs)
(setq pair (pop pairs)
current-beg (car pair)
- current-len (cdr pair)
+ current-end (cdr pair)
current-buf (marker-buffer current-beg))
(pop-to-buffer current-buf)
(goto-char current-beg)
- (when (re-search-forward from (+ current-beg current-len) noerror)
+ (when (re-search-forward from current-end noerror)
(setq found t)))
found))))
;; FIXME: Despite this being a multi-buffer replacement, `N'
(defvar xref--read-pattern-history nil)
-(defun xref--show-xrefs (xrefs window)
+(defun xref--show-xrefs (xrefs window &optional always-show-list)
(cond
- ((not (cdr xrefs))
+ ((and (not (cdr xrefs)) (not always-show-list))
(xref-push-marker-stack)
(xref--pop-to-location (car xrefs) window))
(t
With prefix argument or when there's no identifier at point,
prompt for it.
-If the backend has sufficient information to determine a unique
-definition for IDENTIFIER, it returns only that definition. If
-there are multiple possible definitions, it returns all of them.
-
-If the backend returns one definition, jump to it; otherwise,
-display the list in a buffer."
+If sufficient information is available to determine a unique
+definition for IDENTIFIER, display it in the selected window.
+Otherwise, display the list of the possible definitions in a
+buffer where the user can select from the list."
(interactive (list (xref--read-identifier "Find definitions of: ")))
(xref--find-definitions identifier nil))
:lighter ""
(if xref-etags-mode
(progn
- (setq xref-etags-mode--saved
- (cons xref-find-function
- xref-identifier-completion-table-function))
- (kill-local-variable 'xref-find-function)
- (kill-local-variable 'xref-identifier-completion-table-function))
- (setq-local xref-find-function (car xref-etags-mode--saved))
- (setq-local xref-identifier-completion-table-function
- (cdr xref-etags-mode--saved))))
+ (setq xref-etags-mode--saved xref-backend-functions)
+ (kill-local-variable 'xref-backend-functions))
+ (setq-local xref-backend-functions xref-etags-mode--saved)))
(declare-function semantic-symref-find-references-by-name "semantic/symref")
(declare-function semantic-find-file-noselect "semantic/fw")
(mapc #'kill-buffer
(cl-set-difference (buffer-list) orig-buffers)))))
+;;;###autoload
(defun xref-collect-matches (regexp files dir ignores)
"Collect matches for REGEXP inside FILES in DIR.
FILES is a string with glob patterns separated by spaces.
IGNORES is a list of glob patterns."
- (cl-assert (directory-name-p dir))
+ ;; DIR can also be a regular file for now; let's not advertise that.
(require 'semantic/fw)
(grep-compute-defaults)
(defvar grep-find-template)
grep-find-template t t))
(grep-highlight-matches nil)
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
- files dir ignores))
+ files
+ (expand-file-name dir)
+ ignores))
(orig-buffers (buffer-list))
(buf (get-buffer-create " *xref-grep*"))
(grep-re (caar grep-regexp-alist))
+ (counter 0)
+ reporter
hits)
(with-current-buffer buf
(erase-buffer)
(push (cons (string-to-number (match-string 2))
(match-string 1))
hits)))
+ (setq reporter (make-progress-reporter
+ (format "Collecting search results...")
+ 0 (length hits)))
(unwind-protect
- (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp))
+ (cl-mapcan (lambda (hit)
+ (prog1
+ (progress-reporter-update reporter counter)
+ (cl-incf counter))
+ (xref--collect-matches hit regexp))
(nreverse hits))
+ (progress-reporter-done reporter)
;; TODO: Same as above.
(mapc #'kill-buffer
(cl-set-difference (buffer-list) orig-buffers)))))
" "
(shell-quote-argument ")"))
dir
- (concat
- (shell-quote-argument "(")
- " -path "
- (mapconcat
- (lambda (ignore)
- (when (string-match-p "/\\'" ignore)
- (setq ignore (concat ignore "*")))
- (if (string-match "\\`\\./" ignore)
- (setq ignore (replace-match dir t t ignore))
- (unless (string-prefix-p "*" ignore)
- (setq ignore (concat "*/" ignore))))
- (shell-quote-argument ignore))
- ignores
- " -o -path ")
- " "
- (shell-quote-argument ")")
- " -prune -o ")))
+ (xref--find-ignores-arguments ignores dir)))
+
+(defun xref--find-ignores-arguments (ignores dir)
+ ;; `shell-quote-argument' quotes the tilde as well.
+ (cl-assert (not (string-match-p "\\`~" dir)))
+ (when ignores
+ (concat
+ (shell-quote-argument "(")
+ " -path "
+ (mapconcat
+ (lambda (ignore)
+ (when (string-match-p "/\\'" ignore)
+ (setq ignore (concat ignore "*")))
+ (if (string-match "\\`\\./" ignore)
+ (setq ignore (replace-match dir t t ignore))
+ (unless (string-prefix-p "*" ignore)
+ (setq ignore (concat "*/" ignore))))
+ (shell-quote-argument ignore))
+ ignores
+ " -o -path ")
+ " "
+ (shell-quote-argument ")")
+ " -prune -o ")))
(defun xref--regexp-to-extended (str)
(replace-regexp-in-string