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

[Damien Cassou <damien@cassou.me>]

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

Please find attached jumprel, a tool to find/create related files. This
tool has been described (and compared with `find-file.el' and
`find-sibling-file') in emacs-devel's thread "Comparison of tools to
search for related files".

You will find a few files attached to this email:

- jumprel.el: The core of the library. This is where you will find an
  introductory documentation.
- tests/jumprel-test.el: Corresponding tests.

- jumprel-recipe.el: Support for recipe-based jumpers. This makes it
  easy to define powerful jumpers.
- tests/jumprel-recipe-test.el: Corresponding tests.

- jumprel-regexp.el: A proof-of-concept way to define regexp-based
  jumpers. This files provides the same kind of support as
  `find-sibling-file' and `find-file.el'. This file is heavily based on
  previous work from Lars Ingebrigtsen <larsi@gnus.org> and others.

- 0001-.dir-locals.el-Configure-jumprel-jumpers.patch: A patch for
  Emacs' .dir-locals.el making use of jumprel for .el and .c/.h files.

Because there are already 2 mechanisms to find related files in Emacs
(see above-mentioned thread), I think we should only consider
integrating jumprel into Emacs core if the other 2 are somewhat
deprecated (find-sibling-file hasn't been part of any release yet).

Even if you don't want to include this package in Emacs core, I would
really welcome feedback.

-- 
Damien Cassou

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-.dir-locals.el-Configure-jumprel-jumpers.patch --]
[-- Type: text/x-patch, Size: 1299 bytes --]

From f3d6b1b4614d0bc4962404527e0960924d9722e5 Mon Sep 17 00:00:00 2001
From: Damien Cassou <damien@cassou.me>
Date: Sun, 25 Sep 2022 13:07:18 +0200
Subject: [PATCH] * .dir-locals.el: Configure jumprel-jumpers

---
 .dir-locals.el | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.dir-locals.el b/.dir-locals.el
index 84617a7980..cced69e9c2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,6 +9,7 @@
          (bug-reference-url-format . "https://debbugs.gnu.org/%s")
 	 (diff-add-log-use-relative-names . t)))
  (c-mode . ((c-file-style . "GNU")
+            (jumprel-jumpers . ((recipe :remove-suffix ".c" :add-suffix ".h" :filler auto-insert)))
             (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK"))
             (electric-quote-comment . nil)
             (electric-quote-string . nil)
@@ -26,6 +27,7 @@
 		     (mode . bug-reference)))
  (diff-mode . ((mode . whitespace)))
  (emacs-lisp-mode . ((indent-tabs-mode . nil)
+                     (jumprel-jumpers . ((recipe :remove-suffix ".el" :add-suffix "-tests.el" :add-directory "test" :filler auto-insert)))
                      (electric-quote-comment . nil)
                      (electric-quote-string . nil)
 	             (mode . bug-reference-prog)))
-- 
2.36.2


[-- Attachment #3: jumprel.el --]
[-- Type: text/plain, Size: 17435 bytes --]

;;; jumprel.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 (jumprel) 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/jumprel-jumper (file)
;;   (let ((without-ext (file-name-sans-extension file)))
;;     (list
;;      (concat without-ext ".js")
;;      (concat without-ext ".css"))))
;;
;; (setq jumprel-jumpers (list #'my/jumprel-jumper))
;;
;; `my/jumprel-jumper' is called a 'jumper.  With this setup,
;; `jumprel-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/jumprel-jumper' has to be modified in a non-obvious way or a
;; complicated new jumper must be written and added to
;; `jumprel-jumpers';
;;
;; 2. The function `my/jumprel-jumper' has to be shared with all Emacs
;; users working on the same project

;; So jumprel 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/jumprel-jumper' in `jumprel-jumpers'.
;; This jumper lets the user go from Foo.js to Foo.css.  jumprel 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 `jumprel-recipe.el' for more powerful examples.
;;
;; 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").
;;
;; jumprel 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")
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler "Fill the CSS file")
;;
;; This is rather limited though.  Another solution is to use the
;; 'auto-insert filler:
;;
;; (recipe :remove-suffix ".el" :add-suffix "-test.el" :filler auto-insert)
;;
;; This will execute `auto-insert' in the new file.  New kinds of
;; filler can easily be implemented by overriding `jumprel-fill'.  For
;; example, if you are using the popular `yasnippet' package (not part
;; of Emacs), you can
;;
;; (cl-defmethod jumprel-fill ((filler (head yasnippet)) &allow-other-keys &rest)
;;   (when-let* ((snippet (map-elt (cdr filler) :name)))
;;     (yas-expand-snippet (yas-lookup-snippet snippet major-mode))))
;;
;; Which means the user can now specify a yasnippet snippet in their
;; `.dir-locals.el' file:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".spec.js" :filler (yasnippet :name "spec"))
;;
;; This will execute `yasnippet' in the new file with the "spec"
;; snippet.

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

;;; Code:

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


\f
;;; Customization Options

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

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

(define-widget 'jumprel-filler 'lazy
  "A description of how to fill a new file."
  :tag "Filler"
  :type '(choice))

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

A jumper is basically a function taking the current place as
argument (a filename) and returning a list of (existing and
non-existing) places the user might want to go to from the
current place.

There are different ways to specify a jumper.  Look at the
`customize' interface of this variable for more information."
  :type '(repeat jumprel-jumper)
  :safe (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'jumprel-jumper-safety-functions jumper))) jumpers)))

\f
;;; Public Functions

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

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

If JUMPERS is not provided, use `jumprel-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 `jumprel-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt jumprel-jumpers current-prefix-arg)))))
  (jumprel--jump-or-make jumpers current-place :include-existing-places t))

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

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 `jumprel-jump' and
`jumprel-jump-or-make' if you also want to be able to jump to
existing files.

If JUMPERS is not provided, use `jumprel-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 `jumprel-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt jumprel-jumpers current-prefix-arg)))))
  (jumprel--jump-or-make jumpers current-place :include-non-existing-places t))

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

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 `jumprel-jump' and `jumprel-make' if you don't
want to mix existing and non-existing files in the same list..

If JUMPERS is not provided, use `jumprel-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 `jumprel-jumpers'."
  (interactive (list (when (numberp current-prefix-arg)
                       (list (seq-elt jumprel-jumpers current-prefix-arg)))))
  (jumprel--jump-or-make jumpers current-place
                         :include-existing-places t
                         :include-non-existing-places t))

\f
;;; Jumpers Public API

(cl-defgeneric jumprel-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."
  (funcall jumper place))

(cl-defgeneric jumprel-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 jumprel-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 jumprel--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
jumprel.  It is used to format each place in PLACES."
  (cond
   ((length= places 0) (user-error "No place to go to.  Consider configuring `jumprel-jumpers' or using `jumprel-make'") nil)
   ((length= places 1) (car places))
   (t (let ((initial-directory (file-name-directory initial-place)))
        (jumprel--completing-read "Place: " places (apply-partially #'jumprel--format-place initial-directory))))))

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

(defun jumprel--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 jumprel--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 :jumprel-jumper place))
              (filler (jumprel-get-filler jumper)))
    (jumprel-fill filler :jumper jumper :place place)))

\f
;;; Fillers

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

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

\f
;;; Utility Functions

(cl-defun jumprel--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 `jumprel-jumpers'.  If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'."
  (let* ((jumpers (or jumpers jumprel-jumpers))
         (current-place (or current-place (buffer-file-name))))
    (cond ((not jumpers)
           (user-error "No jumpers.  Consider configuring `jumprel-jumpers'"))
          ((not current-place)
           (user-error "Jumprel only works from file-based buffers"))
          (t
           (let ((existing-places (when include-existing-places
                                    (jumprel--collect-existing-places jumpers current-place)))
                 (non-existing-places (when include-non-existing-places
                                        (jumprel--collect-non-existing-places jumpers current-place))))
             (when-let* ((place (jumprel--choose-place (append existing-places non-existing-places) current-place)))
               (jumprel--act-on-place place)))))))

(defun jumprel--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 (jumprel--call-jumpers jumpers place)))
            (setq places-queue (nconc places-queue new-places)))))
      places)))

