X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4bc5e0222ba7407378b8623b95903176ae14b2e5..198ce5b1715ab44b42d0592e811c3dcebf39870f:/lisp/progmodes/xref.el diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index ae5ec61520..f674c70b10 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -76,6 +76,7 @@ (require 'semantic/symref)) ;; for hit-lines slot (defgroup xref nil "Cross-referencing commands" + :version "25.1" :group 'tools) @@ -208,7 +209,7 @@ LENGTH is the match length, in characters." (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.") @@ -413,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)))) @@ -434,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)) @@ -489,28 +505,34 @@ 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 (from to) - "Perform interactive replacement in all current matches." +(defun xref-query-replace-in-results (from to) + "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 @@ -530,9 +552,11 @@ WINDOW controls how the buffer is displayed: (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) @@ -559,7 +583,8 @@ WINDOW controls how the buffer is displayed: current-beg (car pair) current-end (cdr pair) current-buf (marker-buffer current-beg)) - (pop-to-buffer current-buf) + (xref--with-dedicated-window + (pop-to-buffer current-buf)) (goto-char current-beg) (when (re-search-forward from current-end noerror) (setq found t))) @@ -572,10 +597,9 @@ WINDOW controls how the buffer is displayed: (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": @@ -598,30 +622,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) @@ -708,15 +712,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) @@ -745,16 +749,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) @@ -762,12 +766,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)) @@ -837,37 +839,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) @@ -876,8 +887,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) @@ -886,15 +898,11 @@ 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 hits regexp))) (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' @@ -912,23 +920,32 @@ IGNORES is a list of glob patterns." " " (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 @@ -948,30 +965,71 @@ 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 (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)