;;; related-files-recipe.el --- Provide a recipe DSL to define related-files jumpers -*- lexical-binding: t; -*- ;; Copyright (C) 2022 Damien Cassou ;; Author: Damien Cassou ;; Version: 0.1.0 ;; Package-Requires: ((emacs "29.1")) ;; Created: 25 Sep 2022 ;; URL: https://www.gnu.org/software/emacs/ ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; NOTE The code and documentation below is heavily copy/pasted from ;; `find-sibling-rules' and `find-sibling-file' by Lars Ingebrigtsen ;; . TODO: This NOTE should probably be deleted if we ;; decide to replace `find-sibling-file' with related-files. ;; The code below makes it possible to create related-files jumpers from ;; regular expressions. Such a jumper should be defined as a list ;; starting with the symbol 'regexp followed by two strings MATCH and ;; EXPANSION. 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 EXPANSION. ;; EXPANSION is a string that matches file names. For instance, to ;; define ".h" files as siblings of any ".c", you could say: ;; ;; (regexp "\\([^/]+\\)\\.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: ;; ;; (regexp "src/emacs/[^/]+/\\(.*\\)\\'" "src/emacs/.*/\\1\\'") ;; In this example, if you’re in src/emacs/emacs-27/lisp/abbrev.el, ;; and an src/emacs/emacs-28/lisp/abbrev.el file exists, it’s now ;; defined as a sibling. ;; Regexp-based jumpers as defined here do not support fillers. ;;; Code: (require 'related-files) (require 'map) ;;; Overrides of Public Methods (cl-defmethod related-files-apply ((jumper (head regexp)) place) "Return a list of new places built by applying regexp JUMPER to PLACE." (related-files-recipe--find-sibling-file-search place (list (cons (nth 1 jumper) (nth 2 jumper))))) (cl-defmethod related-files-get-filler ((_jumper (head regexp))) "Return nil as no filler can be associated with regexp-based jumpers." nil) ;;; Emacs 29 functions adapted (defun related-files-recipe--find-sibling-file-search (file rules) ;; Same as `find-sibling-file-search' in Emacs 29 except that ;; ;; - `rules' is a mandatory parameter; ;; ;; - it calls `related-files-recipe--file-expand-wildcards' instead of `file-expand-wildcards'. "Return a list of FILE's \"siblings\" RULES should be a list on the form defined by `find-sibling-rules' (which see), and if nil, defaults to `find-sibling-rules'." (let ((results nil)) (pcase-dolist (`(,match . ,expansions) 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 (related-files-recipe--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)))) (defun related-files-recipe--file-expand-wildcards (pattern &optional full regexp) ;; Same as `file-expand-wildcards' in Emacs 29 "Expand (a.k.a. \"glob\") file-name wildcard pattern PATTERN. This returns a list of file names that match PATTERN. The returned list of file names is sorted in the `string<' order. PATTERN is, by default, a \"glob\"/wildcard string, e.g., \"/tmp/*.png\" or \"/*/*/foo.png\", but can also be a regular expression if the optional REGEXP parameter is non-nil. In any case, the matches are applied per sub-directory, so a match can't span a parent/sub directory, which means that a regexp bit can't contain the \"/\" character. The returned list of file names is sorted in the `string<' order. If PATTERN is written as an absolute file name, the expansions in the returned list are also absolute. If PATTERN is written as a relative file name, it is interpreted relative to the current `default-directory'. The file names returned are normally also relative to the current default directory. However, if FULL is non-nil, they are absolute." (save-match-data (let* ((nondir (file-name-nondirectory pattern)) (dirpart (file-name-directory pattern)) ;; A list of all dirs that DIRPART specifies. ;; This can be more than one dir ;; if DIRPART contains wildcards. (dirs (if (and dirpart (string-match "[[*?]" (file-local-name dirpart))) (mapcar 'file-name-as-directory (related-files-recipe--file-expand-wildcards (directory-file-name dirpart) nil regexp)) (list dirpart))) contents) (dolist (dir dirs) (when (or (null dir) ; Possible if DIRPART is not wild. (file-accessible-directory-p dir)) (let ((this-dir-contents ;; Filter out "." and ".." (delq nil (mapcar (lambda (name) (unless (string-match "\\`\\.\\.?\\'" (file-name-nondirectory name)) name)) (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)) (mapcar (lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) contents))))) contents))) (related-files-add-jumper-type '(list :tag "Regexp" (const :tag "" regexp) (regexp :format "%t: %v%h" :value "\\([^/]+\\)\\.c\\'" :tag "Match" :doc "MATCH is a regular expression that should match a file name that has a sibling.\nIt can contain sub-expressions that will be used in EXPANSIONS.") (repeat :tag "Expansions" (string :format "%t: %v%h" :value "\\1.h" :tag "Expansion" :doc "EXPANSION is a string that matches file names.\nIt can refer to sub-expressions of Match using \\DIGIT.")))) ;;;###autoload (add-hook 'related-files-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'regexp) 'safe))) (provide 'related-files-regexp) ;;; related-files-regexp.el ends here ;; LocalWords: tranformers el