Subject: bug#79126: vc-switch-working-tree does not work if there is no matching file

From: Sean Whitton <[email-masked]>
Date: Wed, 06 Aug 2025 15:08:17 +0100

Hello,

Thank you all for the comments.  Please find attached an implementation.

On Tue 05 Aug 2025 at 03:30pm +03, Dmitry Gutov wrote:

> On 05/08/2025 13:45, Sean Whitton wrote:
>>>> The last resort fallback could possibly be to call project-switch-project?
>>> Probably not - it would show the prompt a second time, right?
>> No, I mean calling project-switch-project non-interactively and passing
>> it the root directory.  Then the user would get some options of exactly
>> what to do.
>
> Adhering to project-switch-commands might be a fine idea, indeed. Although I'd
> probably prefer to just use Dired, myself.

Skipped that idea for now.

>>> And the last step in the algorithm from the previous paragraph would visit the
>>> worktree root, I think, so there shouldn't be a scenario of a complete
>>> failure.
>> True, but maybe failing all the way up to the root should be a special
>> case.
>
> Semantically, just going by the command's name, it seems to me that switching
> to a different directory is the key part of its behavior, and finding a
> corresponding file - a secondary one.
>
> Perhaps we'll want to add a command called 'vc-worktree-find-matching-file'?

I've done it within project-find-matching-file for now but am certainly
open to renaming that function or moving things around -- let me know
what you think.

-- 
Sean Whitton
>From a458eb6a117408821c7ec304c7bef60cf4a544ab Mon Sep 17 00:00:00 2001
From: Sean Whitton <[email-masked]>
Date: Wed, 6 Aug 2025 15:05:08 +0100
Subject: [PATCH] Generalize project-find-matching-file to other major modes

* lisp/progmodes/project.el (dired-current-directory): Declare.
(project-find-matching-file): Handle Dired buffers (bug#79126).
When matching file/directory does not exist, try going up in the
directory tree until finding something that does.
(project-find-matching-buffer-function): New variable.
* etc/NEWS: Announce it.
* lisp/vc/vc.el (vc-switch-working-tree): Use it (bug#79126).
(project-current-directory-override): Declare.
---
 etc/NEWS                  |  5 +++
 lisp/progmodes/project.el | 85 ++++++++++++++++++++++++++++++---------
 lisp/vc/vc.el             |  5 ++-
 3 files changed, 73 insertions(+), 22 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a34a3d73292..b5555d8e042 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -472,6 +472,11 @@ It can be used when switching between projects with similar file trees
 (such as Git worktrees of the same repository).  It supports being
 invoked standalone or from the 'project-switch-commands' dispatch menu.
 
+---
+*** New variable 'project-find-matching-buffer-function'.
+Major modes can set this to major mode-specific versions of
+'project-find-matching-file', to find appropriate matching buffers.
+
 +++
 *** New user option 'project-list-exclude'.
 This user option describes projects that should always be skipped by
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index dafc01c7684..367e7cf86dc 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1307,33 +1307,78 @@ project-find-file-in
         (user-error "You didn't specify the file")
       (find-file file))))
 
