master 408fa62148: Add new command find-sibling-file

[Lars Ingebrigtsen]

branch: master
commit 408fa62148e54e90ab67ad02b338fafadc0bbd76
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add new command find-sibling-file
    
    * doc/emacs/files.texi (Visiting): Document it.
    * lisp/files.el (file-expand-wildcards): Fix up the regexp expansion.
    (find-sibling-rules, find-sibling-file): New user option and command.
    (find-sibling-file--search): New helper function.
---
 doc/emacs/files.texi | 39 ++++++++++++++++++++++
 etc/NEWS             |  5 +++
 lisp/files.el        | 94 +++++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 134 insertions(+), 4 deletions(-)

diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index ffd8079fc1..2c4f1f4619 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -326,6 +326,45 @@ of @code{require-final-newline} (@pxref{Customize Save}).  
If you have
 already visited the same file in the usual (non-literal) manner, this
 command asks you whether to visit it literally instead.
 
+@findex find-sibling-file
+@vindex find-sibling-rules
+Files are sometimes (loosely) tied to other files, and you could call
+these files @dfn{sibling files}.  For instance, when editing C files,
+if you have a file called @samp{"foo.c"}, you often also have a file
+called @samp{"foo.h"}, and that could be its sibling file.  Or you may
+have different versions of a file, for instance
+@samp{"src/emacs/emacs-27/lisp/allout.el"} and
+@samp{"src/emacs/emacs-28/lisp/allout.el"} might be considered
+siblings.  Emacs provides the @code{find-sibling-file} command to jump
+between sibling files, but it's impossible to guess at which files a
+user might want to be considered siblings, so Emacs lets you configure
+this freely by altering the @code{find-sibling-rules} user option.
+This is a list of match/expansion elements.
+
+For instance, to do the @samp{".c"} to @samp{".h"} mapping, you could
+say:
+
+@lisp
+(setq find-sibling-rules
+      '(("\\([^/]+\\)\\.c\\'" "\\1.h")))
+@end lisp
+
+Or, if you want to consider all files under
+@samp{"src/emacs/DIR/file-name"} to be siblings of other @var{dir}s,
+you could say:
+
+@lisp
+(setq find-sibling-rules
+      '(("src/emacs/[^/]+/\\(.*\\)\\'" "src/emacs/.*/\\1")))
+@end lisp
+
+As you can see, this is a list of @var{(MATCH EXPANSION...)} elements.
+The @var{match} is a regular expression that matches the visited file
+name, and each @var{expansion} may refer to match groups by using
+@samp{\\1} and so on.  The resulting expansion string is then applied
+to the file system to see if any files match this expansion
+(interpreted as a regexp).
+
 @vindex find-file-hook
 @vindex find-file-not-found-functions
   Two special hook variables allow extensions to modify the operation
diff --git a/etc/NEWS b/etc/NEWS
index a46bf850b1..8514ed3c3c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -271,6 +271,11 @@ startup.  Previously, these functions ignored
 
 * Changes in Emacs 29.1
 
++++
+** New command 'find-sibling-file'.
+This command jumps to a file considered a "sibling file", which is
+determined according to the new user option 'find-sibling-rules'.
+
 +++
 ** New user option 'delete-selection-temporary-region'.
 When non-nil, 'delete-selection-mode' will only delete the temporary
diff --git a/lisp/files.el b/lisp/files.el
index 95f5b2c535..6c6fcbc55d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7241,10 +7241,13 @@ default directory.  However, if FULL is non-nil, they 
are absolute."
                                  (unless (string-match "\\`\\.\\.?\\'"
                                                        (file-name-nondirectory 
name))
                                    name))
-                              (directory-files (or dir ".") full
-                                                (if regexp
-                                                    nondir
-                                                 (wildcard-to-regexp 
nondir)))))))
+                              (directory-files
+                                (or dir ".") full
+                                (if regexp
+                                    ;; We're matching each file name
+                                    ;; element separately.
+                                    (concat "\\`" nondir "\\'")
+                                 (wildcard-to-regexp nondir)))))))
            (setq contents
                  (nconc
                   (if (and dir (not full))
@@ -7254,6 +7257,89 @@ default directory.  However, if FULL is non-nil, they 
are absolute."
                   contents)))))
       contents)))
 
