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

From: Sean Whitton <[email-masked]>
Date: Thu, 07 Aug 2025 13:38:44 +0100

Hello,

Thanks again all.  Here's the revised patch.

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

* lisp/progmodes/project.el
(project-find-matching-buffer-function): New variable.
(project-find-matching-file): Delete.
(dired-current-directory): Declare.
(project-find-matching-file-or-directory): New function.  Like
the old 'project-find-matching-file', but also handle Dired
buffers (bug#79126).  When matching file/directory does not
exist, try going up in the directory tree until we find
something that does.
(project-find-matching-buffer): New command.
* lisp/vc/vc.el (vc-switch-working-tree): Use it (bug#79126).
* etc/NEWS: Announce new command and new variable.
---
 etc/NEWS                  |   7 ++-
 lisp/progmodes/project.el | 108 +++++++++++++++++++++++++++++---------
 lisp/vc/vc.el             |   3 +-
 3 files changed, 91 insertions(+), 27 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a34a3d73292..5985348e101 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -467,11 +467,16 @@ Callers can use this to indicate the reason for which or context in
 which Emacs should ask the user to select a project.
 
 ---
-*** New command 'project-find-matching-file'.
+*** New command 'project-find-matching-buffer'.
 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 functions to control how
+'project-find-matching-buffer' finds 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..e9e8c558843 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1307,33 +1307,93 @@ 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-or-directory
+  "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 two arguments, the project instance for
+this buffer's project, and the project instance for the matching buffer.")
+
 ;;;###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.
+(defun project-find-matching-buffer ()
+  "Switch to a matching buffer in another project.
+For most file-visiting buffers, the matching buffer is one visiting a
+file in the other project which has the same file name relative to the
+project root.  See `project-find-matching-file' for details.
+Non-file-visiting major modes may configure a different notion of
+matching buffer; see `project-find-matching-buffer-function'.
+
 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."
+detect that, and use the override.  Otherwise, it prompts for the
+project to use from the list of known projects.
+When calling from Lisp, bind `project-current-directory-override' to a
+directory under the target project to preempt this prompting."
   (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))))))
+  (let ((pr (project-current)))
+    (apply project-find-matching-buffer-function
+           (if project-current-directory-override
+               (let (project-current-directory-override)
+                 (list (project-current t) pr))
+             (list pr (project-read-project))))))
+
+(declare-function dired-current-directory "dired")
+
+(defun project-find-matching-file-or-directory (current-project mirror-project)
+  "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.
+CURRENT-PROJECT is the project instance for the current project.
+MIRROR-PROJECT is the project instance for the project to visit.
+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.
+
+This function is intended to be used as the value of
+`project-find-matching-buffer-function'."
+  (let* ((line (line-number-at-pos nil t))
+         (dirp (derived-mode-p 'dired-mode))
+         (mirror-root (project-root mirror-project))
+         (relative-name
+          (file-relative-name (cond
+                               (dirp (dired-current-directory))
+                               ((buffer-file-name))
+                               (t (error "Don't know how to find matching buffer")))
+                              (project-root current-project)))
+         (mirror-name (expand-file-name relative-name mirror-root))
+         (orig-mirror-name mirror-name))
+    (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 mirror-root)
+        (user-error "`%s' not found in `%s'" relative-name mirror-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 67eed872fd7..5dc6461af1f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -4435,13 +4435,12 @@ 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")))
   (let ((project-current-directory-override directory))
-    (project-find-matching-file)))
+    (project-find-matching-buffer)))
 
 ;;;###autoload
 (defun vc-delete-working-tree (backend directory)
-- 
2.47.2