+;; The default value works for file-visiting and Dired buffers.
+;; Non-file-visiting major modes (other than `dired-mode'), where there
+;; is a sensible notion of a matching buffer, can set this.
+;; File-visiting major modes shouldn't set it, except possibly some
+;; highly specialized ones.
+(defvar project-find-matching-buffer-function #'project-find-matching-file
+  "Function to switch to a matching buffer in another project.
+Usually set buffer-locally by non-file-visiting major modes.
+The function will be called with no arguments.  If the other project is
+already determined, `project-current-directory-override' will be bound
+to a directory under that other project.  Otherwise the function should
+prompt for the other project, usually with `project-read-project'.")
+
+(declare-function dired-current-directory "dired")
+
 ;;;###autoload
 (defun project-find-matching-file ()
-  "Visit the file that matches the current one, in another project.
-It will skip to the same line number as well.
-A matching file has the same file name relative to the project root.
+  "Visit file or directory in another project that matches the current one.
+A matching file, or Dired buffer's matching directory, has the same file
+name relative to the project root.
+Also skip to the same line number.
+
+If the matching file does not exist in the other project, try going up
+in the directory tree until encountering a file or directory that
+exists.  For example, from a buffer visiting a file \"lisp/vc/vc.el\",
+if in the other project this file does not exist, try visiting
+\"lisp/vc\" if that exists as a file or directory.
+
+If a Dired buffer's matching directory does not exist in the other
+project, try going up in the directory tree until encountering a
+directory that exists.  For example, from a buffer visiting a
+subdirectory named \"lisp/vc/\", if in the other project \"lisp/vc\" is
+missing or not a directory, try visiting a directory named \"lisp/\" in
+the other project.
+
 When called during switching to another project, this command will
 detect it and use the override.  Otherwise, it prompts for the project
-to use from the known list."
+to use from the list of known projects."
   (interactive)
   (let* ((pr (project-current))
          (line (line-number-at-pos nil t))
-         relative-name mirror-name)
-    (if project-current-directory-override
-        (let* (project-current-directory-override
-               (real-project (project-current t)))
-          (setq relative-name (file-relative-name buffer-file-name
-                                                  (project-root real-project))))
-      (setq relative-name (file-relative-name buffer-file-name (project-root pr)))
-      (setq pr (project-read-project)))
-    (setq mirror-name (expand-file-name relative-name (project-root pr)))
-    (if (not (file-exists-p mirror-name))
-        (user-error "File `%s' not found in `%s'" relative-name (project-root pr))
-      (find-file mirror-name)
-      (save-restriction
-        (widen)
-        (goto-char (point-min))
-        (forward-line (1- line))))))
+         (dirp (derived-mode-p 'dired-mode))
+         (relative-name
+          (file-relative-name (cond
+                               (dirp (dired-current-directory))
+                               ((buffer-file-name))
+                               (t (error "Don't know how to find matching buffer")))
+                              (if project-current-directory-override
+                                  (let (project-current-directory-override)
+                                    (project-root (project-current t)))
+                                (prog1 (project-root pr)
+                                  (setq pr (project-read-project))))))
+         (mirror-name (expand-file-name relative-name (project-root pr)))
+         (orig-mirror-name mirror-name)
+         (root (project-root pr)))
+    (while (not (if dirp (file-directory-p mirror-name)
+                  (file-exists-p mirror-name)))
+      (setq mirror-name (directory-file-name
+                         (file-name-parent-directory mirror-name)))
+      (unless (file-in-directory-p mirror-name root)
+        (user-error "`%s' not found in `%s'" relative-name root)))
+    (find-file mirror-name)
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (forward-line (1- line)))
+    (unless (equal mirror-name orig-mirror-name)
+      (message "`%s' not found; visiting `%s' instead"
+               (abbreviate-file-name orig-mirror-name)
+               (abbreviate-file-name (if (file-directory-p mirror-name)
+                                         (file-name-as-directory mirror-name)
+                                       mirror-name))))))
 
 (defun project--completing-read-strict (prompt
                                         collection &optional predicate
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 3ba01210667..9dab054da47 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -4425,6 +4425,7 @@ vc--prompt-other-working-tree
              t)))
 
 (defvar project-current-directory-override)
+(defvar project-find-matching-buffer-function)
 
 ;;;###autoload
 (defun vc-switch-working-tree (directory)
@@ -4434,13 +4435,13 @@ vc-switch-working-tree
 This command switches to the file which has the same file
 name relative to DIRECTORY that this buffer's file has relative
 to the root of this working tree."
-  ;; FIXME: Switch between directory analogues, too, in Dired buffers.
   (interactive
    (list
     (vc--prompt-other-working-tree (vc-responsible-backend default-directory)
                                    "Other working tree to visit")))
+  (require 'project)
   (let ((project-current-directory-override directory))
-    (project-find-matching-file)))
+    (funcall project-find-matching-buffer-function)))
 
 ;;;###autoload
 (defun vc-delete-working-tree (backend directory)
-- 
2.47.2