(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.
-(defcustom xref-prompt-for-identifier nil
- "When non-nil, 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, only prompt 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))
- :version "25.1")
+ (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-pulse-on-jump t
- "When non-nil, momentarily highlight jump locations."
- :type 'boolean
- :version "25.1")
+(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.")
(error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
(set-marker marker nil nil)
- (xref--maybe-pulse))))
-
-(defun xref--maybe-pulse ()
- (when xref-pulse-on-jump
- (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))))
+ (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 ()
((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))))
- (xref--maybe-pulse))
+ (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)
- (xref--maybe-pulse)
+ (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-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
GROUP is a string for decoration purposes and XREF is an
`xref--xref' object."
- (require 'compile) ;; For the compilation-info face.
- (cl-loop for ((group . xrefs) . more1) on xref-alist do
+ (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))
+ (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)
(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 xref-prompt-for-identifier (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 nil
+ nil nil nil
'xref--read-identifier-history id))
(t id))))
(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)
(cdr 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 (name dir)
- "Collect mentions of NAME inside DIR.
-Uses the Semantic Symbol Reference API, see
+(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)
- (cl-assert (directory-name-p dir))
(let* ((default-directory dir)
(semantic-symref-tool 'detect)
- (res (semantic-symref-find-references-by-name name 'subdirs))
- (hits (and res (oref res :hit-lines)))
+ (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-reference hit name)) hits))
+ (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--collect-reference (hit name)
+(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))))
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
- (when (re-search-forward (format "\\_<%s\\_>"
- (regexp-quote name))
- (line-end-position) t)
+ (syntax-propertize (line-end-position))
+ (when (re-search-forward regexp (line-end-position) t)
(goto-char (match-beginning 0))
- (xref-make (format
- "%d: %s"
- line
- (buffer-substring
- (line-beginning-position)
- (line-end-position)))
+ (xref-make (buffer-substring
+ (line-beginning-position)
+ (line-end-position))
(xref-make-file-location file line
(current-column))))))))
-\f
(provide 'xref)
;;; xref.el ends here