From: Dmitry Gutov Date: Sun, 12 May 2024 17:42:08 +0000 (+0300) Subject: Fix 'C-u C-x p g' globally and 'A' in dired-mode X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=68aab8b6697b42e2e30e73345ca2fc0d32813202;p=emacs.git 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 c89f7216375..e0164ae8023 100644 --- 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 9e489e52755..8c1b2c97e90 100644 --- 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 21703cbdad6..93943cef43b 100644 --- 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