X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9459456b50dc8dec071dd0106ecbf4c42291057e..0ea47a6159f351f32b7dbc68debe99eb02f2dd8d:/lisp/progmodes/xref.el diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6a3b42ff64..05cd97932a 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,6 +1,6 @@ ;; 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. @@ -19,6 +19,11 @@ ;;; 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". ;; @@ -71,6 +76,7 @@ (require 'semantic/symref)) ;; for hit-lines slot (defgroup xref nil "Cross-referencing commands" + :version "25.1" :group 'tools) @@ -201,20 +207,22 @@ LENGTH is the match length, in characters." ;;; 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. @@ -230,10 +238,21 @@ IDENTIFIER can be any string returned by 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. @@ -345,10 +364,10 @@ elements is negated." (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)))) @@ -395,16 +414,17 @@ elements is negated." (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)))) @@ -416,52 +436,66 @@ WINDOW controls how the buffer is displayed: ;;; 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.") - -(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* ((marker (xref-location-marker location)) (buf (marker-buffer marker))) - (xref--display-position marker t buf)) + (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)) @@ -471,90 +505,134 @@ WINDOW controls how the buffer is displayed: (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* (item xrefs iter) + (save-excursion + (while (setq item (xref--search-property 'xref-item)) + (when (xref-match-length item) + (push item xrefs)))) (unwind-protect (progn - (save-excursion - (goto-char (point-min)) - (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))) - ;; 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 len) pairs))))) - (setq pairs (nreverse pairs))) - (unless pairs (user-error "No suitable matches here")) - (xref--query-replace-1 from to pairs)) - (dolist (pair pairs) - (move-marker (car pair) nil))))) + (goto-char (point-min)) + (setq iter (xref--buf-pairs-iterator (nreverse xrefs))) + (xref--query-replace-1 from to iter)) + (funcall iter :cleanup)))) + +(defun xref--buf-pairs-iterator (xrefs) + (let (chunk-done item next-pair file-buf pairs all-pairs) + (lambda (action) + (pcase action + (:next + (when (or xrefs next-pair) + (setq chunk-done nil) + (when next-pair + (setq file-buf (marker-buffer (car next-pair)) + pairs (list next-pair) + next-pair nil)) + (while (and (not chunk-done) + (setq item (pop xrefs))) + (save-excursion + (let* ((loc (xref-item-location item)) + (beg (xref-location-marker loc)) + (end (move-marker (make-marker) + (+ beg (xref-match-length item)) + (marker-buffer beg)))) + (let ((pair (cons beg end))) + (push pair all-pairs) + ;; Perform sanity check first. + (xref--goto-location loc) + (if (xref--outdated-p item + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + (message "Search result out of date, skipping") + (cond + ((null file-buf) + (setq file-buf (marker-buffer beg)) + (push pair pairs)) + ((equal file-buf (marker-buffer beg)) + (push pair pairs)) + (t + (setq chunk-done t + next-pair pair)))))))) + (cons file-buf (nreverse pairs)))) + (:cleanup + (dolist (pair all-pairs) + (move-marker (car pair) nil) + (move-marker (cdr pair) nil))))))) + +(defun xref--outdated-p (item line-text) + ;; FIXME: The check should probably be a generic function instead of + ;; the assumption that all matches contain the full line as summary. + (let ((summary (xref-item-summary item)) + (strip (lambda (s) (if (string-match "\r\\'" s) + (substring-no-properties s 0 -1) + s)))) + (not + ;; Sometimes buffer contents include ^M, and sometimes Grep + ;; output includes it, and they don't always match. + (equal (funcall strip line-text) + (funcall strip summary))))) ;; FIXME: Write a nicer UI. -(defun xref--query-replace-1 (from to pairs) +(defun xref--query-replace-1 (from to iter) (let* ((query-replace-lazy-highlight nil) - current-beg current-len current-buf + (continue t) + did-it-once buf-pairs pairs + current-beg current-end ;; 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-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-buf (marker-buffer current-beg)) - (pop-to-buffer current-buf) + current-end (cdr pair)) (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' - ;; doesn't work, because we're not using - ;; `multi-query-replace-map', and it would expect the below - ;; function to be called once per buffer. - (perform-replace from to t t nil))) + (while (and continue (setq buf-pairs (funcall iter :next))) + (if did-it-once + ;; Reuse the same window for subsequent buffers. + (switch-to-buffer (car buf-pairs)) + (xref--with-dedicated-window + (pop-to-buffer (car buf-pairs))) + (setq did-it-once t)) + (setq pairs (cdr buf-pairs)) + (setq continue + (perform-replace from to t t nil nil multi-query-replace-map))) + (unless did-it-once (user-error "No suitable matches here")) + (when (and continue (not buf-pairs)) + (message "All results processed")))) (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": @@ -577,30 +655,10 @@ WINDOW controls how the buffer is displayed: (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, 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))) - (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) @@ -662,7 +720,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--show-xref-buffer (xrefs alist) (let ((xref-alist (xref--analyze xrefs))) (with-current-buffer (get-buffer-create xref-buffer-name) - (let ((inhibit-read-only t)) + (setq buffer-undo-list nil) + (let ((inhibit-read-only t) + (buffer-undo-list t)) (erase-buffer) (xref--insert-xrefs xref-alist) (xref--xref-buffer-mode) @@ -687,15 +747,15 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defvar xref--read-pattern-history nil) -(defun xref--show-xrefs (xrefs window) +(defun xref--show-xrefs (xrefs display-action &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)) + (xref--pop-to-location (car xrefs) display-action)) (t (xref-push-marker-stack) (funcall xref-show-xrefs-function xrefs - `((window . ,window)))))) + `((window . ,(selected-window))))))) (defun xref--prompt-p (command) (or (eq xref-prompt-for-identifier t) @@ -724,16 +784,16 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." ;;; Commands -(defun xref--find-xrefs (input kind arg 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 window))) + (xref--show-xrefs xrefs display-action))) -(defun xref--find-definitions (id window) - (xref--find-xrefs id 'definitions id window)) +(defun xref--find-definitions (id display-action) + (xref--find-xrefs id 'definitions id display-action)) ;;;###autoload (defun xref-find-definitions (identifier) @@ -741,12 +801,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." 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)) @@ -816,37 +874,46 @@ and just use etags." (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") +(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 - (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))))) + (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) @@ -855,8 +922,9 @@ IGNORES is a list of glob patterns." 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) @@ -865,20 +933,18 @@ IGNORES is a list of glob patterns." (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 - (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp)) - (nreverse hits)) - ;; TODO: Same as above. - (mapc #'kill-buffer - (cl-set-difference (buffer-list) orig-buffers))))) + (xref--convert-hits (nreverse hits) regexp))) (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' (defvar grep-find-template) (defvar find-name-arg) + ;; `shell-quote-argument' quotes the tilde as well. + (cl-assert (not (string-match-p "\\`~" dir))) (grep-expand-template grep-find-template regexp @@ -890,24 +956,32 @@ IGNORES is a list of glob patterns." (concat " -o " 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 "))) + (shell-quote-argument dir) + (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." + (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 @@ -927,30 +1001,75 @@ IGNORES is a list of glob patterns." (match-string 1 str))))) str t t)) -(defun xref--collect-matches (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)) - (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)))))) + (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 (and + ;; REGEXP might match an empty string. Or line. + (or (null matches) + (> (point) line-beg)) + (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)