(defun jumprel--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)))
   (jumprel--call-jumpers jumpers current-place)))

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

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

(defun jumprel--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 :jumprel-jumper jumper))
   places))

(defun jumprel--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 jumprel-add-jumper-type (customization-type)
  "Add CUSTOMIZATION-TYPE choice to `jumprel-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 `jumprel-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."
  (jumprel--add-choice-to-type 'jumprel-jumper customization-type))

(defun jumprel-add-filler-type (customization-type)
  "Add CUSTOMIZATION-TYPE choice to `jumprel-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 `jumprel-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."
  (jumprel--add-choice-to-type 'jumprel-filler customization-type))

(defun jumprel--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))))

(jumprel-add-jumper-type 'function)

(jumprel-add-filler-type '(string :tag "Fill with pre-defined content"))
(jumprel-add-filler-type '(const :tag "Use `auto-insert'" auto-insert))

(provide 'jumprel)
;;; jumprel.el ends here

;; LocalWords:  minibuffer jumprel

[-- Attachment #4: jumprel-recipe.el --]
[-- Type: text/plain, Size: 10442 bytes --]

;;; jumprel-recipe.el --- Provide a recipe DSL to define jumprel 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-creation recipe DSL to create jumprel
;; jumpers.  Such a jumper should be defined as a list starting with the
;; symbol 'recipe.  Here are some examples:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css")
;;
;; The jumper above will let the user jump from MyComponent.js to
;; MyComponent.css in the same directory and back from the CSS to the
;; JS file.  Sometimes, a related file is in a parallel folder
;; hierarchy.  This can be specified by using the :add-directory
;; keyword:
;;
;; (recipe :remove-suffix ".el" :add-suffix "-tests.el" :add-directory "test")
;;
;; This is the typical elisp code base example where test files end
;; with "-tests.el" and are located in a "test/" directory.  With such
;; a jumper, the user can jump from
;; /project/src/lisp/calendar/parse-time.el to
;; /project/src/test/lisp/calendar/parse-time-tests.el and back.
;;
;; Sometimes, capitalization between a file and its related file isn't
;; similar.  In this case, the :case-transformer keyword can be used:
;;
;; (recipe :remove-suffix ".js" :add-suffix "-tests.js" :case-transformer uncapitalize)
;;
;; This makes it possible for a user to jump from /project/src/Foo.js
;; to /project/src/foo-tests.js and back.
;;
;; A filler (see jumprel's main documentation) can be specified with
;; the :filler keyword:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler auto-insert)
;;
;; This will call `auto-insert' on newly created files.  See jumprel's
;; main documentation for the syntax of other kinds of fillers.

;;; Code:

(require 'subr-x)
(require 'map)
(require 'jumprel)

\f
;;; Overrides of Public Methods

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

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

\f
;;; Utility Functions

(cl-defun jumprel-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
`jumprel-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* (((jumprel-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 (jumprel-recipe--apply-to-filename
                                       path-with-suffix
                                       (apply-partially #'jumprel-recipe--apply-case-transformer case-transformer))))
    (if add-directory
        (jumprel-recipe--add-directory-to-path path-with-changed-case add-directory)
      (list path-with-changed-case))))

(cl-defun jumprel-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
`jumprel-recipe--apply-filename-jumper'.  For example, ADD-SUFFIX
should already be present in PLACE and will be removed from it."
  (when-let* (((jumprel-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 (jumprel-recipe--apply-to-filename
                                       path-with-suffix
                                       (apply-partially #'jumprel-recipe--unapply-case-transformer case-transformer))))
    (if add-directory
        (jumprel-recipe--remove-directory-from-path path-with-changed-case add-directory)
      (list path-with-changed-case))))

(defun jumprel-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 jumprel-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 (jumprel-recipe--seq-positions path-segments remove-directory)))
    (cl-loop
     for position in positions
     for candidate = (string-join (jumprel-recipe--seq-remove-at-position path-segments position) "/")
     if (file-exists-p (file-name-directory candidate)) collect candidate)))

(defun jumprel-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 jumprel-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 jumprel-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))))
    (jumprel-recipe--apply-case-transformer untransformer string)))

(defun jumprel-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 jumprel-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 jumprel-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))))

(jumprel-add-jumper-type
 '(cons
   :tag "Recipe"
   (const :tag "" recipe)
   (set
    :tag "Transformations"
    (list :inline t
          :tag "Remove suffix"
          (const :remove-suffix)
          string)
    (list :inline t
          :tag "Add suffix"
          (const :add-suffix)
          string)
    (list :inline t
          :tag "Case transformer"
          (const :case-transformer)
          (choice
           :value capitalize
           (const :tag "Capitalize" capitalize)
           (const :tag "Uncapitalize" uncapitalize)))
    (list :inline t
          :tag "Add directory"
          (const :add-directory)
          string)
    (list :inline t
          :tag "Filler"
          (const :filler)
          jumprel-filler))))

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

(provide 'jumprel-recipe)
;;; jumprel-recipe.el ends here

;; LocalWords:  tranformers el

[-- Attachment #5: jumprel-regexp.el --]
[-- Type: text/plain, Size: 7977 bytes --]

;;; jumprel-recipe.el --- Provide a recipe DSL to define jumprel 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 jumprel.

;; The code below makes it possible to create jumprel 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 'jumprel)
(require 'map)

\f
;;; Overrides of Public Methods

(cl-defmethod jumprel-apply ((jumper (head regexp)) place)
  "Return a list of new places built by applying regexp JUMPER to PLACE."
  (jumprel-recipe--find-sibling-file-search
   place
   (list (list (nth 1 jumper) (nth 2 jumper)))))

(cl-defmethod jumprel-get-filler ((_jumper (head regexp)))
  "Return nil as no filler can be associated with regexp-based jumpers."
  nil)

\f
;;; Emacs 29 functions adapted

(defun jumprel-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 `jumprel-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
                             (jumprel-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 jumprel-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
			     (jumprel-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)))

(jumprel-add-jumper-type
 '(list
   :tag "Regexp"
   (const :tag "" regexp)
   (regexp :tag "match")
   (regexp :tag "expansion")
   (set
    :tag ""
    (list :inline t
          :tag "Filler"
          (const :filler)
          jumprel-filler))))

;;;###autoload
(add-hook 'jumprel-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'regexp) 'safe)))

(provide 'jumprel-regexp)
;;; jumprel-regexp.el ends here

;; LocalWords:  tranformers el

[-- Attachment #6: jumprel-recipe-test.el --]
[-- Type: text/plain, Size: 6722 bytes --]

;;; jumprel-recipe-test.el --- Tests for jumprel-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 jumprel-recipe.el.

;;; Code:

(require 'jumprel-recipe)

\f
;;; Customization Options

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

\f
;;; Utility Functions

(ert-deftest jumprel-recipe-test-apply-filename-jumper ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let* ((place "/emacs-src/lisp/Abbrev.el")
           (places (jumprel-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 jumprel-recipe-test-unapply-filename-jumper ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let* ((place "/emacs-src/test/lisp/abbrev-tests.el")
           (places (jumprel-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 jumprel-recipe-test-add-directory-to-path ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let ((result (jumprel-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 jumprel-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 (jumprel-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
        (should (equal
                 result
                 (list (concat existing-directory "abbrev.el"))))))))

(ert-deftest jumprel-recipe-test-remove-directory-from-path ()
  (cl-letf (((symbol-function 'file-exists-p)
             (lambda (_) t)))
    (let ((result (jumprel-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 jumprel-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 (jumprel-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 jumprel-recipe-test-apply-to-filename ()
  (should (equal (jumprel-recipe--apply-to-filename "/foo/bar" #'upcase) "/foo/BAR"))
  (should (equal (jumprel-recipe--apply-to-filename "/foo/bar/BAZ.EL" #'downcase) "/foo/bar/baz.el")))

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

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

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

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

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

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

[-- Attachment #7: jumprel-test.el --]
[-- Type: text/plain, Size: 5012 bytes --]

;;; jumprel-test.el --- Tests for jumprel             -*- 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 jumprel.el.

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

\f
;;; Customization Options

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

\f
;;; Jumpers Public API

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

\f
;;; Functions Manipulating Places

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

\f
;;; Utility Functions

(ert-deftest jumprel-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
               (jumprel--collect-existing-places (list jumper1) current-place)
               (list new-place))))))

(ert-deftest jumprel-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
               (jumprel--collect-existing-places (list jumper1 jumper2) current-place)
               (list new-place))))))

(ert-deftest jumprel-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 (jumprel--collect-existing-places '(jumper) nil)))

(ert-deftest jumprel-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 (jumprel--call-jumpers
                              (list jumperAtom jumperList)
                              "/")
                             '("/foo" "/bar1" "/bar2")))
    (should (seq-set-equal-p (jumprel--call-jumpers
                              (list jumperAtom jumperSingleton)
                              "/")
                             '("/foo" "/baz")))
    (should (seq-set-equal-p (jumprel--call-jumpers
                              (list jumperAtom jumperNil)
                              "/")
                             '("/foo")))
    (should (seq-set-equal-p (jumprel--call-jumpers
                              (list jumperAtom jumperIdentity)
                              '"/")
                             '("/foo" "/")))
    (should (seq-set-equal-p (jumprel--call-jumpers
                              (list jumperAtom jumperList jumperSingleton jumperNil jumperIdentity)
                              '"/")
                             '("/foo" "/bar1" "/bar2" "/baz" "/")))))

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

(provide 'jumprel-test)
;;; jumprel-test.el ends here