bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files

[Damien Cassou <damien@cassou.me>]

[-- Attachment #1: Type: text/plain, Size: 2460 bytes --]

Please find a new version of the files attached and my answers to your
feedback below.

Eli Zaretskii <eliz@gnu.org> writes:
> "jumprel" is not the best name, IMO; something like
> "related-files" would be better

Renamed to related-files.

> what you call "recipes", i.e. descriptors of how to generate the
> name of related files from a given file name, should be documented
> in a single doc string

Agree.  Doc strings and file headers have been rewritten.  The doc
string of `related-files-jumpers' quickly describes all known kinds of
jumpers and refer to the customization interface and the manual (to be
written) for the details. I refrained from describing the full syntax of
every kind of jumper in `related-files-jumpers' to keep it
understandable.

The customization interface of `related-file-jumpers' has received a lot
of love with default values, clearer tags, documentation, and better
overall presentation.

> I find no documentation of how to describe alternatives -- several
> alternative file names produced from a single original file name

I fixed that by improving the doc strings of `related-files-jumpers',
`related-files-jump', `related-files-make',
`related-files-jump-or-make' and `related-files-apply'.

> jumprel-recipe.el is AFAICT devoid of any recipe-related public
> APIs, so I don't see how such a separation can be possible.

related-files-recipe.el overrides the `related-files-apply' method. So
loading this file introduces a new kind of jumper. This is the same for
related-files-regexp.el. Both files are completely optional and serve as
examples to implement more kinds of jumpers.

> I also question the motivation: is jumprel.el really independent of
> the inner workings of the recipes as implemented in
> jumprel-recipe.el?

I think it is and it has been designed with this in mind. As far as I
know, related-files.el works perfectly with 3 kinds of jumpers whose
implementation is really different:

- function-based jumpers are implemented in related-files.el as a
  default in cl-defgeneric methods.

- recipe-based jumpers are optional and implemented in
  related-files-recipe.el.

- regexp-based jumpers are optional and implemented in
  related-files-regexp.el.

> The interface doesn't seem to me abstract enough to justify the
> separation.

Would you mind explaining this part?

-- 
Damien Cassou

"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill

[-- Attachment #2: related-files.el --]
[-- Type: text/plain, Size: 20132 bytes --]

;;; related-files.el --- Easily find files related to the current one  -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/

;; Author: Damien Cassou <damien@cassou.me>
;; Keywords: tools

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Thousands times a day you want to jump from a file to its test file
;; (or to its CSS file, or to its header file, or any other related
;; file) and just as many times you want to go back to the initial
;; file.  JUMPing to RELated (related-files) files is what this package is
;; about.

;; The question is: how does a user specify that a file is related to
;; a set of other files? One way is to create a function that takes a
;; file as argument and returns a list of related filenames:
;;
;; (defun my/related-files-jumper (file)
;;   (let ((without-ext (file-name-sans-extension file)))
;;     (list
;;      (concat without-ext ".js")
;;      (concat without-ext ".css"))))
;;
;; (setq related-files-jumpers (list #'my/related-files-jumper))
;;
;; `my/related-files-jumper' is called a 'jumper.  With this setup,
;; `related-files-jump' will let the user jump from Foo.js to Foo.css and
;; back.
;;
;; This is working good but has several limitations:
;;
;; 1. If Foo.css is not in the same directory as Foo.js or if you want
;; to include test files which end with "-tests.js",
;; `my/related-files-jumper' has to be modified in a non-obvious way or a
;; complicated new jumper must be written and added to
;; `related-files-jumpers';
;;
;; 2. The function `my/related-files-jumper' has to be shared with all Emacs
;; users working on the same project

;; So related-files recommends another approach that is less powerful but
;; much simpler.  Here is another way to define the same jumper:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css")
;;
;; This list must replace `my/related-files-jumper' in
;; `related-files-jumpers'.  This jumper lets the user go from Foo.js
;; to Foo.css.  related-files will automatically inverse the meaning
;; of :remove-suffix and :add-suffix arguments so the user can also go
;; from Foo.css to Foo.js with this jumper.  See
;; `related-files-jumpers' and THE MANUAL (TODO) for more information.
;;
;; This kind of jumper can easily be shared with the members of a team
;; through a .dir-locals.el file.  See (info "(Emacs) Directory Variables").
;;
;; `related-files-make' also makes it easy to create a related file and fill
;; it with some content.  If the content is always the same, a string
;; can be used to specify it:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler "Fill the CSS file")
;;
;; There is also an `auto-insert'-based way to fill new files and new
;; kinds of fillers can easily be implemented.  See the manual for
;; more information.

;; If you want to add a new kind of jump, override `related-files-apply' and
;; optionally `related-files-get-filler', call `related-files-add-jumper-type' and
;; add a function to `related-files-jumper-safety-functions'.
;;
;; If you want to add a new kind of filler, override `related-files-fill'
;; and call `related-files-add-filler-type'.

;;; Code:

(require 'subr-x)
(require 'cl-lib)

\f
;;; Customization Options

(defgroup related-files nil
  "Facilitate navigation between the current file and related files."
  :group 'tools)

(define-widget 'related-files-jumper 'lazy
  "A description of how two files relate to each other."
  :tag "Jumper"
  :type '(choice))

(define-widget 'related-files-filler 'lazy
  "A description of how to fill a new file."
  :format "%v"
  :type '(choice :value ""))

;;;###autoload
(defvar related-files-jumper-safety-functions nil
  "Functions checking if a given jumper is safe or not.

Each function should take a jumper as argument and should return
either nil, 'safe or 'unsafe.  Nil must be returned if the
function doesn't know if the jumper is safe.

The first function returning non-nil will determine the safety of
the jumper and other functions won't be executed.")

;;;###autoload (put 'related-files-jumpers 'safe-local-variable (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'related-files-jumper-safety-functions jumper))) jumpers)))
(defcustom related-files-jumpers nil
  "List of jumpers to consider to go from the current file to related files.

There are different kinds of jumpers:

- A jumper can be a function.  In this case, the function should
accept the current place as argument (a filename) and should
return a (possibly-empty) list of (existing and non-existing)
places the user might want to go to or create from the current
place.  Instead of returning a list, the jumper may also just
return a place.

- A jumper can also be a list (regexp MATCH 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
EXPANSIONS.  EXPANSION is a string that matches file names.

- A jumper can also be a list (recipe [:remove-suffix
REMOVE-SUFFIX] [:add-suffix ADD-SUFFIX] [:add-directory
ADD-DIRECTORY] [:case-transformer TRANSFORMATION]).  Such a
jumper defines transformations to apply to the current file name
to get related file names.  A :filler keyword can also be added
to the list to specify how to create a missing file.  Such a
jumper has the advantage that is works both ways: you can go from
a file to its related files but also from any related file to the
initial file and other related files.

Other kinds of jumpers can be created by writing Emacs Lisp.
Defining a new kind of jumper requires overriding
`related-files-apply' and optionally `related-files-get-filler'.
It also requires calling `related-files-add-jumper-type' and
adding a function to `related-files-jumper-safety-functions'.

