Fix 'C-u C-x p g' globally and 'A' in dired-mode

* lisp/progmodes/project.el (project-find-regexp): Ensure the
DEFAULT-DIRECTORY is set correctly for the 'C-u' case (bug#70888).

* lisp/progmodes/project.el (project--files-in-directory):
Ensure that the DIR argument ends with a slash --
'dired-do-find-regexp' passes it differently, for example.

* lisp/progmodes/xref.el (xref--group-name-for-display): Ensure
the project-relative and absolute display modes work well for
groups with "relative" file names.
(xref--analyze, xref--add-log-current-defun): Change accordingly.

* test/lisp/progmodes/project-tests.el
(project-find-regexp-with-prefix): New test.

(cherry picked from commit b20d4ab374fb9b3c80b968df6acd6444f763bd40)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index c89f72163759388fd59914acd21867600845a7ba..e0164ae80230d59606f7f6c12228a24d55b1ed91 100644 (file)
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -342,7 +342,8 @@ to find the list of ignores for each directory."
 (defun project--files-in-directory (dir ignores &optional files)
   (require 'find-dired)
   (require 'xref)
-  (let* ((default-directory dir)
+  (let* ((dir (file-name-as-directory dir))
+         (default-directory dir)
          ;; Make sure ~/ etc. in local directory name is
          ;; expanded and not left for the shell command
          ;; to interpret.

diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 9e489e52755ab4a72ed49bcea7155534fec58015..8c1b2c97e9077e86bd315b56fe0827e0ae1a3d7d 100644 (file)
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1148,11 +1148,15 @@ beginning of the line."
 (defun xref--add-log-current-defun ()
   "Return the string used to group a set of locations.
 This function is used as a value for `add-log-current-defun-function'."
-  (xref--group-name-for-display
-   (if-let (item (xref--item-at-point))
-       (xref-location-group (xref-match-item-location item))
-     (xref--imenu-extract-index-name))
-   (xref--project-root (project-current))))
+  (let ((project-root (xref--project-root (project-current))))
+    (xref--group-name-for-display
+     (if-let (item (xref--item-at-point))
+         (xref-location-group (xref-match-item-location item))
+       (xref--imenu-extract-index-name))
+     project-root
+     (and
+      (string-prefix-p project-root default-directory)
+      (substring default-directory (length project-root))))))
 
 (defun xref--next-error-function (n reset?)
   (when reset?
@@ -1284,12 +1288,15 @@ GROUP is a string for decoration purposes and XREF is an
       (xref--apply-truncation)))
   (run-hooks 'xref-after-update-hook))
 
-(defun xref--group-name-for-display (group project-root)
+(defun xref--group-name-for-display (group project-root dd-suffix)
   "Return GROUP formatted in the preferred style.
 
 The style is determined by the value of `xref-file-name-display'.
 If GROUP looks like a file name, its value is formatted according
-to that style.  Otherwise it is returned unchanged."
+to that style.  Otherwise it is returned unchanged.
+
+PROJECT-ROOT is the root of the current project, if any.  DD-SUFFIX is
+the relative name of `default-directory' relative to the project root."
   ;; XXX: The way we verify that it's indeed a file name and not some
   ;; other kind of string, e.g. Java package name or TITLE from
   ;; `tags-apropos-additional-actions', is pretty lax.  But we don't
@@ -1299,16 +1306,19 @@ to that style.  Otherwise it is returned unchanged."
   ;; values themselves (e.g. by piping through some public function),
   ;; or adding a new accessor to locations, like GROUP-TYPE.
   (cl-ecase xref-file-name-display
-    (abs group)
+    (abs (if (file-name-absolute-p group) group (expand-file-name group)))
     (nondirectory
-     (if (file-name-absolute-p group)
-         (file-name-nondirectory group)
-       group))
+     (file-name-nondirectory group))
     (project-relative
-     (if (and project-root
-              (string-prefix-p project-root group))
-         (substring group (length project-root))
-       group))))
+     (cond
+      ((not (file-name-absolute-p group))
+       (concat dd-suffix group))
+      ((and project-root
+            (string-prefix-p project-root group))
+       (substring group (length project-root)))
+      ;; Default to absolute when there's not project around.
+      (t
+       (expand-file-name group))))))
 
 (defun xref--analyze (xrefs)
   "Find common groups in XREFS and format group names.
@@ -1321,10 +1331,13 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
                    (eq xref-file-name-display 'project-relative)
                    (project-current)))
          (project-root (and project
-                            (expand-file-name (xref--project-root project)))))
+                            (expand-file-name (xref--project-root project))))
+         (dd-suffix (and project-root
+                         (string-prefix-p project-root default-directory)
+                         (substring default-directory (length project-root)))))
     (mapcar
      (lambda (pair)
-       (cons (xref--group-name-for-display (car pair) project-root)
+       (cons (xref--group-name-for-display (car pair) project-root dd-suffix)
              (cdr pair)))
      alist)))
 

diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el
index 21703cbdad61e9dc4d31a077421024ea564f544b..93943cef43b40d3a7f40a30de12376442aa86fb7 100644 (file)
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -188,4 +188,33 @@ When `project-ignores' includes a name matching project dir."
       (should (equal (sort (mapcar #'xref-item-summary matches) #'string<)
                      '("((nil . ((project-vc-ignores . (\"etc\")))))" "etc"))))))
 
+(ert-deftest project-find-regexp-with-prefix ()
+  "Check the happy path."
+  (skip-unless (executable-find find-program))
+  (skip-unless (executable-find "xargs"))
+  (skip-unless (executable-find "grep"))
+  (let* ((directory (ert-resource-directory))
+         (project-find-functions nil)
+         (project-list-file (expand-file-name "emacs-projects" temporary-file-directory))
+         (project (cons 'transient (expand-file-name "../elisp-mode-resources/" directory))))
+    (add-hook 'project-find-functions (lambda (_dir) project))
+    (should (eq (project-current) project))
+    (let* ((matches nil)
+           (xref-search-program 'grep)
+           (xref-show-xrefs-function
+            (lambda (fetcher _display)
+              (setq matches (funcall fetcher))))
+           (current-prefix-arg t))
+      (cl-letf (((symbol-function 'read-directory-name)
+                 (lambda (_prompt _default _dirname _mm) directory))
+                ((symbol-function 'grep-read-files) (lambda (_re) "*")))
+        (project-find-regexp "etc"))
+      (should (equal (mapcar (lambda (item)
+                               (file-name-base
+                                (xref-location-group (xref-item-location item))))
+                             matches)
+                     '(".dir-locals" "etc")))
+      (should (equal (sort (mapcar #'xref-item-summary matches) #'string<)
+                     '("((nil . ((project-vc-ignores . (\"etc\")))))" "etc"))))))
+
 ;;; project-tests.el ends here