mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
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.
This commit is contained in:
parent
2c759b9ce6
commit
b20d4ab374
@ -347,7 +347,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.
|
||||
@ -989,8 +990,9 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
|
||||
(files
|
||||
(if (not current-prefix-arg)
|
||||
(project-files pr)
|
||||
(let ((dir (read-directory-name "Base directory: "
|
||||
caller-dir nil t)))
|
||||
(let* ((dir (read-directory-name "Base directory: "
|
||||
caller-dir nil t)))
|
||||
(setq default-directory dir)
|
||||
(project--files-in-directory dir
|
||||
nil
|
||||
(grep-read-files regexp))))))
|
||||
|
@ -1048,11 +1048,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?
|
||||
@ -1184,12 +1188,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
|
||||
@ -1199,16 +1206,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.
|
||||
@ -1221,10 +1231,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)))
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user