+(defcustom find-sibling-rules nil
+  "Rules for finding \"sibling\" files.
+This is used by the `find-sibling-file' command.
+
+This variable is a list of (MATCH EXPANSION...) elements.
+
+MATCH is a regular expression that should match a file name that
+has a sibling.  It can contain sub-expressions that will be used
+in EXPANSIONS.
+
+EXPANSION is a string that matches file names.  For instance, to
+define \".h\" files as siblings of any \".c\", you could say:
+
+  (\"\\\\([^/]+\\\\)\\\\.c\\\\\\='\" \"\\\\1.h\")
+
+MATCH and EXPANSION can also be fuller paths.  For instance, if
+you want to define other versions of a project as being sibling
+files, you could say something like:
+
+  (\"src/emacs/[^/]+/\\\\(.*\\\\)\\\\\\='\" \"src/emacs/.*/\\\\1\\\\\\='\")
+
+In this example, if you're in src/emacs/emacs-27/lisp/abbrev.el,
+and you an src/emacs/emacs-28/lisp/abbrev.el file exists, it's
+now defined as a sibling."
+  :type 'sexp
+  :version "29.1")
+
+(defun find-sibling-file (file)
+  "Visit a \"sibling\" file of FILE.
+By default, return only files that exist, but if ALL is non-nil,
+return all matches.
+
+When called interactively, FILE is the currently visited file.
+
+The \"sibling\" file is defined by the `find-sibling-rules' variable."
+  (interactive (progn
+                 (unless buffer-file-name
+                   (user-error "Not visiting a file"))
+                 (list buffer-file-name)))
+  (let ((siblings (find-sibling-file--search (expand-file-name file))))
+    (if (length= siblings 1)
+        (find-file (car siblings))
+      (let ((relatives (mapcar (lambda (sibling)
+                                 (file-relative-name
+                                  sibling (file-name-directory file)))
+                               siblings)))
+        (find-file
+         (completing-read (format-prompt "Find file" (car relatives))
+                          relatives nil t nil nil (car relatives)))))))
+
+(defun find-sibling-file--search (file)
+  (let ((results nil))
+    (pcase-dolist (`(,match . ,expansions) find-sibling-rules)
+      ;; Go through the list and find matches.
+      (when (string-match match file)
+        (let ((match-data (match-data)))
+          (dolist (expansion expansions)
+            (let ((start 0))
+              ;; Expand \\1 forms in the expansions.
+              (while (string-match "\\\\\\([0-9]+\\)" expansion start)
+                (let ((index (string-to-number (match-string 1 expansion))))
+                  (setq start (match-end 0)
+                        expansion
+                        (replace-match
+                         (substring file
+                                    (elt match-data (* index 2))
+                                    (elt match-data (1+ (* index 2))))
+                         t t expansion)))))
+            ;; Then see which files we have that are matching.  (And
+            ;; expand from the end of the file's match, since we might
+            ;; be doing a relative match.)
+            (let ((default-directory (substring file 0 (car match-data))))
+              ;; Keep the first matches first.
+              (setq results
+                    (nconc
+                     results
+                     (mapcar #'expand-file-name
+                             (file-expand-wildcards expansion nil t)))))))))
+    ;; Delete the file itself (in case it matched), and remove
+    ;; duplicates, in case we have several expansions and some match
+    ;; the same subsets of files.
+    (delete file (delete-dups results))))
+
 ;; Let Tramp know that `file-expand-wildcards' does not need an advice.
 (provide 'files '(remote-wildcards))