;; 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.
;;
-;; A major mode should make these variables buffer-local first.
+;; That consists of a constructor function, which should return a
+;; backend value, and a set of implementations for the generic
+;; functions:
;;
-;; `xref-find-function' can be called in several ways, see its
-;; description. It has to operate with "xref" and "location" values.
+;; `xref-backend-identifier-at-point',
+;; `xref-backend-identifier-completion-table',
+;; `xref-backend-definitions', `xref-backend-references',
+;; `xref-backend-apropos', which see.
+;;
+;; 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"
:group 'tools)
(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:
(cl-defgeneric xref-location-marker (location)
"Return the marker for LOCATION.")
"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:
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."
+ "Create and return a new `xref-file-location'."
(make-instance 'xref-file-location :file file :line line :column column))
(cl-defmethod xref-location-marker ((l xref-file-location))
(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))
(position :type fixnum :initarg :position)))
(defun xref-make-buffer-location (buffer position)
- "Create and return a new xref-buffer-location."
+ "Create and return a new `xref-buffer-location'."
(make-instance 'xref-buffer-location :buffer buffer :position position))
(cl-defmethod xref-location-marker ((l xref-buffer-location))
actual location is not known.")
(defun xref-make-bogus-location (message)
- "Create and return a new xref-bogus-location."
+ "Create and return a new `xref-bogus-location'."
(make-instance 'xref-bogus-location :message message))
(cl-defmethod xref-location-marker ((l xref-bogus-location))
somewhere.")
(defun xref-make (summary location)
- "Create and return a new xref item.
+ "Create and return a new `xref-item'.
SUMMARY is a short string to describe the xref.
LOCATION is an `xref-location'."
(make-instance 'xref-item :summary summary :location 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.")
-
-(cl-defmethod xref-match-bounds ((i xref-match-item))
- (with-slots (end-column location) i
- (cons (xref-file-location-column location)
- end-column)))
+ (length :initarg :length :reader xref-match-length))
+ :comment "A match xref item describes a search result.")
-(defun xref-make-match (summary end-column location)
- "Create and return a new xref match item.
+(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 functions 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 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."
(ring-empty-p xref--marker-ring))
\f
+
+(defun xref--goto-char (pos)
+ (cond
+ ((and (<= (point-min) pos) (<= pos (point-max))))
+ (widen-automatically (widen))
+ (t (user-error "Position is outside accessible part of buffer")))
+ (goto-char pos))
+
(defun xref--goto-location (location)
"Set buffer and point according to xref-location LOCATION."
(let ((marker (xref-location-marker location)))
(set-buffer (marker-buffer marker))
- (cond ((and (<= (point-min) marker) (<= marker (point-max))))
- (widen-automatically (widen))
- (t (error "Location is outside accessible part of buffer")))
- (goto-char marker)))
+ (xref--goto-char marker)))
(defun xref--pop-to-location (item &optional window)
"Go to the location of ITEM and display the buffer.
WINDOW controls how the buffer is displayed:
nil -- switch-to-buffer
- 'window -- pop-to-buffer (other window)
- 'frame -- pop-to-buffer (other frame)"
- (xref--goto-location (xref-item-location item))
- (cl-ecase window
- ((nil) (switch-to-buffer (current-buffer)))
- (window (pop-to-buffer (current-buffer) t))
- (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
+ `window' -- pop-to-buffer (other window)
+ `frame' -- pop-to-buffer (other frame)"
+ (let* ((marker (save-excursion
+ (xref-location-marker (xref-item-location item))))
+ (buf (marker-buffer marker)))
+ (cl-ecase window
+ ((nil) (switch-to-buffer buf))
+ (window (pop-to-buffer buf t))
+ (frame (let ((pop-up-frames t)) (pop-to-buffer buf t))))
+ (xref--goto-char marker))
(let ((xref--current-item item))
(run-hooks 'xref-after-jump-hook)))
(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
(when (and restore (not (eq (car restore) 'same)))
(push (cons buf win) xref--display-history))))
-(defun xref--display-position (pos other-window xref-buf)
+(defun xref--display-position (pos other-window buf)
;; Show the location, but don't hijack focus.
- (with-selected-window (display-buffer (current-buffer) other-window)
- (goto-char pos)
- (run-hooks 'xref-after-jump-hook)
- (let ((buf (current-buffer))
- (win (selected-window)))
- (with-current-buffer xref-buf
- (setq-local other-window-scroll-buffer buf)
- (xref--save-to-history buf win)))))
+ (let ((xref-buf (current-buffer)))
+ (with-selected-window (display-buffer buf other-window)
+ (xref--goto-char pos)
+ (run-hooks 'xref-after-jump-hook)
+ (let ((buf (current-buffer))
+ (win (selected-window)))
+ (with-current-buffer xref-buf
+ (setq-local other-window-scroll-buffer buf)
+ (xref--save-to-history buf win))))))
(defun xref--show-location (location)
(condition-case err
- (let ((xref-buf (current-buffer))
- (bl (buffer-list))
- (xref--inhibit-mark-current t))
- (xref--goto-location location)
- (let ((buf (current-buffer)))
- (unless (memq buf bl)
- ;; Newly created.
- (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
- (with-current-buffer xref-buf
- (push buf xref--temporary-buffers))))
- (xref--display-position (point) t xref-buf))
+ (let* ((marker (xref-location-marker location))
+ (buf (marker-buffer marker)))
+ (xref--display-position marker t buf))
(user-error (message (error-message-string err)))))
(defun xref-show-location-at-point ()
(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.
(while (setq item (xref--search-property 'xref-item))
- (when (xref-match-bounds item)
+ (when (xref-match-length item)
(save-excursion
- (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"))
(push (cons beg end) pairs)))))
(setq pairs (nreverse pairs)))
(unless pairs (user-error "No suitable matches here"))
(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)))
+ (setq pair (pop pairs)
+ current-beg (car pair)
+ current-end (cdr pair)
+ current-buf (marker-buffer current-beg))
(pop-to-buffer current-buf)
- (goto-char (car current-pair))
- (when (re-search-forward from (cdr current-pair) noerror)
+ (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'
(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.
+If KILL is non-nil, also kill the current buffer.
The buffers that the user has otherwise interacted with in the
meantime are preserved."
(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*"
(defun xref--insert-xrefs (xref-alist)
"Insert XREF-ALIST in the current-buffer.
-XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
+XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
GROUP is a string for decoration purposes and XREF is an
`xref-item' object."
(require 'compile) ; For the compilation faces.
(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 window)
+ (cond
+ ((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))))))
(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-xrefs (input kind arg window)
+ (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 window)))
+
(defun xref--find-definitions (id window)
- (xref--show-xrefs id 'definitions id window))
+ (xref--find-xrefs id 'definitions id window))
;;;###autoload
(defun xref-find-definitions (identifier)
"Find the definition of the identifier at point.
With prefix argument or when there's no identifier at point,
-prompt for it."
+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."
(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))
-
-;;;###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: ")))
- (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
- (nconc
- (project-directories proj)
- (project-search-path proj)))))
- (xref-find-function
- (lambda (_kind regexp)
- (cl-mapcan
- (lambda (dir)
- (xref-collect-matches regexp files dir (project-ignores proj)))
- 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))))
+ (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-symref-find-text "semantic/symref")
(declare-function semantic-find-file-noselect "semantic/fw")
-(declare-function grep-read-files "grep")
(declare-function grep-expand-template "grep")
(defun xref-collect-references (symbol dir)
(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))
+ (cl-mapcan (lambda (hit) (xref--collect-matches
+ hit (format "\\_<%s\\_>" (regexp-quote symbol))))
+ hits)
+ ;; TODO: Implement "lightweight" buffer visiting, so that we
+ ;; don't have to kill them.
(mapc #'kill-buffer
(cl-set-difference (buffer-list) orig-buffers)))))
(match-string 1))
hits)))
(unwind-protect
- (delq nil
- (mapcar (lambda (hit) (xref--collect-match hit regexp))
- (nreverse hits)))
+ (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp))
+ hits)
+ ;; TODO: Same as above.
(mapc #'kill-buffer
(cl-set-difference (buffer-list) orig-buffers)))))
" -path "
(mapconcat
(lambda (ignore)
- (when (string-match "\\(\\.\\)/" ignore)
- (setq ignore (replace-match dir t t ignore 1)))
(when (string-match-p "/\\'" ignore)
(setq ignore (concat ignore "*")))
- (unless (string-prefix-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 ")
(match-string 1 str)))))
str t t))
-(defun xref--collect-match (hit regexp)
+(defun xref--collect-matches (hit regexp)
(pcase-let* ((`(,line . ,file) hit)
(buf (or (find-buffer-visiting file)
(semantic-find-file-noselect file))))
(save-excursion
(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)))))))
+ (let ((line-end (line-end-position))
+ (line-beg (line-beginning-position))
+ 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))))))
(provide 'xref)