Get more information about jumper types defined above, new
jumpers and fillers through the customization interface and THE
MANUAL (TODO)."
  :type '(repeat :tag "Jumpers" related-files-jumper)
  :safe (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'related-files-jumper-safety-functions jumper))) jumpers)))

\f
;;; Public Functions

;;;###autoload
(defun related-files-jump (&optional jumpers current-place)
  "Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.

Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed.  The
resulting list of candidates is shown to the user so one can be
selected.  If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates.  If the resulting list contains only one item, this
item is automatically selected.

Only existing files are presented to the user.  Look at
`related-files-make' and `related-files-jump-or-make' if you also want to be
able to create new files.

If JUMPERS is not provided, use `related-files-jumpers'.  If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.

Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt related-files-jumpers current-prefix-arg)))))
  (related-files--jump-or-make jumpers current-place :include-existing-places t))

;;;###autoload
(defun related-files-make (&optional jumpers current-place)
  "Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.

Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed.  The
resulting list of candidates is shown to the user so one can be
selected.  If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates.  If the resulting list contains only one item, this
item is automatically selected.

Only non-existing files are presented to the user so the user can
easily create them.  This is useful to create a test file for the
current file for example.  Look at `related-files-jump' and
`related-files-jump-or-make' if you also want to be able to jump to
existing files.

If JUMPERS is not provided, use `related-files-jumpers'.  If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.

Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt related-files-jumpers current-prefix-arg)))))
  (related-files--jump-or-make jumpers current-place :include-non-existing-places t))

