From 408fa62148e54e90ab67ad02b338fafadc0bbd76 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 5 Jun 2022 15:43:38 +0200 Subject: [PATCH] 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 ffd8079fc15..2c4f1f4619e 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 a46bf850b10..8514ed3c3c6 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 95f5b2c5358..6c6fcbc55d3 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)) -- 2.39.2