From: Dmitry Gutov Date: Wed, 30 Dec 2020 11:48:45 +0000 (+0200) Subject: Add 'project-relative' as value for 'xref-file-name-display' X-Git-Tag: emacs-28.0.90~4482 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=13b59c690ada05f670d8056a6710045b22097c88;p=emacs.git Add 'project-relative' as value for 'xref-file-name-display' * lisp/progmodes/xref.el (xref-file-name-display): Document new value. (xref-location-group ((l xref-file-location))): Handle the new value. (xref--project-root): Extract from the default method of 'xref-backend-references' so it can be used in above's new code. Also fix an old bug in the "backward compat" branch. * lisp/progmodes/xref.el (xref--project-root-memo): New variable. * test/lisp/progmodes/xref-tests.el: Add test cases for the three possible settings of 'xref-file-name-display'. Co-authored-by: Tobias Rittweiler --- diff --git a/etc/NEWS b/etc/NEWS index 765c032dc47..1b49b015608 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1302,6 +1302,11 @@ have been renamed to have "proper" public names and documented ('xref-show-definitions-buffer' and 'xref-show-definitions-buffer-at-bottom'). +--- +*** New value 'project-relative' for 'xref-file-name-display' +If chosen, file names in *xref* buffers will be displayed relative +to the 'project-root' of the current project, when available. + ** json.el --- diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6f7125670bd..2d458704b57 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -109,12 +109,20 @@ This is typically the filename.") (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 @@ -149,10 +157,31 @@ Line numbers start from 1 and columns from 0.") (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) @@ -273,10 +302,7 @@ current project's main and external roots." (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) @@ -913,6 +939,12 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (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) diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index e1efbe8a4eb..ea3cbc81ea7 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -97,3 +97,34 @@ (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")))))