(require 'eieio)
(require 'ring)
(require 'pcase)
+(require 'project)
(defgroup xref nil "Cross-referencing commands"
:group 'tools)
"Return a string used to group a set of locations.
This is typically the filename.")
+(cl-defgeneric xref-location-line (_location)
+ "Return the line number corresponding to the location."
+ nil)
+
;;;; Commonly needed location classes are defined here:
;; FIXME: might be useful to have an optional "hint" i.e. a string to
;; search for in case the line number is sightly out of date.
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
- (line :type fixnum :initarg :line)
+ (line :type fixnum :initarg :line :reader xref-location-line)
(column :type fixnum :initarg :column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
(point-marker))))))
(cl-defmethod xref-location-group ((l xref-file-location))
- (oref l :file))
+ (oref l file))
(defclass xref-buffer-location (xref-location)
((buffer :type buffer :initarg :buffer)
(make-instance 'xref-bogus-location :message message))
(cl-defmethod xref-location-marker ((l xref-bogus-location))
- (user-error "%s" (oref l :message)))
+ (user-error "%s" (oref l message)))
(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
-;; This should be in elisp-mode.el, but it's preloaded, and we can't
-;; preload defclass and defmethod (at least, not yet).
-(defclass xref-elisp-location (xref-location)
- ((symbol :type symbol :initarg :symbol)
- (type :type symbol :initarg :type)
- (file :type string :initarg :file
- :reader xref-location-group))
- :documentation "Location of an Emacs Lisp symbol definition.")
-
-(defun xref-make-elisp-location (symbol type file)
- (make-instance 'xref-elisp-location :symbol symbol :type type :file file))
-
-(cl-defmethod xref-location-marker ((l xref-elisp-location))
- (with-slots (symbol type file) l
- (let ((buffer-point
- (pcase type
- (`defun (find-function-search-for-symbol symbol nil file))
- ((or `defvar `defface)
- (find-function-search-for-symbol symbol type file))
- (`feature
- (cons (find-file-noselect file) 1)))))
- (with-current-buffer (car buffer-point)
- (goto-char (or (cdr buffer-point) (point-min)))
- (point-marker)))))
-
\f
;;; Cross-reference
(defclass xref--xref ()
- ((description :type string :initarg :description
- :reader xref--xref-description)
- (location :type xref-location :initarg :location
+ ((summary :type string :initarg :summary
+ :reader xref--xref-summary)
+ (location :initarg :location
:reader xref--xref-location))
:comment "An xref is used to display and locate constructs like
variables or functions.")
-(defun xref-make (description location)
- "Create and return a new xref.
-DESCRIPTION is a short string to describe the xref.
+(defun xref-make (summary location)
+ "Create and return a new xref item.
+SUMMARY is a short string to describe the xref.
LOCATION is an `xref-location'."
- (make-instance 'xref--xref :description description :location location))
+ (make-instance 'xref--xref :summary summary :location location))
\f
;;; API
(defcustom xref-marker-ring-length 16
"Length of the xref marker ring."
- :type 'integer
- :version "25.1")
+ :type 'integer)
+
+(defcustom xref-prompt-for-identifier '(not xref-find-definitions
+ xref-find-definitions-other-window
+ xref-find-definitions-other-frame)
+ "When t, always prompt for the identifier name.
+
+When nil, prompt only when there's no value at point we can use,
+or when the command has been called with the prefix argument.
+
+Otherwise, it's a list of xref commands which will prompt
+anyway (the value at point, if any, will be used as the default).
+
+If the list starts with `not', the meaning of the rest of the
+elements is negated."
+ :type '(choice (const :tag "always" t)
+ (const :tag "auto" nil)
+ (set :menu-tag "command specific" :tag "commands"
+ :value (not)
+ (const :tag "Except" not)
+ (repeat :inline t (symbol :tag "command")))))
+
+(defcustom xref-after-jump-hook '(recenter
+ xref-pulse-momentarily)
+ "Functions called after jumping to an xref."
+ :type 'hook)
+
+(defcustom xref-after-return-hook '(xref-pulse-momentarily)
+ "Functions called after returning to a pre-jump location."
+ :type 'hook)
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
"Ring of markers to implement the marker stack.")
-(defun xref-push-marker-stack ()
- "Add point to the marker stack."
- (ring-insert xref--marker-ring (point-marker)))
+(defun xref-push-marker-stack (&optional m)
+ "Add point M (defaults to `point-marker') to the marker stack."
+ (ring-insert xref--marker-ring (or m (point-marker))))
;;;###autoload
(defun xref-pop-marker-stack ()
(switch-to-buffer (or (marker-buffer marker)
(error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
- (set-marker marker nil nil))))
+ (set-marker marker nil nil)
+ (run-hooks 'xref-after-return-hook))))
+
+(defun xref-pulse-momentarily ()
+ (let (beg end)
+ (save-excursion
+ (back-to-indentation)
+ (if (eolp)
+ (setq beg (line-beginning-position)
+ end (1+ (point)))
+ (setq beg (point)
+ end (line-end-position))))
+ (pulse-momentary-highlight-region beg end 'next-error)))
;; etags.el needs this
(defun xref-clear-marker-stack ()
(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)))))
+ (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
+ (run-hooks 'xref-after-jump-hook))
\f
;;; XREF buffer (part of the UI)
(when (and restore (not (eq (car restore) 'same)))
(push (cons buf win) xref--display-history))))
-(defun xref--display-position (pos other-window recenter-arg xref-buf)
+(defun xref--display-position (pos other-window xref-buf)
;; Show the location, but don't hijack focus.
(with-selected-window (display-buffer (current-buffer) other-window)
(goto-char pos)
- (recenter recenter-arg)
+ (run-hooks 'xref-after-jump-hook)
(let ((buf (current-buffer))
(win (selected-window)))
(with-current-buffer xref-buf
(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 1 xref-buf))
+ (xref--display-position (point) t xref-buf))
(user-error (message (error-message-string err)))))
(defun xref-show-location-at-point ()
(xref-show-location-at-point))
(defun xref--location-at-point ()
- (get-text-property (point) 'xref-location))
+ (save-excursion
+ (back-to-indentation)
+ (get-text-property (point) 'xref-location)))
(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."
(interactive)
- (back-to-indentation)
(let ((loc (or (xref--location-at-point)
(user-error "No reference at point")))
(window xref--window))
(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
"Mode for displaying cross-references."
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (setq next-error-function #'xref--next-error-function)
+ (setq next-error-last-buffer (current-buffer)))
+
+(defun xref--next-error-function (n reset?)
+ (when reset?
+ (goto-char (point-min)))
+ (let ((backward (< n 0))
+ (n (abs n))
+ (loc nil))
+ (dotimes (_ n)
+ (setq loc (xref--search-property 'xref-location backward)))
+ (cond (loc
+ (xref--pop-to-location loc))
+ (t
+ (error "No %s xref" (if backward "previous" "next"))))))
(defun xref-quit (&optional kill)
"Bury temporarily displayed buffers, then quit the current window.
XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
GROUP is a string for decoration purposes and XREF is an
`xref--xref' object."
- (cl-loop for ((group . xrefs) . more1) on xref-alist do
- (xref--insert-propertized '(face bold) group "\n")
+ (require 'compile) ; For the compilation faces.
+ (cl-loop for ((group . xrefs) . more1) on xref-alist
+ for max-line-width =
+ (cl-loop for xref in xrefs
+ maximize (let ((line (xref-location-line
+ (oref xref location))))
+ (length (and line (format "%d" line)))))
+ for line-format = (and max-line-width
+ (format "%%%dd: " max-line-width))
+ do
+ (xref--insert-propertized '(face compilation-info) group "\n")
(cl-loop for (xref . more2) on xrefs do
- (insert " ")
- (with-slots (description location) xref
- (xref--insert-propertized
- (list 'xref-location location
- 'face 'font-lock-keyword-face
- 'mouse-face 'highlight
- 'keymap xref--button-map
- 'help-echo
- (concat "mouse-2: display in another window, "
- "RET or mouse-1: follow reference"))
- description))
- (when (or more1 more2)
- (insert "\n")))))
+ (with-slots (summary location) xref
+ (let* ((line (xref-location-line location))
+ (prefix
+ (if line
+ (propertize (format line-format line)
+ 'face 'compilation-line-number)
+ " ")))
+ (xref--insert-propertized
+ (list 'xref-location location
+ ;; 'face 'font-lock-keyword-face
+ 'mouse-face 'highlight
+ 'keymap xref--button-map
+ 'help-echo
+ (concat "mouse-2: display in another window, "
+ "RET or mouse-1: follow reference"))
+ prefix summary)))
+ (insert "\n"))))
(defun xref--analyze (xrefs)
"Find common filenames in XREFS.
(tb (cl-set-difference (buffer-list) bl)))
(cond
((null xrefs)
- (user-error "No known %s for: %s" (symbol-name kind) input))
+ (user-error "No %s found for: %s" (symbol-name kind) input))
((not (cdr xrefs))
(xref-push-marker-stack)
(xref--pop-to-location (xref--xref-location (car xrefs)) window))
`((window . ,window)
(temporary-buffers . ,tb)))))))
+(defun xref--prompt-p (command)
+ (or (eq xref-prompt-for-identifier t)
+ (if (eq (car xref-prompt-for-identifier) 'not)
+ (not (memq command (cdr xref-prompt-for-identifier)))
+ (memq command xref-prompt-for-identifier))))
+
(defun xref--read-identifier (prompt)
"Return the identifier at point or read it from the minibuffer."
(let ((id (funcall xref-identifier-at-point-function)))
- (cond ((or current-prefix-arg (not id))
- (completing-read prompt
+ (cond ((or current-prefix-arg
+ (not id)
+ (xref--prompt-p this-command))
+ (completing-read (if id
+ (format "%s (default %s): "
+ (substring prompt 0 (string-match
+ "[ :]+\\'" prompt))
+ id)
+ prompt)
(funcall xref-identifier-completion-table-function)
- nil t id
- 'xref--read-identifier-history))
+ nil nil nil
+ 'xref--read-identifier-history id))
(t id))))
\f
(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)))
+
(declare-function apropos-parse-pattern "apropos" (pattern))
;;;###autoload
(defun xref-find-apropos (pattern)
"Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
"Search for pattern (word list or regexp): "
- nil nil nil 'xref--read-pattern-history)))
+ nil 'xref--read-pattern-history)))
(require 'apropos)
(xref--show-xrefs pattern 'apropos
(apropos-parse-pattern
;;;###autoload (define-key esc-map "." #'xref-find-definitions)
;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
+;;;###autoload (define-key esc-map "?" #'xref-find-references)
;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
(setq-local xref-identifier-completion-table-function
(cdr xref-etags-mode--saved))))
-\f
+(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)
+ "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."
+ (cl-assert (directory-name-p dir))
+ (require 'semantic/symref)
+ (defvar semantic-symref-tool)
+ (let* ((default-directory dir)
+ (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)))))
+
+(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))
+ (require 'semantic/fw)
+ (grep-compute-defaults)
+ (defvar grep-find-template)
+ (defvar grep-highlight-matches)
+ (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
+ 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))
+ (buf (get-buffer-create " *xref-grep*"))
+ (grep-re (caar grep-regexp-alist))
+ hits)
+ (with-current-buffer buf
+ (erase-buffer)
+ (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))
+ 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)))))
+
+(defun xref--rgrep-command (regexp files dir ignores)
+ (require 'find-dired) ; for `find-name-arg'
+ (defvar grep-find-template)
+ (defvar find-name-arg)
+ (grep-expand-template
+ grep-find-template
+ regexp
+ (concat (shell-quote-argument "(")
+ " " find-name-arg " "
+ (mapconcat
+ #'shell-quote-argument
+ (split-string files)
+ (concat " -o " find-name-arg " "))
+ " "
+ (shell-quote-argument ")"))
+ dir
+ (concat
+ (shell-quote-argument "(")
+ " -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)))
+ (shell-quote-argument ignore))
+ ignores
+ " -o -path ")
+ " "
+ (shell-quote-argument ")")
+ " -prune -o ")))
+
+(defun xref--regexp-to-extended (str)
+ (replace-regexp-in-string
+ ;; FIXME: Add tests. Move to subr.el, make a public function.
+ ;; Maybe error on Emacs-only constructs.
+ "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
+ (lambda (str)
+ (cond
+ ((not (match-beginning 1))
+ str)
+ ((eq (length (match-string 1 str)) 2)
+ (concat (substring str 0 (match-beginning 1))
+ (substring (match-string 1 str) 1 2)))
+ (t
+ (concat (substring str 0 (match-beginning 1))
+ "\\"
+ (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
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (syntax-propertize (line-end-position))
+ (when (re-search-forward regexp (line-end-position) t)
+ (goto-char (match-beginning 0))
+ (xref-make (buffer-substring
+ (line-beginning-position)
+ (line-end-position))
+ (xref-make-file-location file line
+ (current-column))))))))
+
(provide 'xref)
;;; xref.el ends here