(defcustom xref-file-name-display 'abs
"Style of file name display in *xref* buffers.
+
If the value is the symbol `abs', the default, show the file names
in their full absolute form.
+
If `nondirectory', show only the nondirectory (a.k.a. \"base name\")
-part of the file name."
+part of the file name.
+
+If `project-relative', show only the file name relative to the
+current project root. If there is no current project, or if the
+file resides outside of its root, show that particular file name
+in its full absolute form."
:type '(choice (const :tag "absolute file name" abs)
- (const :tag "nondirectory file name" nondirectory))
+ (const :tag "nondirectory file name" nondirectory)
+ (const :tag "relative to project root" project-relative))
:version "27.1")
;; FIXME: might be useful to have an optional "hint" i.e. a string to
(forward-char column))
(point-marker))))))
+(defvar xref--project-root-memo nil
+ "Cons mapping `default-directory' value to the search root.")
+
(cl-defmethod xref-location-group ((l xref-file-location))
(cl-ecase xref-file-name-display
- (abs (oref l file))
- (nondirectory (file-name-nondirectory (oref l file)))))
+ (abs
+ (oref l file))
+ (nondirectory
+ (file-name-nondirectory (oref l file)))
+ (project-relative
+ (unless (and xref--project-root-memo
+ (equal (car xref--project-root-memo)
+ default-directory))
+ (setq xref--project-root-memo
+ (cons default-directory
+ (let ((root
+ (let ((pr (project-current)))
+ (and pr (xref--project-root pr)))))
+ (and root (expand-file-name root))))))
+ (let ((file (oref l file))
+ (search-root (cdr xref--project-root-memo)))
+ (if (and search-root
+ (string-prefix-p search-root file))
+ (substring file (length search-root))
+ file)))))
(defclass xref-buffer-location (xref-location)
((buffer :type buffer :initarg :buffer)
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
(cons
- (if (fboundp 'project-root)
- (project-root pr)
- (with-no-warnings
- (project-roots pr)))
+ (xref--project-root pr)
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
(pop-to-buffer (current-buffer))
(current-buffer))))
+(defun xref--project-root (project)
+ (if (fboundp 'project-root)
+ (project-root project)
+ (with-no-warnings
+ (car (project-roots project)))))
+
(defun xref--show-common-initialize (xref-alist fetcher alist)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
(should (null (marker-position (cdr (nth 0 (cdr cons1))))))
(should (null (marker-position (car (nth 0 (cdr cons2))))))
(should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
+
+(ert-deftest xref--xref-file-name-display-is-abs ()
+ (let ((xref-file-name-display 'abs))
+ (should (equal (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ (concat xref-tests--data-dir "file1.txt")
+ (concat xref-tests--data-dir "file2.txt"))))))
+
+(ert-deftest xref--xref-file-name-display-is-nondirectory ()
+ (let ((xref-file-name-display 'nondirectory))
+ (should (equal (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ "file1.txt"
+ "file2.txt")))))
+
+(ert-deftest xref--xref-file-name-display-is-relative-to-project-root ()
+ (let* ((data-parent-dir
+ (file-name-directory (directory-file-name xref-tests--data-dir)))
+ (project-find-functions
+ #'(lambda (_) (cons 'transient data-parent-dir)))
+ (xref-file-name-display 'project-relative))
+ (should (equal (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ "xref-resources/file1.txt"
+ "xref-resources/file2.txt")))))