;;;###autoload
(defun related-files-jump-or-make (&optional jumpers current-place)
  "Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.

Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed.  The
resulting list of candidates is shown to the user so one can be
selected.  If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates.  If the resulting list contains only one item, this
item is automatically selected.

Both existing and non-existing files are presented to the user so
the user can easily jump to existing files or create missing
ones.  Look at `related-files-jump' and `related-files-make' if you don't
want to mix existing and non-existing files in the same list..

If JUMPERS is not provided, use `related-files-jumpers'.  If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.

Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt related-files-jumpers current-prefix-arg)))))
  (related-files--jump-or-make jumpers current-place
                         :include-existing-places t
                         :include-non-existing-places t))

\f
;;; Jumpers Public API

(cl-defgeneric related-files-apply (jumper place)
  "Apply JUMPER to PLACE and return related places or nil.

PLACE is a filename and the result must be a possibly-empty list
of filenames.

The default implementation allows JUMPER to be a function.  The
function can return either a single place or a possibly-empty
list of places."
  (funcall jumper place))

(cl-defgeneric related-files-get-filler (jumper)
  "Return a filler associated with JUMPER.

There is no filler associated to a function-based jumper but
other kinds of jumpers may be able to specify a filler.")

\f
;;; Filler Public API

(cl-defgeneric related-files-fill (filler &allow-other-keys &rest)
  "Use FILLER to fill the current buffer with some content.

The current buffer is empty when this function is called.

Beyond the filler, this function is called with the :jumper and
:place keyword arguments.")

\f
;;; Functions Manipulating Places

(defun related-files--choose-place (places initial-place)
  "Let the user pick one of PLACES and return it.

PLACES is a list of filenames and INITIAL-PLACE is a filename.

INITIAL-PLACE is the place that was current when the user started
related-files.  It is used to format each place in PLACES."
  (cond
   ((length= places 0) (user-error "No place to go to.  Consider configuring `related-files-jumpers' or using `related-files-make'") nil)
   ((length= places 1) (car places))
   (t (let ((initial-directory (file-name-directory initial-place)))
        (related-files--completing-read "Place: " places (apply-partially #'related-files--format-place initial-directory))))))

(defun related-files--act-on-place (place)
  "Either open or create PLACE, a filename."
  (if (file-exists-p place)
      (find-file place)
    (related-files--make-place place)))

(defun related-files--format-place (initial-directory place)
  "Return a string representing PLACE.

INITIAL-DIRECTORY is used to format PLACE relatively.

If PLACE doesn't exist, append \"(create it!)\" to the return
value."
  (when-let* ((relative-name (file-relative-name place initial-directory)))
    (if (file-exists-p place)
        relative-name
      (format "%s (create it!)" relative-name))))

(defun related-files--make-place (place)
  "Create the file at PLACE.

If a jumper is attached to PLACE and if this jumper has a filler,
use the filler to populate the new file with initial content."
  (find-file place)
  (when-let* ((jumper (get-text-property 0 :related-files-jumper place))
              (filler (related-files-get-filler jumper)))
    (related-files-fill filler :jumper jumper :place place)))

\f
;;; Fillers

(cl-defmethod related-files-fill ((filler string) &allow-other-keys &rest)
  "Fill the current buffer with FILLER, a string."
  (insert filler))

(cl-defmethod related-files-fill ((_filler (eql auto-insert)) &allow-other-keys &rest)
  "Fill the current buffer by calling `auto-insert'."
  (auto-insert))

\f
;;; Utility Functions

(cl-defun related-files--jump-or-make (jumpers current-place &key include-existing-places include-non-existing-places)
  "Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.

Existing files are presented to the user if
INCLUDE-EXISTING-PLACES is non-nil.  Non-existing files are
presented to the user if INCLUDE-NON-EXISTING-PLACES is non-nil.

If JUMPERS is not provided, use `related-files-jumpers'.  If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'."
  (let* ((jumpers (or jumpers related-files-jumpers))
         (current-place (or current-place (buffer-file-name))))
    (cond ((not jumpers)
           (user-error "No jumpers.  Consider configuring `related-files-jumpers'"))
          ((not current-place)
           (user-error "Related-Files only works from file-based buffers"))
          (t
           (let ((existing-places (when include-existing-places
                                    (related-files--collect-existing-places jumpers current-place)))
                 (non-existing-places (when include-non-existing-places
                                        (related-files--collect-non-existing-places jumpers current-place))))
             (when-let* ((place (related-files--choose-place (append existing-places non-existing-places) current-place)))
               (related-files--act-on-place place)))))))

(defun related-files--collect-existing-places (jumpers current-place)
  "Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.

Each jumper in JUMPERS is not only called with CURRENT-PLACE as
argument but also with all places generated by other jumpers,
recursively.  Only existing places are considered and returned.

The returned value doesn't contain CURRENT-PLACE."
  (when current-place
    (let* ((places nil)
           (places-queue (list current-place)))
      (while places-queue
        (when-let* ((place (pop places-queue))
                    ((file-exists-p place))
                    ((not (seq-contains-p places place))))
          (unless (equal place current-place) (push place places))
          (let ((new-places (related-files--call-jumpers jumpers place)))
            (setq places-queue (nconc places-queue new-places)))))
      places)))

(defun related-files--collect-non-existing-places (jumpers current-place)
  "Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.

Only non-existing places are considered and returned.  The
returned value doesn't contain CURRENT-PLACE."
  (cl-delete-if
   (lambda (place) (or (equal place current-place)
                       (file-exists-p place)))
   (related-files--call-jumpers jumpers current-place)))

(defun related-files--call-jumpers (jumpers place)
  "Return a list of places that can be accessed from PLACE with JUMPERS."
  (mapcan (apply-partially #'related-files--call-jumper place) jumpers))

(defun related-files--call-jumper (place jumper)
  "Return a list of places that can be accessed from PLACE with JUMPER."
  (when-let* ((place-or-places (related-files-apply jumper place))
              (places (if (proper-list-p place-or-places)
                          place-or-places
                        (list place-or-places))))
    (related-files--attach-jumper-to-places jumper places)))

(defun related-files--attach-jumper-to-places (jumper places)
  "Return PLACES with JUMPER attached to each.

Each item of the return value remembers it was created with
JUMPER."
  (mapcar
   (lambda (place) (propertize place :related-files-jumper jumper))
   places))

(defun related-files--completing-read (prompt entities formatter)
  "Display PROMPT and let the user choose one of ENTITIES in the minibuffer.

Format each entity with FORMATTER before presenting it to the
user."
  (let* ((entity-string-to-entity (make-hash-table :test 'equal :size (length entities)))
         (entity-strings (mapcar formatter entities)))
    (cl-loop
     for entity in entities
     for entity-string in entity-strings
     do (puthash entity-string entity entity-string-to-entity))
    (when-let* ((entity-string (completing-read prompt entity-strings nil t)))
      (gethash entity-string entity-string-to-entity))))

(defun related-files-add-jumper-type (customization-type)
  "Add CUSTOMIZATION-TYPE choice to `related-files-jumper' widget.

This function should be called when creating a new kind of jumper
to add an alternative customization type to the `customize'
interface of `related-files-jumpers'.

CUSTOMIZATION-TYPE describes what the new kind of jumper should
look like and should contain the same kind of data as the :type
argument of `defcustom'.  See Info node `(elisp) Customization
Types' for more information."
  (related-files--add-choice-to-type 'related-files-jumper customization-type))

(defun related-files-add-filler-type (customization-type)
  "Add CUSTOMIZATION-TYPE choice to `related-files-filler' widget.

This function should be called when creating a new kind of filler
to add an alternative customization type to the `customize'
interface of `related-files-jumpers'.

CUSTOMIZATION-TYPE describes what the new kind of filler should
look like and should contain the same kind of data as the :type
argument of `defcustom'.  See Info node `(elisp) Customization
Types' for more information."
  (related-files--add-choice-to-type 'related-files-filler customization-type))

(defun related-files--add-choice-to-type (widget-symbol customization-type)
  "Add CUSTOMIZATION-TYPE to the choice type of WIDGET-SYMBOL.

CUSTOMIZATION-TYPE is only added if absent from the type
alternatives."
  (when-let* ((widget (get widget-symbol 'widget-type))
              (choice (widget-get widget :type))
              ((not (seq-contains-p (cdr choice) customization-type))))
    (widget-put widget :type `(,@choice ,customization-type))))

(related-files-add-jumper-type
 '(function
   :format "%t: %v\n%h\n"
   :doc "Should accept a place as argument and return a list of related places."))

(related-files-add-filler-type '(string :tag "Fill with pre-defined content" :value "Replace me with a better default"))
(related-files-add-filler-type '(const :tag "Use `auto-insert'" auto-insert))

(provide 'related-files)
;;; related-files.el ends here

;; LocalWords:  minibuffer related-files

[-- Attachment #3: related-files-recipe.el --]
[-- Type: text/plain, Size: 10130 bytes --]

;;; related-files-recipe.el --- Provide a recipe DSL to define related-files jumpers  -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; The code below defines a file name recipe DSL to create related-files
;; jumpers.  Such a jumper should be defined as a list starting with the
;; symbol 'recipe.

;;; Code:

(require 'subr-x)
(require 'map)
(require 'related-files)

\f
;;; Overrides of Public Methods

(cl-defmethod related-files-apply ((jumper (head recipe)) place)
  "Return a list of new places built by applying recipe JUMPER to PLACE."
  (append
   (apply #'related-files-recipe--apply-filename-jumper place (cdr jumper))
   (apply #'related-files-recipe--unapply-filename-jumper place (cdr jumper))))

(cl-defmethod related-files-get-filler ((jumper (head recipe)))
  "Return the filler of recipe JUMPER."
  (map-elt (cdr jumper) :filler))

\f
;;; Utility Functions

(cl-defun related-files-recipe--apply-filename-jumper
    (place &key (remove-suffix "") (add-suffix "") case-transformer add-directory
           &allow-other-keys)
  "Return places built after applying some modifications to PLACE.

Modifications are applied in the order below.

REMOVE-SUFFIX is a string (e.g., \".el\") that PLACE should
end with and that is going to be removed from it.

ADD-SUFFIX is a string (e.g., \"-tests.el\") that will be
added at the end.

CASE-TRANSFORMER is one of the kind of tranformers defined by
`related-files-recipe--apply-case-transformer' and is used to change
the case of the filename.

ADD-DIRECTORY is a string (e.g., \"test\") that is added next to
directory names in PLACE."
  (when-let* (((related-files-recipe--suffix-can-be-changed-p place add-suffix remove-suffix))
              (path-without-suffix (substring place 0 (- (length remove-suffix))))
              (path-with-suffix (concat path-without-suffix add-suffix))
              (path-with-changed-case (related-files-recipe--apply-to-filename
                                       path-with-suffix
                                       (apply-partially #'related-files-recipe--apply-case-transformer case-transformer))))
    (if add-directory
        (related-files-recipe--add-directory-to-path path-with-changed-case add-directory)
      (list path-with-changed-case))))

(cl-defun related-files-recipe--unapply-filename-jumper (place &key (add-suffix "") (remove-suffix "") case-transformer add-directory &allow-other-keys)
  "Return places built after un-applying some modifications to PLACE.

The meaning of ADD-SUFFIX, REMOVE-SUFFIX, CASE-TRANSFORMER and
ADD-DIRECTORY is the opposite of the one of
`related-files-recipe--apply-filename-jumper'.  For example, ADD-SUFFIX
should already be present in PLACE and will be removed from it."
  (when-let* (((related-files-recipe--suffix-can-be-changed-p place remove-suffix add-suffix))
              (path-without-suffix (substring place 0 (- (length add-suffix))))
              (path-with-suffix (concat path-without-suffix remove-suffix))
              (path-with-changed-case (related-files-recipe--apply-to-filename
                                       path-with-suffix
                                       (apply-partially #'related-files-recipe--unapply-case-transformer case-transformer))))
    (if add-directory
        (related-files-recipe--remove-directory-from-path path-with-changed-case add-directory)
      (list path-with-changed-case))))

(defun related-files-recipe--add-directory-to-path (file add-directory)
  "Return the paths to files looking like FILE but with ADD-DIRECTORY inside it.

The file-system is searched for existing directories but the
returned paths don't have to exist."
  (cl-labels
      ((parent-directory (directory) (file-name-directory (directory-file-name directory)))
       (root-p (directory) (string= directory (parent-directory directory))))
    (cl-loop
     for current-directory = (file-name-directory file) then (parent-directory current-directory)
     for candidate = (expand-file-name
                      (substring file (length (expand-file-name current-directory)))
                      (expand-file-name add-directory current-directory))
     if (file-exists-p (file-name-directory candidate)) collect candidate into result
     if (root-p current-directory) return result)))

(defun related-files-recipe--remove-directory-from-path (file remove-directory)
  "Return the paths to files looking like FILE but with REMOVE-DIRECTORY removed.

The file-system is searched for existing directories but the
returned paths don't have to exist."
  (when-let* ((path-segments (split-string file "/"))
              (positions (related-files-recipe--seq-positions path-segments remove-directory)))
    (cl-loop
     for position in positions
     for candidate = (string-join (related-files-recipe--seq-remove-at-position path-segments position) "/")
     if (file-exists-p (file-name-directory candidate)) collect candidate)))

(defun related-files-recipe--apply-to-filename (path fn)
  "Apply FN to the filename part of PATH."
  (let* ((filename (file-name-nondirectory path))
         (directory (file-name-directory path)))
    (expand-file-name (funcall fn filename) directory)))

(defun related-files-recipe--apply-case-transformer (transformer string)
  "Return the result of applying TRANFORMER to STRING.

TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
  (cl-case transformer
    (capitalize (concat (upcase (substring string 0 1)) (substring string 1)))
    (uncapitalize (concat (downcase (substring string 0 1)) (substring string 1)))
    (t (if transformer
           (user-error "Unknown transformer %s" transformer)
         string))))

(defun related-files-recipe--unapply-case-transformer (transformer string)
  "Return the result of un-applying TRANFORMER to STRING.

TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
  (let ((untransformer (cl-case transformer
                         (capitalize 'uncapitalize)
                         (uncapitalize 'capitalize)
                         (t transformer))))
    (related-files-recipe--apply-case-transformer untransformer string)))

(defun related-files-recipe--suffix-can-be-changed-p (path add-suffix remove-suffix)
  "Return nil if REMOVE-SUFFIX cannot be replaced with ADD-SUFFIX in PATH.

The function also returns nil if ADD-SUFFIX is already present in
PATH.  This avoids adding the same suffix again.  For example,
the function returns nil if -tests.el is added to
/project/foo-tests.el to avoid getting
/project/foo-tests-tests.el as candidate."
  (and
   (string-suffix-p remove-suffix path)
   (or (not (string-suffix-p add-suffix path))
       (string-suffix-p add-suffix remove-suffix))))

;; NOTE: This is in Emacs 29 already under the name `seq-positions'
(defun related-files-recipe--seq-positions (seq elt &optional testfn)
  "Return the positions of ELT in SEQ.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
  (cl-loop for i from 0 below (length seq)
           if (funcall (or testfn #'equal) (nth i seq) elt) collect i))

;; NOTE: This is in Emacs 29 already under the name `seq-remove-at-position'
(defun related-files-recipe--seq-remove-at-position (seq position)
  "Return a copy of SEQ where the element at POSITION got removed."
  (append
   (cl-subseq seq 0 position)
   (cl-subseq seq (1+ position))))

(related-files-add-jumper-type
 '(cons
   :tag "Transformation recipe"
   (const :tag "" recipe)
   (set
    :tag "Transformations"
    (list :inline t
          :format "%t: %v\n%d"
          :tag "Remove a string from the end of the filename, e.g., \".el\""
          (const :remove-suffix :tag "")
          (string :tag "Suffix to remove" :value ".c"))
    (list :inline t
          :format "%t: %v\n%d"
          :tag "Add a string at the end of the filename, e.g., \"-tests.el\""
          (const :add-suffix :tag "")
          (string :tag "Suffix to add" :value ".h"))
    (list :inline t
          :tag "Case transformer"
          :format "%t: %v%h\n"
          :doc "Useful when a file and its related files have names with different case"
          (const :case-transformer :tag "")
          (choice
           :value capitalize
           (const :tag "Capitalize the filename" capitalize)
           (const :tag "Uncapitalize the filename" uncapitalize)))
    (list :inline t
          :tag "String that is added next to directory names in PLACE"
          :format "%t: %v\n%h\n"
          :doc "Useful when a related file is in a parallel file hierarchy.\nFor example, with a value of \"test\", the user could jump from\n\"/project/src/lisp/calendar/parse-time.el\" to\n\"/project/src/test/lisp/calendar/parse-time.el\" and back.\nThe directory must already exist."
          (const :add-directory :tag "")
          (string :tag "Directory name to add" :value "test"))
    (list :inline t
          :tag "Filler"
          :format "%t: %v\n"
          (const :filler :tag "")
          related-files-filler))))

;;;###autoload
(add-hook 'related-files-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'recipe) 'safe)))

(provide 'related-files-recipe)
;;; related-files-recipe.el ends here

;; LocalWords:  tranformers el

[-- Attachment #4: related-files-regexp.el --]
[-- Type: text/plain, Size: 8381 bytes --]

;;; related-files-recipe.el --- Provide a recipe DSL to define related-files jumpers  -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; NOTE The code and documentation below is heavily copy/pasted from
;; `find-sibling-rules' and `find-sibling-file' by Lars Ingebrigtsen
;; <larsi@gnus.org>.  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)

\f
;;; 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)

\f
;;; 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

[-- Attachment #5: related-files-recipe-test.el --]
[-- Type: text/plain, Size: 6998 bytes --]

;;; related-files-recipe-test.el --- Tests for related-files-recipe  -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Tests for related-files-recipe.el.

;;; Code:

(require 'related-files-recipe)

\f
;;; Customization Options

(ert-deftest related-files-recipe-test-jumpers-safe-values ()
  (should (safe-local-variable-p 'related-files-jumpers '((recipe :remove-suffix ".el" add-suffix "-tests.el")))))

\f
;;; Utility Functions

(ert-deftest related-files-recipe-test-apply-filename-jumper ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let* ((place "/emacs-src/lisp/Abbrev.el")
           (places (related-files-recipe--apply-filename-jumper
                    place
                    :remove-suffix ".el"
                    :add-suffix "-tests.el"
                    :case-transformer 'uncapitalize
                    :add-directory "test"
                    :filler 'foo)))
      (should (seq-set-equal-p
               places
               '("/test/emacs-src/lisp/abbrev-tests.el"
                 "/emacs-src/test/lisp/abbrev-tests.el"
                 "/emacs-src/lisp/test/abbrev-tests.el"))))))

(ert-deftest related-files-recipe-test-unapply-filename-jumper ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let* ((place "/emacs-src/test/lisp/abbrev-tests.el")
           (places (related-files-recipe--unapply-filename-jumper
                    place
                    :remove-suffix ".el"
                    :add-suffix "-tests.el"
                    :case-transformer 'uncapitalize
                    :add-directory "test"
                    :filler 'foo)))
      (should (seq-set-equal-p places '("/emacs-src/lisp/Abbrev.el"))))))

(ert-deftest related-files-recipe-test-add-directory-to-path ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let ((result (related-files-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
      (should (seq-set-equal-p
               result
               '("/test/emacs-src/lisp/abbrev.el"
                 "/emacs-src/test/lisp/abbrev.el"
                 "/emacs-src/lisp/test/abbrev.el"))))))

(ert-deftest related-files-recipe-test-add-directory-to-path-filter-non-existing-directories ()
  "To reduce the number of candidates, the directories must already exist."
  (let ((existing-directory "/emacs-src/test/lisp/"))
    (cl-letf (((symbol-function 'file-exists-p)
               (apply-partially #'string= existing-directory)))
      (let ((result (related-files-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
        (should (equal
                 result
                 (list (concat existing-directory "abbrev.el"))))))))

(ert-deftest related-files-recipe-test-remove-directory-from-path ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let ((result (related-files-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
      (should (seq-set-equal-p
               result
               '("/emacs-src/test/lisp/test/abbrev-tests.el"
                 "/test/emacs-src/lisp/test/abbrev-tests.el"
                 "/test/emacs-src/test/lisp/abbrev-tests.el"))))))

(ert-deftest related-files-recipe-test-remove-directory-from-path-filter-non-existing-directories ()
  "To reduce the number of candidates, the directories must already exist."
  (let ((existing-directory "/test/emacs-src/lisp/test/"))
    (cl-letf (((symbol-function 'file-exists-p)
               (apply-partially #'string= existing-directory)))
      (let ((result (related-files-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
        (should (equal
                 result
                 (list (concat existing-directory "abbrev-tests.el"))))))))

(ert-deftest related-files-recipe-test-apply-to-filename ()
  (should (equal (related-files-recipe--apply-to-filename "/foo/bar" #'upcase) "/foo/BAR"))
  (should (equal (related-files-recipe--apply-to-filename "/foo/bar/BAZ.EL" #'downcase) "/foo/bar/baz.el")))

(ert-deftest related-files-recipe-test-apply-case-transformer ()
  (should (equal (related-files-recipe--apply-case-transformer 'capitalize "foo") "Foo"))
  (should (equal (related-files-recipe--apply-case-transformer 'uncapitalize "Foo") "foo"))
  (should (equal (related-files-recipe--apply-case-transformer nil "foo") "foo"))
  (should-error (related-files-recipe--apply-case-transformer 'unknown "foo")))

(ert-deftest related-files-recipe-test-unapply-case-transformer ()
  (should (equal (related-files-recipe--unapply-case-transformer 'capitalize "Foo") "foo"))
  (should (equal (related-files-recipe--unapply-case-transformer 'uncapitalize "foo") "Foo"))
  (should (equal (related-files-recipe--unapply-case-transformer nil "foo") "foo"))
  (should-error (related-files-recipe--unapply-case-transformer 'unknown "foo")))

(ert-deftest related-files-recipe-test-suffix-can-be-changed-p ()
  (should-not (related-files-recipe--suffix-can-be-changed-p "/a/b.el" ".el" "-tests.el"))
  (should-not (related-files-recipe--suffix-can-be-changed-p "/a/b-tests.el" "-tests.el" ".el"))
  (should (related-files-recipe--suffix-can-be-changed-p "/a/b-tests.el" ".el" "-tests.el"))
  (should (related-files-recipe--suffix-can-be-changed-p "/a/b.el" "-tests.el" ".el"))
  (should (related-files-recipe--suffix-can-be-changed-p "/a/b.less" ".js" ".less")))

(ert-deftest related-files-recipe-test-seq-positions ()
  (should (equal '(0 3) (related-files-recipe--seq-positions '("a" "b" "c" "a" "d") "a")))
  (should (equal '() (related-files-recipe--seq-positions '("a" "b" "c" "a" "d") "Z"))))

(ert-deftest related-files-recipe-test-seq-remove-at-position ()
  (let ((letters '(a b c d)))
    (should (equal '(a b d) (related-files-recipe--seq-remove-at-position letters 2)))
    (should (equal '(b c d) (related-files-recipe--seq-remove-at-position letters 0)))
    (should (equal '(a b c) (related-files-recipe--seq-remove-at-position letters 3)))))

(provide 'related-files-recipe-test)
;;; related-files-recipe-test.el ends here

[-- Attachment #6: related-files-test.el --]
[-- Type: text/plain, Size: 5198 bytes --]

;;; related-files-test.el --- Tests for related-files             -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Tests for related-files.el.

;;; Code:
(require 'related-files)
(require 'ert)
(require 'cl-lib)
(require 'seq)

\f
;;; Customization Options

(ert-deftest related-files-test-jumpers-safe-values ()
  (should (safe-local-variable-p 'related-files-jumpers nil))
  (should-not (safe-local-variable-p 'related-files-jumpers (list (lambda (place) place)))))

\f
;;; Jumpers Public API

(ert-deftest related-files-test-apply-function-jumper ()
  (let* ((place 'place)
         (jumperIdentity #'identity)
         (jumperConst (lambda (_) place)))
    (should (equal (related-files-apply jumperIdentity "/foo/bar") "/foo/bar"))
    (should (equal (related-files-apply jumperConst "/foo/bar") place))))

\f
;;; Functions Manipulating Places

(ert-deftest related-files-test-format-place ()
  (cl-letf (((symbol-function 'file-exists-p)
             (apply-partially #'equal "/project/foo/exists.el")))
    (should (equal (related-files--format-place "/project/foo/" "/project/foo/exists.el") "exists.el"))
    (should (equal (related-files--format-place "/project/bar/" "/project/foo/exists.el") "../foo/exists.el"))
    (should (equal (related-files--format-place "/project/foo/" "/project/foo/non-existing.el") "non-existing.el (create it!)"))))

\f
;;; Utility Functions

(ert-deftest related-files-test-collect-existing-places-does-not-return-current-place ()
  (cl-letf (((symbol-function 'file-exists-p)
             (apply-partially #'seq-contains-p '("/bar" "/foo"))))
    (let* ((current-place "/bar")
           (new-place "/foo")
           (jumper1 (lambda (_) new-place)))
      (should (equal
               (related-files--collect-existing-places (list jumper1) current-place)
               (list new-place))))))

(ert-deftest related-files-test-collect-existing-places-returns-uniq-results ()
  "If 2 jumpers produce the same place, the place should only appear once."
  (cl-letf (((symbol-function 'file-exists-p)
             (apply-partially #'seq-contains-p '("/bar" "/foo"))))
    (let* ((current-place "/bar")
           (new-place "/foo")
           (jumper1 (lambda (_) new-place))
           (jumper2 (lambda (_) new-place)))
      (should (seq-set-equal-p
               (related-files--collect-existing-places (list jumper1 jumper2) current-place)
               (list new-place))))))

(ert-deftest related-files-test-collect-existing-places-returns-no-place-when-no-current-place ()
  "If there is no current place, there shouldn't be any destination place."
  (should-not (related-files--collect-existing-places '(jumper) nil)))

(ert-deftest related-files-test-call-jumpers ()
  (let* ((jumperAtom (lambda (_) "/foo"))
         (jumperList (lambda (_) (list "/bar1" "/bar2")))
         (jumperSingleton (lambda (_) (list "/baz")))
         (jumperNil (lambda (_)))
         (jumperIdentity #'identity))
    (should (seq-set-equal-p (related-files--call-jumpers
                              (list jumperAtom jumperList)
                              "/")
                             '("/foo" "/bar1" "/bar2")))
    (should (seq-set-equal-p (related-files--call-jumpers
                              (list jumperAtom jumperSingleton)
                              "/")
                             '("/foo" "/baz")))
    (should (seq-set-equal-p (related-files--call-jumpers
                              (list jumperAtom jumperNil)
                              "/")
                             '("/foo")))
    (should (seq-set-equal-p (related-files--call-jumpers
                              (list jumperAtom jumperIdentity)
                              '"/")
                             '("/foo" "/")))
    (should (seq-set-equal-p (related-files--call-jumpers
                              (list jumperAtom jumperList jumperSingleton jumperNil jumperIdentity)
                              '"/")
                             '("/foo" "/bar1" "/bar2" "/baz" "/")))))

(ert-deftest related-files-test-test--call-jumpers-attach-jumper-to-all-places ()
  (let* ((jumper (lambda (_) "/foo"))
         (place (car (related-files--call-jumpers (list jumper) "/"))))
    (should (eq (get-text-property 0 :related-files-jumper place) jumper))))

(provide 'related-files-test)
;;; related-files-test.el ends here