;; 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".
;;
;; 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.
+;; dependent way and that's done by defining an xref backend.
+;;
+;; That consists of a constructor function, which should return a
+;; backend value, and a set of implementations for the generic
+;; functions:
;;
-;; A major mode should make these variables buffer-local first.
+;; `xref-backend-identifier-at-point',
+;; `xref-backend-identifier-completion-table',
+;; `xref-backend-definitions', `xref-backend-references',
+;; `xref-backend-apropos', which see.
;;
-;; `xref-find-function' can be called in several ways, see its
-;; description. It has to operate with "xref" and "location" values.
+;; A major mode would normally use `add-hook' to add the backend
+;; constructor to `xref-backend-functions'.
+;;
+;; The last three methods 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
;; class inheriting from `xref-location' and implementing
;; `xref-location-group' and `xref-location-marker'.
;;
+;; There's a special kind of xrefs we call "match xrefs", which
+;; correspond to search results. For these values,
+;; `xref-match-length' must be defined, and `xref-location-marker'
+;; must return the beginning of the match.
+;;
;; 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
+;; `xref-backend-identifier-completion-table' 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.
+;; See the etags and elisp-mode implementations for full examples.
;;; Code:
(require 'pcase)
(require 'project)
+(eval-when-compile
+ (require 'semantic/symref)) ;; for hit-lines slot
+
(defgroup xref nil "Cross-referencing commands"
+ :version "25.1"
:group 'tools)
\f
"Return the line number corresponding to the location."
nil)
-(cl-defgeneric xref-match-bounds (_item)
- "Return a cons with columns of the beginning and end of the match."
+(cl-defgeneric xref-match-length (_item)
+ "Return the length of the match."
nil)
;;;; Commonly needed location classes are defined here:
(save-excursion
(goto-char (point-min))
(beginning-of-line line)
- (move-to-column column)
+ (forward-char column)
(point-marker))))))
(cl-defmethod xref-location-group ((l xref-file-location))
(location :initarg :location
:type xref-file-location
:reader xref-item-location)
- (end-column :initarg :end-column))
- :comment "An xref item describes a reference to a location
-somewhere.")
+ (length :initarg :length :reader xref-match-length))
+ :comment "A match xref item describes a search result.")
-(cl-defmethod xref-match-bounds ((i xref-match-item))
- (with-slots (end-column location) i
- (cons (xref-file-location-column location)
- end-column)))
-
-(defun xref-make-match (summary end-column location)
+(defun xref-make-match (summary location length)
"Create and return a new `xref-match-item'.
SUMMARY is a short string to describe the xref.
-END-COLUMN is the match end column number inside SUMMARY.
-LOCATION is an `xref-location'."
- (make-instance 'xref-match-item :summary summary :location location
- :end-column end-column))
+LOCATION is an `xref-location'.
+LENGTH is the match length, in characters."
+ (make-instance 'xref-match-item :summary summary
+ :location location :length length))
\f
;;; API
-(declare-function etags-xref-find "etags" (action id))
-(declare-function tags-lazy-completion-table "etags" ())
+(defvar xref-backend-functions nil
+ "Special hook to find the xref backend for the current context.
+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.")
-;; 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:
+;; 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)
- (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
-result must be a list of xref objects. If IDENTIFIER contains
-sufficient information to determine a unique definition, returns
-only that definition. If there are multiple possible definitions,
-return all of them. If no definitions can be found, return nil.
+;;;###autoload
+(defun xref-find-backend ()
+ (run-hook-with-args-until-success 'xref-backend-functions))
- (references IDENTIFIER): Find references of IDENTIFIER. The
-result must be a list of xref objects. If no references can be
-found, return nil.
+(cl-defgeneric xref-backend-definitions (backend identifier)
+ "Find definitions of IDENTIFIER.
- (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
-is a regexp.
+The result must be a list of xref objects. If IDENTIFIER
+contains sufficient information to determine a unique definition,
+return only that definition. If there are multiple possible
+definitions, return all of them. If no definitions can be found,
+return nil.
IDENTIFIER can be any string returned by
-`xref-identifier-at-point-function', or from the table returned
-by `xref-identifier-completion-table-function'.
+`xref-backend-identifier-at-point', or from the table returned by
+`xref-backend-identifier-completion-table'.
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.
+(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.
+
+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.
+PATTERN is a regexp")
+
+(cl-defgeneric xref-backend-identifier-at-point (_backend)
+ "Return 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 determine 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 ()
+special text property which e.g. `xref-backend-definitions' would
+recognize and then delegate the work to an external process."
(let ((thing (thing-at-point 'symbol)))
(and thing (substring-no-properties thing))))
+(cl-defgeneric xref-backend-identifier-completion-table (backend)
+ "Returns the completion table for identifiers.")
+
\f
;;; misc utilities
(defun xref--alistify (list key test)
(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))))
(pcase-let ((`(,beg . ,end)
(save-excursion
(or
- (xref--match-buffer-bounds xref--current-item)
+ (let ((length (xref-match-length xref--current-item)))
+ (and length (cons (point) (+ (point) length))))
(back-to-indentation)
(if (eolp)
(cons (line-beginning-position) (1+ (point)))
(cons (point) (line-end-position)))))))
(pulse-momentary-highlight-region beg end 'next-error)))
-(defun xref--match-buffer-bounds (item)
- (save-excursion
- (let ((bounds (xref-match-bounds item)))
- (when bounds
- (cons (progn (move-to-column (car bounds))
- (point))
- (progn (move-to-column (cdr bounds))
- (point)))))))
-
;; etags.el needs this
(defun xref-clear-marker-stack ()
"Discard all markers from the marker stack."
(set-buffer (marker-buffer marker))
(xref--goto-char marker)))
-(defun xref--pop-to-location (item &optional window)
+(defun xref--pop-to-location (item &optional action)
"Go to the location of ITEM and display the buffer.
-WINDOW controls how the buffer is displayed:
+ACTION controls how the buffer is displayed:
nil -- switch-to-buffer
`window' -- pop-to-buffer (other window)
- `frame' -- pop-to-buffer (other frame)"
+ `frame' -- pop-to-buffer (other frame)
+If SELECT is non-nil, select the target window."
(let* ((marker (save-excursion
(xref-location-marker (xref-item-location item))))
(buf (marker-buffer marker)))
- (cl-ecase window
+ (cl-ecase action
((nil) (switch-to-buffer buf))
(window (pop-to-buffer buf t))
(frame (let ((pop-up-frames t)) (pop-to-buffer buf t))))
;;; XREF buffer (part of the UI)
;; The xref buffer is used to display a set of xrefs.
+(defconst xref-buffer-name "*xref*"
+ "The name of the buffer to show xrefs.")
-(defvar-local xref--display-history nil
- "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
-
-(defvar-local xref--temporary-buffers nil
- "List of buffers created by xref code.")
-
-(defvar-local xref--current nil
- "Non-nil if this buffer was once current, except while displaying xrefs.
-Used for temporary buffers.")
-
-(defvar xref--inhibit-mark-current nil)
-
-(defun xref--mark-selected ()
- (unless xref--inhibit-mark-current
- (setq xref--current t))
- (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
-
-(defun xref--save-to-history (buf win)
- (let ((restore (window-parameter win 'quit-restore)))
- ;; Save the new entry if the window displayed another buffer
- ;; previously.
- (when (and restore (not (eq (car restore) 'same)))
- (push (cons buf win) xref--display-history))))
-
-(defun xref--display-position (pos other-window buf)
- ;; Show the location, but don't hijack focus.
- (let ((xref-buf (current-buffer)))
- (with-selected-window (display-buffer buf other-window)
+(defmacro xref--with-dedicated-window (&rest body)
+ `(let* ((xref-w (get-buffer-window xref-buffer-name))
+ (xref-w-dedicated (window-dedicated-p xref-w)))
+ (unwind-protect
+ (progn
+ (when xref-w
+ (set-window-dedicated-p xref-w 'soft))
+ ,@body)
+ (when xref-w
+ (set-window-dedicated-p xref-w xref-w-dedicated)))))
+
+(defun xref--show-pos-in-buf (pos buf select)
+ (let ((xref-buf (current-buffer))
+ win)
+ (with-selected-window
+ (xref--with-dedicated-window
+ (display-buffer buf))
(xref--goto-char pos)
(run-hooks 'xref-after-jump-hook)
- (let ((buf (current-buffer))
- (win (selected-window)))
+ (let ((buf (current-buffer)))
+ (setq win (selected-window))
(with-current-buffer xref-buf
- (setq-local other-window-scroll-buffer buf)
- (xref--save-to-history buf win))))))
+ (setq-local other-window-scroll-buffer buf))))
+ (when select
+ (select-window win))))
-(defun xref--show-location (location)
+(defun xref--show-location (location &optional select)
(condition-case err
- (let ((bl (buffer-list))
- (xref--inhibit-mark-current t)
- (marker (xref-location-marker location)))
- (let ((buf (marker-buffer marker)))
- (unless (memq buf bl)
- ;; Newly created.
- (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
- (push buf xref--temporary-buffers))
- (xref--display-position marker t buf)))
+ (let* ((marker (xref-location-marker location))
+ (buf (marker-buffer marker)))
+ (xref--show-pos-in-buf marker buf select))
(user-error (message (error-message-string err)))))
+(defvar-local xref--window nil
+ "The original window this xref buffer was created from.")
+
(defun xref-show-location-at-point ()
- "Display the source of xref at point in the other window, if any."
+ "Display the source of xref at point in the appropriate window, if any."
(interactive)
(let* ((xref (xref--item-at-point))
(xref--current-item xref))
(when xref
- (xref--show-location (xref-item-location xref)))))
+ ;; Try to avoid the window the current xref buffer was
+ ;; originally created from.
+ (if (window-live-p xref--window)
+ (with-selected-window xref--window
+ (xref--show-location (xref-item-location xref)))
+ (xref--show-location (xref-item-location xref))))))
(defun xref-next-line ()
- "Move to the next xref and display its source in the other window."
+ "Move to the next xref and display its source in the appropriate window."
(interactive)
(xref--search-property 'xref-item)
(xref-show-location-at-point))
(defun xref-prev-line ()
- "Move to the previous xref and display its source in the other window."
+ "Move to the previous xref and display its source in the appropriate window."
(interactive)
(xref--search-property 'xref-item t)
(xref-show-location-at-point))
(back-to-indentation)
(get-text-property (point) 'xref-item)))
-(defvar-local xref--window nil
- "ACTION argument to call `display-buffer' with.")
-
(defun xref-goto-xref ()
- "Jump to the xref on the current line and bury the xref buffer."
+ "Jump to the xref on the current line and select its window."
(interactive)
(let ((xref (or (xref--item-at-point)
- (user-error "No reference at point")))
- (window xref--window))
- (xref-quit)
- (xref--pop-to-location xref window)))
+ (user-error "No reference at point"))))
+ (xref--show-location (xref-item-location xref) t)))
+
+(defun xref-query-replace-in-results (from to)
+ "Perform interactive replacement of FROM with TO in all displayed xrefs.
-(defun xref-query-replace (from to)
- "Perform interactive replacement in all current matches."
+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: Check that none of the matches are out of date;
- ;; offer to re-scan otherwise. Note that saving the last
- ;; modification tick won't work, as long as not all of the
- ;; buffers are kept open.
+ ;; 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-bounds item)
+ (when (xref-match-length item)
(save-excursion
- ;; FIXME: Get rid of xref--goto-location, by making
- ;; xref-match-bounds return markers already.
- (xref--goto-location (xref-item-location item))
- (let ((bounds (xref--match-buffer-bounds item))
- (beg (make-marker))
- (end (make-marker)))
- (move-marker beg (car bounds))
- (move-marker end (cdr bounds))
+ (let* ((loc (xref-item-location item))
+ (beg (xref-location-marker loc))
+ (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
+ ;; function, instead of the assumption that all
+ ;; matches contain the full line as summary.
+ ;; TODO: Offer to re-scan otherwise.
+ (unless (equal (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))
+ (xref-item-summary item))
+ (user-error "Search results out of date"))
+ (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 (cdr pair) nil)))))
+;; FIXME: Write a nicer UI.
(defun xref--query-replace-1 (from to pairs)
(let* ((query-replace-lazy-highlight nil)
- current-pair 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.
(isearch-filter-predicate
(lambda (beg end)
- (and current-pair
+ (and current-beg
(eq (current-buffer) current-buf)
- (>= beg (car current-pair))
- (<= end (cdr current-pair)))))
+ (>= beg current-beg)
+ (<= end current-end))))
(replace-re-search-function
(lambda (from &optional _bound noerror)
- (let (found)
+ (let (found pair)
(while (and (not found) pairs)
- (setq current-pair (pop pairs)
- current-buf (marker-buffer (car current-pair)))
- (pop-to-buffer current-buf)
- (goto-char (car current-pair))
- (when (re-search-forward from (cdr current-pair) noerror)
+ (setq pair (pop pairs)
+ current-beg (car pair)
+ current-end (cdr pair)
+ current-buf (marker-buffer current-beg))
+ (xref--with-dedicated-window
+ (pop-to-buffer current-buf))
+ (goto-char current-beg)
+ (when (re-search-forward from current-end noerror)
(setq found t)))
found))))
;; FIXME: Despite this being a multi-buffer replacement, `N'
(defvar xref--xref-buffer-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [remap quit-window] #'xref-quit)
(define-key map (kbd "n") #'xref-next-line)
(define-key map (kbd "p") #'xref-prev-line)
- (define-key map (kbd "r") #'xref-query-replace)
+ (define-key map (kbd "r") #'xref-query-replace-in-results)
(define-key map (kbd "RET") #'xref-goto-xref)
(define-key map (kbd "C-o") #'xref-show-location-at-point)
;; suggested by Johan Claesson "to further reduce finger movement":
(dotimes (_ n)
(setq xref (xref--search-property 'xref-item backward)))
(cond (xref
- (xref--pop-to-location xref))
+ (xref--show-location (xref-item-location xref) t))
(t
(error "No %s xref" (if backward "previous" "next"))))))
-(defun xref-quit (&optional kill)
- "Bury temporarily displayed buffers, then quit the current window.
-
-If KILL is non-nil, kill all buffers that were created in the
-process of showing xrefs, and also kill the current buffer.
-
-The buffers that the user has otherwise interacted with in the
-meantime are preserved."
- (interactive "P")
- (let ((window (selected-window))
- (history xref--display-history))
- (setq xref--display-history nil)
- (pcase-dolist (`(,buf . ,win) history)
- (when (and (window-live-p win)
- (eq buf (window-buffer win)))
- (quit-window nil win)))
- (when kill
- (let ((xref--inhibit-mark-current t)
- kill-buffer-query-functions)
- (dolist (buf xref--temporary-buffers)
- (unless (buffer-local-value 'xref--current buf)
- (kill-buffer buf)))
- (setq xref--temporary-buffers nil)))
- (quit-window kill window)))
-
-(defconst xref-buffer-name "*xref*"
- "The name of the buffer to show xrefs.")
-
(defvar xref--button-map
(let ((map (make-sparse-keymap)))
(define-key map [(control ?m)] #'xref-goto-xref)
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(setq xref--window (assoc-default 'window alist))
- (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
- (dolist (buf xref--temporary-buffers)
- (with-current-buffer buf
- (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
(current-buffer)))))
\f
;; This part of the UI seems fairly uncontroversial: it reads the
;; identifier and deals with the single definition case.
+;; (FIXME: do we really want this case to be handled like that in
+;; "find references" and "find regexp searches"?)
;;
;; The controversial multiple definitions case is handed off to
;; xref-show-xrefs-function.
(defvar xref--read-pattern-history nil)
-(defun xref--show-xrefs (input kind arg window)
- (let* ((bl (buffer-list))
- (xrefs (funcall xref-find-function kind arg))
- (tb (cl-set-difference (buffer-list) bl)))
- (cond
- ((null xrefs)
- (user-error "No %s found for: %s" (symbol-name kind) input))
- ((not (cdr xrefs))
- (xref-push-marker-stack)
- (xref--pop-to-location (car xrefs) window))
- (t
- (xref-push-marker-stack)
- (funcall xref-show-xrefs-function xrefs
- `((window . ,window)
- (temporary-buffers . ,tb)))))))
+(defun xref--show-xrefs (xrefs display-action &optional always-show-list)
+ (cond
+ ((and (not (cdr xrefs)) (not always-show-list))
+ (xref-push-marker-stack)
+ (xref--pop-to-location (car xrefs) display-action))
+ (t
+ (xref-push-marker-stack)
+ (funcall xref-show-xrefs-function xrefs
+ `((window . ,(selected-window)))))))
(defun xref--prompt-p (command)
(or (eq xref-prompt-for-identifier t)
(defun xref--read-identifier (prompt)
"Return the identifier at point or read it from the minibuffer."
- (let ((id (funcall xref-identifier-at-point-function)))
+ (let* ((backend (xref-find-backend))
+ (id (xref-backend-identifier-at-point backend)))
(cond ((or current-prefix-arg
(not id)
(xref--prompt-p this-command))
"[ :]+\\'" prompt))
id)
prompt)
- (funcall xref-identifier-completion-table-function)
+ (xref-backend-identifier-completion-table backend)
nil nil nil
'xref--read-identifier-history id))
(t id))))
\f
;;; Commands
-(defun xref--find-definitions (id window)
- (xref--show-xrefs id 'definitions id window))
+(defun xref--find-xrefs (input kind arg display-action)
+ (let ((xrefs (funcall (intern (format "xref-backend-%s" kind))
+ (xref-find-backend)
+ arg)))
+ (unless xrefs
+ (user-error "No %s found for: %s" (symbol-name kind) input))
+ (xref--show-xrefs xrefs display-action)))
+
+(defun xref--find-definitions (id display-action)
+ (xref--find-xrefs id 'definitions id display-action))
;;;###autoload
(defun xref-find-definitions (identifier)
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))
"Find references to the identifier at point.
With prefix argument, prompt for the identifier."
(interactive (list (xref--read-identifier "Find references of: ")))
- (xref--show-xrefs identifier 'references identifier nil))
-
-;; TODO: Rename and move to project-find-regexp, as soon as idiomatic
-;; usage of xref from other packages has stabilized.
-;;;###autoload
-(defun xref-find-regexp (regexp)
- "Find all matches for REGEXP.
-With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for."
- (interactive (list (xref--read-identifier "Find regexp: ")))
- (require 'grep)
- (let* ((proj (project-current))
- (files (if current-prefix-arg
- (grep-read-files regexp)
- "*"))
- (dirs (if current-prefix-arg
- (list (read-directory-name "Base directory: "
- nil default-directory t))
- (project-prune-directories
- (append
- (project-roots proj)
- (project-search-path proj)))))
- (xref-find-function
- (lambda (_kind regexp)
- (cl-mapcan
- (lambda (dir)
- (xref-collect-matches regexp files dir
- (project-ignores proj dir)))
- dirs))))
- (xref--show-xrefs regexp 'matches regexp nil)))
+ (xref--find-xrefs identifier 'references identifier nil))
(declare-function apropos-parse-pattern "apropos" (pattern))
"Search for pattern (word list or regexp): "
nil 'xref--read-pattern-history)))
(require 'apropos)
- (xref--show-xrefs pattern 'apropos
+ (xref--find-xrefs pattern 'apropos
(apropos-parse-pattern
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
: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))))
-
-(declare-function semantic-symref-find-references-by-name "semantic/symref")
-(declare-function semantic-find-file-noselect "semantic/fw")
-(declare-function grep-read-files "grep")
+ (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-instantiate "semantic/symref")
+(declare-function semantic-symref-perform-search "semantic/symref")
(declare-function grep-expand-template "grep")
+(defvar ede-minor-mode) ;; ede.el
(defun xref-collect-references (symbol dir)
"Collect references to SYMBOL inside DIR.
This function uses the Semantic Symbol Reference API, see
-`semantic-symref-find-references-by-name' for details on which
-tools are used, and when."
+`semantic-symref-tool-alist' for details on which tools are used,
+and when."
(cl-assert (directory-name-p dir))
(require 'semantic/symref)
(defvar semantic-symref-tool)
- (let* ((default-directory dir)
+
+ ;; Some symref backends use `ede-project-root-directory' as the root
+ ;; directory for the search, rather than `default-directory'. Since
+ ;; the caller has specified `dir', we bind `ede-minor-mode' to nil
+ ;; to force the backend to use `default-directory'.
+ (let* ((ede-minor-mode nil)
+ (default-directory dir)
+ ;; FIXME: Remove CScope and Global from the recognized tools?
+ ;; The current implementations interpret the symbol search as
+ ;; "find all calls to the given function", but not function
+ ;; definition. And they return nothing when passed a variable
+ ;; name, even a global one.
(semantic-symref-tool 'detect)
- (res (semantic-symref-find-references-by-name symbol 'subdirs))
- (hits (and res (oref res hit-lines)))
- (orig-buffers (buffer-list)))
- (unwind-protect
- (delq nil
- (mapcar (lambda (hit) (xref--collect-match
- hit (format "\\_<%s\\_>" (regexp-quote symbol))))
- hits))
- (mapc #'kill-buffer
- (cl-set-difference (buffer-list) orig-buffers)))))
+ (case-fold-search nil)
+ (inst (semantic-symref-instantiate :searchfor symbol
+ :searchtype 'symbol
+ :searchscope 'subdirs
+ :resulttype 'line-and-text)))
+ (xref--convert-hits (semantic-symref-perform-search inst)
+ (format "\\_<%s\\_>" (regexp-quote symbol)))))
+;;;###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))
- (orig-buffers (buffer-list))
+ files
+ (expand-file-name dir)
+ ignores))
(buf (get-buffer-create " *xref-grep*"))
(grep-re (caar grep-regexp-alist))
hits)
(call-process-shell-command command nil t)
(goto-char (point-min))
(while (re-search-forward grep-re nil t)
- (push (cons (string-to-number (match-string 2))
- (match-string 1))
+ (push (list (string-to-number (match-string 2))
+ (match-string 1)
+ (buffer-substring-no-properties (point) (line-end-position)))
hits)))
- (unwind-protect
- (delq nil
- (mapcar (lambda (hit) (xref--collect-match hit regexp))
- (nreverse hits)))
- (mapc #'kill-buffer
- (cl-set-difference (buffer-list) orig-buffers)))))
+ (xref--convert-hits hits regexp)))
(defun xref--rgrep-command (regexp files dir ignores)
(require 'find-dired) ; for `find-name-arg'
" "
(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)
+ "Convert IGNORES and DIR to a list of arguments for 'find'.
+IGNORES is a list of glob patterns. DIR is an absolute
+directory, used as the root of the ignore globs."
+ ;; `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
(match-string 1 str)))))
str t t))
-(defun xref--collect-match (hit regexp)
- (pcase-let* ((`(,line . ,file) hit)
- (buf (or (find-buffer-visiting file)
- (semantic-find-file-noselect file))))
- (with-current-buffer buf
- (save-excursion
+(defvar xref--last-visiting-buffer nil)
+(defvar xref--temp-buffer-file-name nil)
+
+(defun xref--convert-hits (hits regexp)
+ (let (xref--last-visiting-buffer
+ (tmp-buffer (generate-new-buffer " *xref-temp*")))
+ (unwind-protect
+ (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer))
+ hits)
+ (kill-buffer tmp-buffer))))
+
+(defun xref--collect-matches (hit regexp tmp-buffer)
+ (pcase-let* ((`(,line ,file ,text) hit)
+ (buf (xref--find-buffer-visiting file)))
+ (if buf
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (xref--collect-matches-1 regexp file line
+ (line-beginning-position)
+ (line-end-position))))
+ ;; Using the temporary buffer is both a performance and a buffer
+ ;; management optimization.
+ (with-current-buffer tmp-buffer
+ (erase-buffer)
+ (unless (equal file xref--temp-buffer-file-name)
+ (insert-file-contents file nil 0 200)
+ ;; Can't (setq-local delay-mode-hooks t) because of
+ ;; bug#23272, but the performance penalty seems minimal.
+ (let ((buffer-file-name file)
+ (inhibit-message t)
+ message-log-max)
+ (ignore-errors
+ (set-auto-mode t)))
+ (setq-local xref--temp-buffer-file-name file)
+ (setq-local inhibit-read-only t)
+ (erase-buffer))
+ (insert text)
(goto-char (point-min))
- (forward-line (1- line))
- (syntax-propertize (line-end-position))
- ;; TODO: Handle multiple matches per line.
- (when (re-search-forward regexp (line-end-position) t)
- (goto-char (match-beginning 0))
- (let ((loc (xref-make-file-location file line
- (current-column))))
- (goto-char (match-end 0))
- (xref-make-match (buffer-substring
- (line-beginning-position)
- (line-end-position))
- (current-column)
- loc)))))))
+ (xref--collect-matches-1 regexp file line
+ (point)
+ (point-max))))))
+
+(defun xref--collect-matches-1 (regexp file line line-beg line-end)
+ (let (matches)
+ (syntax-propertize line-end)
+ ;; FIXME: This results in several lines with the same
+ ;; summary. Solve with composite pattern?
+ (while (re-search-forward regexp line-end t)
+ (let* ((beg-column (- (match-beginning 0) line-beg))
+ (end-column (- (match-end 0) line-beg))
+ (loc (xref-make-file-location file line beg-column))
+ (summary (buffer-substring line-beg line-end)))
+ (add-face-text-property beg-column end-column 'highlight
+ t summary)
+ (push (xref-make-match summary loc (- end-column beg-column))
+ matches)))
+ (nreverse matches)))
+
+(defun xref--find-buffer-visiting (file)
+ (unless (equal (car xref--last-visiting-buffer) file)
+ (setq xref--last-visiting-buffer
+ (cons file (find-buffer-visiting file))))
+ (cdr xref--last-visiting-buffer))
(provide 'xref)