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

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: emacs; Severity: wishlist; Reported by: Damien Cassou <damien@HIDDEN>; Keywords: patch; dated Sun, 25 Sep 2022 11:22:01 UTC; Maintainer for emacs is bug-gnu-emacs@HIDDEN.
Severity set to 'wishlist' from 'normal' Request was from Stefan Kangas <stefankangas@HIDDEN> to control <at> debbugs.gnu.org. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 6 Oct 2022 06:09:21 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Oct 06 02:09:21 2022
Received: from localhost ([127.0.0.1]:58592 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ogK4N-0002zJ-8y
	for submit <at> debbugs.gnu.org; Thu, 06 Oct 2022 02:09:21 -0400
Received: from mail.choca.pics ([80.67.172.235]:36108)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <damien@HIDDEN>) id 1ogK4I-0002z8-N2
 for 58071 <at> debbugs.gnu.org; Thu, 06 Oct 2022 02:09:17 -0400
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 1673F18197CB7;
 Thu,  6 Oct 2022 08:09:13 +0200 (CEST)
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032)
 with ESMTP id jsSoYwoVMDdY; Thu,  6 Oct 2022 08:09:09 +0200 (CEST)
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 25FF118197CB3;
 Thu,  6 Oct 2022 08:09:09 +0200 (CEST)
X-Virus-Scanned: amavisd-new at choca.pics
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026)
 with ESMTP id pAorAH87bJmm; Thu,  6 Oct 2022 08:09:08 +0200 (CEST)
Received: from localhost (153.226.95.79.rev.sfr.net [79.95.226.153])
 by mail.choca.pics (Postfix) with ESMTPSA id 52EF018195798;
 Thu,  6 Oct 2022 08:09:08 +0200 (CEST)
From: Damien Cassou <damien@HIDDEN>
To: Eli Zaretskii <eliz@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <83k05qlgyw.fsf@HIDDEN>
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
Date: Thu, 06 Oct 2022 08:09:07 +0200
Message-ID: <87pmf51o1o.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain

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

Eli Zaretskii <eliz@HIDDEN> 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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=related-files.el

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

;; Copyright (C) 2022  Damien Cassou

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

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)

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

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


;;; 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.")


;;; 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.")

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

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

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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=related-files-recipe.el

;;; 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@HIDDEN>
;; 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)

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

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

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Disposition: attachment; filename=related-files-regexp.el
Content-Transfer-Encoding: quoted-printable

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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@HIDDEN>.  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=E2=80=99re in src/emacs/emacs-27/lisp/abbrev.el,
;; and an src/emacs/emacs-28/lisp/abbrev.el file exists, it=E2=80=99s now
;; defined as a sibling.

;; Regexp-based jumpers as defined here do not support fillers.

;;; Code:

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


;;; Overrides of Public Methods

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

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


;;; Emacs 29 functions adapted

(defun related-files-recipe--find-sibling-file-search (file rules)
  ;; Same as `find-sibling-file-search' in Emacs 29 except that
  ;;
  ;; - `rules' is a mandatory parameter;
  ;;
  ;; - it calls `related-files-recipe--file-expand-wildcards' instead of `f=
ile-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 e=
xpansion 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-nondirect=
ory 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 EXPANSI=
ONS.")
   (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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=related-files-recipe-test.el

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)


;;; 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")))))

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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=related-files-test.el

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)

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

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


;;; 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!)"))))

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

--=-=-=--




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 30 Sep 2022 10:38:34 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Sep 30 06:38:34 2022
Received: from localhost ([127.0.0.1]:40581 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1oeDPc-0004SL-9S
	for submit <at> debbugs.gnu.org; Fri, 30 Sep 2022 06:38:33 -0400
Received: from eggs.gnu.org ([209.51.188.92]:36386)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <eliz@HIDDEN>) id 1oeDPX-0004S5-Fi
 for 58071 <at> debbugs.gnu.org; Fri, 30 Sep 2022 06:38:31 -0400
Received: from fencepost.gnu.org ([2001:470:142:3::e]:46004)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1oeDPQ-0000cl-Sh; Fri, 30 Sep 2022 06:38:20 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date:
 mime-version; bh=s6BuA32fMUx3PpFg6ywfBwKCko/eNFo3rlDFtzFP9wY=; b=GQ/6ohwCjdKj
 yHiOL69SlKNNl+39wZ2gtQ2YpPzembjydwytOSwqRPy8SR+iv6gXTlmgjv2uBgj5MeHOrf65xui+V
 EgzpoqhJaGaU5L+utlXiP7a4ulZXWgnYxy0gxYd4I/XipqQP3JTBJsPesnu/zABgtuZz0MeySi117
 7AQ9HTWyOMTY3Ooo7FR1pkBXST6nPt2aV4ZJq/tAsPkfRwgjUR9Uhz4iwg+zGk7q/wsRnwmnVvaf9
 C09KRpiR5XTiC0gbyX6NAhRJnjuzDTlCelxglxi/zGqv1WvdA/eBqtJwlzIj9cmPn1OgA9+QQjv+Z
 7sOU7hIlJ01N9KlAMwhZng==;
Received: from [87.69.77.57] (port=2934 helo=home-c4e4a596f7)
 by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1oeDPQ-0002vs-5v; Fri, 30 Sep 2022 06:38:20 -0400
Date: Fri, 30 Sep 2022 13:38:05 +0300
Message-Id: <83o7uxdu5u.fsf@HIDDEN>
From: Eli Zaretskii <eliz@HIDDEN>
To: Damien Cassou <damien@HIDDEN>
In-Reply-To: <87czbd8d6j.fsf@HIDDEN> (message from Damien Cassou on Fri, 30
 Sep 2022 10:43:48 +0200)
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
 <874jwr9u6c.fsf@HIDDEN> <835yh6h867.fsf@HIDDEN> <87czbd8d6j.fsf@HIDDEN>
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

> From: Damien Cassou <damien@HIDDEN>
> Cc: 58071 <at> debbugs.gnu.org
> Date: Fri, 30 Sep 2022 10:43:48 +0200
> 
> Eli Zaretskii <eliz@HIDDEN> writes:
> > I guess the doc string of jumprel-jumpers would be a possibility.
> 
> `jumprel-jumpers' is in jumprel.el which is independent of
> jumprel-recipe.el. I would like to keep the responsibility clean if
> possible.

jumprel-recipe.el is AFAICT devoid of any recipe-related public APIs,
so I don't see how such a separation can be possible.  I also question
the motivation: is jumprel.el really independent of the inner workings
of the recipes as implemented in jumprel-recipe.el?  The interface
doesn't seem to me abstract enough to justify the separation.  Even if
I did agree that documentation must always be in the same place as the
code.  Which I don't necessarily agree with: there are many examples
when documentation and implementation are physically on different
files.

Anyway, you asked for suggestions, and I gave you one.  I still think
there's nothing wrong with it, but feel free to add the documentation
in some other place which looks more correct to you.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 30 Sep 2022 08:45:00 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Sep 30 04:45:00 2022
Received: from localhost ([127.0.0.1]:40474 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1oeBdj-0001Uk-VB
	for submit <at> debbugs.gnu.org; Fri, 30 Sep 2022 04:45:00 -0400
Received: from mail.choca.pics ([80.67.172.235]:49964)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <damien@HIDDEN>) id 1oeBdi-0001Ud-9d
 for 58071 <at> debbugs.gnu.org; Fri, 30 Sep 2022 04:44:58 -0400
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id CF3B9181942A3;
 Fri, 30 Sep 2022 10:44:57 +0200 (CEST)
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032)
 with ESMTP id vngfTmIF6EH3; Fri, 30 Sep 2022 10:44:57 +0200 (CEST)
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 7018C181942A7;
 Fri, 30 Sep 2022 10:44:57 +0200 (CEST)
X-Virus-Scanned: amavisd-new at choca.pics
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026)
 with ESMTP id uyEyoGRHdAsg; Fri, 30 Sep 2022 10:44:57 +0200 (CEST)
Received: from localhost (240-68-190-109.dsl.ovh.fr [109.190.68.240])
 by mail.choca.pics (Postfix) with ESMTPSA id 314BC181942A3;
 Fri, 30 Sep 2022 10:44:57 +0200 (CEST)
From: Damien Cassou <damien@HIDDEN>
To: Lars Ingebrigtsen <larsi@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <87ill6ihkv.fsf@HIDDEN>
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
 <874jwr9u6c.fsf@HIDDEN> <87ill6ihkv.fsf@HIDDEN>
Date: Fri, 30 Sep 2022 10:44:56 +0200
Message-ID: <87a66h8d4n.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 58071
Cc: Eli Zaretskii <eliz@HIDDEN>, 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Lars Ingebrigtsen <larsi@HIDDEN> writes:
> The similarity between completion frameworks and "jumping to files" is
> that people have different needs.  Some would prefer something that
> guesses for you, while others prefer to make the rules explicit.


Why not having both with a reasonable default values that people can
populate? That being said, for now, jumprel and find-sibling-file both
provide no rule by default.

-- 
Damien Cassou

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




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 30 Sep 2022 08:43:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Sep 30 04:43:56 2022
Received: from localhost ([127.0.0.1]:40470 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1oeBci-0001Sz-J8
	for submit <at> debbugs.gnu.org; Fri, 30 Sep 2022 04:43:56 -0400
Received: from mail.choca.pics ([80.67.172.235]:49926)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <damien@HIDDEN>) id 1oeBce-0001Sm-8x
 for 58071 <at> debbugs.gnu.org; Fri, 30 Sep 2022 04:43:55 -0400
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 30E2B181942A3;
 Fri, 30 Sep 2022 10:43:50 +0200 (CEST)
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032)
 with ESMTP id inAz-x6j2mvL; Fri, 30 Sep 2022 10:43:49 +0200 (CEST)
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 989A0181942A7;
 Fri, 30 Sep 2022 10:43:49 +0200 (CEST)
X-Virus-Scanned: amavisd-new at choca.pics
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026)
 with ESMTP id KCT2ymiXFwX6; Fri, 30 Sep 2022 10:43:49 +0200 (CEST)
Received: from localhost (240-68-190-109.dsl.ovh.fr [109.190.68.240])
 by mail.choca.pics (Postfix) with ESMTPSA id 49D16181942A3;
 Fri, 30 Sep 2022 10:43:49 +0200 (CEST)
From: Damien Cassou <damien@HIDDEN>
To: Eli Zaretskii <eliz@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <835yh6h867.fsf@HIDDEN>
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
 <874jwr9u6c.fsf@HIDDEN> <835yh6h867.fsf@HIDDEN>
Date: Fri, 30 Sep 2022 10:43:48 +0200
Message-ID: <87czbd8d6j.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

>> Eli Zaretskii <eliz@HIDDEN> writes:
>>> what you call "recipes", [=E2=80=A6] should be documented in a single d=
oc
>>> string, and the other places that use recipes should reference the
>>> symbol whose doc string documents them

> From: Damien Cassou <damien@HIDDEN>
>> do you have any suggestion for this?

Eli Zaretskii <eliz@HIDDEN> writes:
> I guess the doc string of jumprel-jumpers would be a possibility.


`jumprel-jumpers' is in jumprel.el which is independent of
jumprel-recipe.el. I would like to keep the responsibility clean if
possible.



--=20
Damien Cassou

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




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 29 Sep 2022 10:46:35 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Sep 29 06:46:35 2022
Received: from localhost ([127.0.0.1]:36137 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1odr3r-0002Eg-G7
	for submit <at> debbugs.gnu.org; Thu, 29 Sep 2022 06:46:35 -0400
Received: from quimby.gnus.org ([95.216.78.240]:44202)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <larsi@HIDDEN>) id 1odr3p-0002ER-Od
 for 58071 <at> debbugs.gnu.org; Thu, 29 Sep 2022 06:46:34 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org;
 s=20200322; h=Content-Transfer-Encoding:Content-Type:MIME-Version:Message-ID
 :Date:References:In-Reply-To:Subject:Cc:To:From:Sender:Reply-To:Content-ID:
 Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc
 :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe:
 List-Post:List-Owner:List-Archive;
 bh=m8YOZs5wMTsqS3Jl2MtKYcDixlxuX9W4hI49OZb8NXA=; b=Y4aIJrQ9LB3/ZYUvlgL89wVbHx
 z8RaJZnGCIf4gp2Mcxbsmp5+T3ULQdrEHJy6i++fR7ujhqieeBi6K+A5NvLbrkDvXeCOR6oAt84A6
 XZHIMq7AEuvlccJTkY2XEwJSxMtxk8eQ33QzNCtkik/YvnD8MF3LJkAJQIqi0D1r0bcc=;
Received: from [84.212.220.105] (helo=joga)
 by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.92) (envelope-from <larsi@HIDDEN>)
 id 1odr3h-0005Jg-39; Thu, 29 Sep 2022 12:46:27 +0200
From: Lars Ingebrigtsen <larsi@HIDDEN>
To: Damien Cassou <damien@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <874jwr9u6c.fsf@HIDDEN> (Damien Cassou's message of "Wed, 28
 Sep 2022 21:26:51 +0200")
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
 <874jwr9u6c.fsf@HIDDEN>
Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAABGdBTUEAALGPC/xhBQAAACBj
 SFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAElBMVEWZb3hlVl+/qKtM
 MzwkFhn///8fEXZMAAAAAWJLR0QF+G/pxwAAAAd0SU1FB+YJHQoaLsLGzc4AAAGuSURBVDjLrZNr
 kuMgDIQFzgHAcABZcwF7xAHioPufaVt+TZLZ/NiqVVXi4I9u9CBEiJDfIwnlv8ZnQB9A/n8ghRMU
 Xfz7NzDrWYHzsq/jAUpXAMQpOUFTtUX3eAFmzdYD7Ganwsw0/wYwsl7nopqmw+wArjBFziIDNMuT
 ogOoAy5a+gl869AbcosuaesFZhGpXWfCMyDzC3zjxa37fjxRa3AQxgHWwrUvlCmGpiNkhCkKuxPF
 MrMStU0IACwZnyhfD8k0oAczxwO4WCSNQqGarcJUNqvB/HC4ETIygxM80Uip9mAkylm4devYMnVC
 cWrtQRTlhhzqUtatJsqKwuwuLPE2EpUYvchqAMiv2SgcCzEl8SLZHBisXBINCn9LVHvZASLV2b7j
 4Af7zVDS7bUH8lFLUUr11RPYYuWhhR1s63bJJm15A836UhJdhMr+E81Eh4TqCcbp2NDu3iPM8wD3
 Q0vb1Igj22uQd4aZ4vQOfHgSpiM7v0VPgGlIGB1ull1VUfJBoKkbeLbSu58ReHg/A32VIH54by+g
 dcwT1+LrXdFswX8m/JR+WX2Ifwd/ABSkr20AjVmfAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIyLTA5
 LTI5VDEwOjI2OjQ2KzAwOjAw2i+/hgAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMi0wOS0yOVQxMDoy
 Njo0NiswMDowMKtyBzoAAAAASUVORK5CYII=
X-Now-Playing: New Order's _Power, Corruption & Lies_: "Blue Monday"
Date: Thu, 29 Sep 2022 12:46:24 +0200
Message-ID: <87ill6ihkv.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 @@CONTACT_ADDRESS@@ for details.
 
 Content preview:  Damien Cassou <damien@HIDDEN> writes: > I'm not sure I
   understand what you mean. I agree that there is no point > in having 10 many
    different completion frameworks in Emacs core (even > though we might be
   close to this number already 😊 [...] 
 
 Content analysis details:   (-2.9 points, 5.0 required)
 
  pts rule name              description
 ---- ---------------------- --------------------------------------------------
 -1.0 ALL_TRUSTED            Passed through trusted hosts only via SMTP
 -1.9 BAYES_00               BODY: Bayes spam probability is 0 to 1%
                             [score: 0.0000]
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: Eli Zaretskii <eliz@HIDDEN>, 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Damien Cassou <damien@HIDDEN> writes:

> I'm not sure I understand what you mean. I agree that there is no point
> in having 10 many different completion frameworks in Emacs core (even
> though we might be close to this number already =F0=9F=98=8A).
>
> Similarly, I wouldn't like to have 3 find-related-files packages. But I
> think that, contrary to completion frameworks, these 3 packages provide
> the same feature: namely "a command to find file(s) related to the
> current one". Said differently, the user-visible behavior is the
> same. As soon as the setup is done, there shouldn't any difference
> between `find-sibling-file' and `jumprel'.

The similarity between completion frameworks and "jumping to files" is
that people have different needs.  Some would prefer something that
guesses for you, while others prefer to make the rules explicit.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 29 Sep 2022 08:55:09 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Sep 29 04:55:09 2022
Received: from localhost ([127.0.0.1]:35915 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1odpK1-0002lr-0O
	for submit <at> debbugs.gnu.org; Thu, 29 Sep 2022 04:55:09 -0400
Received: from eggs.gnu.org ([209.51.188.92]:45318)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <eliz@HIDDEN>) id 1odpJy-0002lR-J3
 for 58071 <at> debbugs.gnu.org; Thu, 29 Sep 2022 04:55:06 -0400
Received: from fencepost.gnu.org ([2001:470:142:3::e]:57910)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1odpJs-0001bH-NI; Thu, 29 Sep 2022 04:55:00 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date:
 mime-version; bh=hgwRDXqK9a2ZYCibHQ2S/Lqo4UktjJX4jq0nhfsYnsM=; b=ngL33xEAJSHy
 Y0DpmBWTLaHhsQAnwm0lPN67iI7d8AxVKHQyI0k2sugzkA++2eh8e2bIgB/6AvdSzj+5Busqq5FV5
 hwCWL+c78xyYTIeXA0NFdoiDxlmEEhVKN95D8n5b03MGgVe4SE6eWcXQA9qAjNCMszyLEN5LCVxW7
 x/Xp4Q8uG40x/Z+S34UD+RXPbsc57fufvTQtkQNNKrxQBAvb+K1/+VdsFVH8R+rLWj4YsdYDimX+r
 FtcDsM2S335KXE6juZO07D5Fn7DUR4f2zjTN95kk8U/4KkslBbwfutCWghDt1YeJdap4fY3j7b1HJ
 EtaGRH+r2C6dues43waQIA==;
Received: from [87.69.77.57] (port=3692 helo=home-c4e4a596f7)
 by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1odpJs-00042F-2l; Thu, 29 Sep 2022 04:55:00 -0400
Date: Thu, 29 Sep 2022 11:54:56 +0300
Message-Id: <835yh6h867.fsf@HIDDEN>
From: Eli Zaretskii <eliz@HIDDEN>
To: Damien Cassou <damien@HIDDEN>
In-Reply-To: <874jwr9u6c.fsf@HIDDEN> (message from Damien Cassou on Wed, 28
 Sep 2022 21:26:51 +0200)
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
 <874jwr9u6c.fsf@HIDDEN>
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

> From: Damien Cassou <damien@HIDDEN>
> Cc: 58071 <at> debbugs.gnu.org
> Date: Wed, 28 Sep 2022 21:26:51 +0200
> 
> > - 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, and the other places that use recipes should
> > reference the symbol whose doc string documents them
> 
> do you have any suggestion for this? The only place I can find is
> `jumprel-recipe--apply-filename-jumper' which is private. I could also
> add it to the override of `jumprel-apply' but I'm not sure how to
> reference an override from a docstring.

I guess the doc string of jumprel-jumpers would be a possibility.

> 
> > - I find no documentation of how to describe alternatives -- several
> > alternative file names produced from a single original file name
> 
> several alternatives can be produced with:
> 
> 1. several jumpers produce several alternatives: all jumpers are
> executed on the current file name and their results are merged into a
> single list of candidates (see `jumprel--collect-existing-places' and
> `jumprel--call-jumpers').
> 
> 2. a function-based jumper returning a list (this is described in the
>    docstring of `jumprel-apply')
> 
> 3. a regexp-based jumper may also return a list of candidates if the
> globs match several existing filenames
> 
> 4. a recipe-based jumper may also return a list of candidates if
> :add-directory is used and several matching directories exist
> 
> Does that answer your question or did I miss the point?

It does answer, but this should be documented.

> What do you expect from me now? Send a new patch with the new package
> name? Or do you plan to give more feedback first?

A new patch, I guess.  With a better name and with the
documentation-related issues mentioned above fixed.

We should then discuss whether to have this in core or on ELPA.  Such
a discussion would perhaps need to be on emacs-devel, not here, to
catch a wider audience.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 28 Sep 2022 19:26:59 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Sep 28 15:26:59 2022
Received: from localhost ([127.0.0.1]:34756 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1odchu-0003CI-Nt
	for submit <at> debbugs.gnu.org; Wed, 28 Sep 2022 15:26:59 -0400
Received: from mail.choca.pics ([80.67.172.235]:46034)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <damien@HIDDEN>) id 1odchr-0003C7-MG
 for 58071 <at> debbugs.gnu.org; Wed, 28 Sep 2022 15:26:58 -0400
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id BDE5E181942A3;
 Wed, 28 Sep 2022 21:26:53 +0200 (CEST)
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032)
 with ESMTP id 9Dl88vGLN1gO; Wed, 28 Sep 2022 21:26:52 +0200 (CEST)
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id CE880181942A7;
 Wed, 28 Sep 2022 21:26:52 +0200 (CEST)
X-Virus-Scanned: amavisd-new at choca.pics
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026)
 with ESMTP id phFrcIRk7bcC; Wed, 28 Sep 2022 21:26:52 +0200 (CEST)
Received: from localhost (153.226.95.79.rev.sfr.net [79.95.226.153])
 by mail.choca.pics (Postfix) with ESMTPSA id 7A782181942A3;
 Wed, 28 Sep 2022 21:26:52 +0200 (CEST)
From: Damien Cassou <damien@HIDDEN>
To: Eli Zaretskii <eliz@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <83k05qlgyw.fsf@HIDDEN>
References: <878rm7wvib.fsf@HIDDEN> <83k05qlgyw.fsf@HIDDEN>
Date: Wed, 28 Sep 2022 21:26:51 +0200
Message-ID: <874jwr9u6c.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Thank you very much Eli for your review. I appreciate the time you took
to have a look at my code. I imagine how busy you are and my package
isn't small.

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

sure

> - 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, and the other places that use recipes should
> reference the symbol whose doc string documents them

do you have any suggestion for this? The only place I can find is
`jumprel-recipe--apply-filename-jumper' which is private. I could also
add it to the override of `jumprel-apply' but I'm not sure how to
reference an override from a docstring.

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

several alternatives can be produced with:

1. several jumpers produce several alternatives: all jumpers are
executed on the current file name and their results are merged into a
single list of candidates (see `jumprel--collect-existing-places' and
`jumprel--call-jumpers').

2. a function-based jumper returning a list (this is described in the
   docstring of `jumprel-apply')

3. a regexp-based jumper may also return a list of candidates if the
globs match several existing filenames

4. a recipe-based jumper may also return a list of candidates if
:add-directory is used and several matching directories exist

Does that answer your question or did I miss the point?

> - I wonder whether "recipes" like these are a convenient method of
>    customizing this facility: do people really find it easy to write
>    "ordered" property lists for this purpose?

I find the resulting syntax very easy to read:

(recipe :remove-suffix ".js" :add-suffix "-tests.js" :add-directory "tests"=
 :case-transformer uncapitalize)
(recipe :remove-suffix ".js" :add-suffix ".spec.component.js" :filler (yasn=
ippet :name "componentSpec"))
(recipe :remove-suffix ".js" :add-suffix ".less")
(recipe :remove-suffix ".js" :add-suffix ".stories.js" :filler (yasnippet :=
name "stories")))

I think this is much clearer than using regular expressions but this is
maybe only me? If you don't like the recipe syntax, we can leave this
one out of the patch and only include regexp-based jumpers.

What do you expect from me now? Send a new patch with the new package
name? Or do you plan to give more feedback first?

Lars Ingebrigtsen <larsi@HIDDEN> writes:
> I think jumprel would probably be better suited as an ELPA
> package. Like completion frameworks, there's no one size fits all in
> this area -- the DWIM for one person isn't the DWIM for another
> person.

Thank you very much Lars for giving feedback on this package! I
appreciate your point of view because you've already written a similar
feature which probably means you are using it.

> jumprel is a different take on what find-file does, just like Helm is
> a different take how completion should look.

I'm not sure I understand what you mean. I agree that there is no point
in having 10 many different completion frameworks in Emacs core (even
though we might be close to this number already =F0=9F=98=8A).

Similarly, I wouldn't like to have 3 find-related-files packages. But I
think that, contrary to completion frameworks, these 3 packages provide
the same feature: namely "a command to find file(s) related to the
current one". Said differently, the user-visible behavior is the
same. As soon as the setup is done, there shouldn't any difference
between `find-sibling-file' and `jumprel'.

Is there anything in your process that would change if you would switch
from `find-sibling-file' to `jumprel'?

In my opinion, what differs between these packages is the extensibility
of the implementation. If regexps are a good solution to configure
relations between files, both packages support that thanks to your
work. But if users want something else, they could only get it in
`jumprel': either with functions, with recipes or with something else of
their creation.

Also, jumprel supports creation of related files and automatic filling
of new files through an extensible mechanism I called a "filler".

Best

--=20
Damien Cassou

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




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 27 Sep 2022 11:34:53 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Sep 27 07:34:53 2022
Received: from localhost ([127.0.0.1]:53164 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1od8rV-0003ed-C6
	for submit <at> debbugs.gnu.org; Tue, 27 Sep 2022 07:34:53 -0400
Received: from quimby.gnus.org ([95.216.78.240]:51412)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <larsi@HIDDEN>) id 1od8rT-0003eO-6V
 for 58071 <at> debbugs.gnu.org; Tue, 27 Sep 2022 07:34:52 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org;
 s=20200322; h=Content-Type:MIME-Version:Message-ID:Date:References:
 In-Reply-To:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:
 Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender:
 Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:
 List-Subscribe:List-Post:List-Owner:List-Archive;
 bh=bt2+/nqoOJthV5IyCrhcfQf0zvHfvXHlgEZjWvl8tqc=; b=dR07tfQ0tNablbVEO9sNeF1PMY
 XqQ2sbRR4Wnnv7wd2zEwGa8NuNtsnh/3Eca1NjsyRJZxg5ock81xtEBJDVnrJ5YYin1FCdf5ENuK7
 H8UR5/AVvMCe7KrO30fzd0UQ85qDnj0jG5jBrpd+OWVp3bZLtHUXF461oddZDh0M9QCw=;
Received: from [84.212.220.105] (helo=joga)
 by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.92) (envelope-from <larsi@HIDDEN>)
 id 1od8rJ-0001Ls-NR; Tue, 27 Sep 2022 13:34:43 +0200
From: Lars Ingebrigtsen <larsi@HIDDEN>
To: Stefan Kangas <stefankangas@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <CADwFkmn0559DdcLZhagOQr9U+mgB_UPYLtcbX57WcCXGtftu3A@HIDDEN>
 (Stefan Kangas's message of "Mon, 26 Sep 2022 09:37:40 -0400")
References: <878rm7wvib.fsf@HIDDEN> <87pmfi8kgh.fsf@HIDDEN>
 <CADwFkmn0559DdcLZhagOQr9U+mgB_UPYLtcbX57WcCXGtftu3A@HIDDEN>
Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAABGdBTUEAALGPC/xhBQAAACBj
 SFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAElBMVEXPzMaXjWZYSzAR
 FRKRXiX///9EDnzxAAAAAWJLR0QF+G/pxwAAAAd0SU1FB+YJGwsWLz3dh78AAAGQSURBVDjLfZQL
 loMgDEWhKxBwATVhARpcQAez/zVNwk/bscM5SsuVl+QRNebrcLdjMo90O1bzgPaTsM7YAXUQyvKG
 lBAVjN2ivLhAGiG8AQAgQJIJ0htoiiN4mY+TQIF3QOUGgA/BAViuiJcgHWRdqaSkBauxZ7mQTwcE
 lIfLzeXzIZGSHLybxA/6qQCoxSDvnTNBQIsOWMEGzlrrReoj3dWrcSA73wFtoaay9/LVRQFbEk2N
 R0dfFlcELBLk6uvFEuzneeNV+h8Mj6mB0Q9/QA+hM+IpNQB8kbpoqrvfsuJSbfsfLwDEiSinSpRm
 XPwFZEo0Y4LFL9L91TcFMe8JI1KejJPXJdQUdAfTLiDiNs3S1a5LWWY5iSgd8nQ+kMULEBneOdGC
 FKw/QUwxMx/FEJjmAXJMjLKtVExrOEEmZs56wNI5dALOsQDdA6k3xQAHCZBOhdbDT81KB0ZOuGeK
 SnKiASAyHXJ1rwc44rHnllvaI3eQSy25AVl4Gauhpeyix6UYfebVP0F6s5OpHx4dvwZbxTaWPLnh
 AAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIyLTA5LTI3VDExOjIyOjQ3KzAwOjAwiKc7ZgAAACV0RVh0
 ZGF0ZTptb2RpZnkAMjAyMi0wOS0yN1QxMToyMjo0NyswMDowMPn6g9oAAAAASUVORK5CYII=
X-Now-Playing: Simon & Garfunkel's _Parsley, Sage, Rosemary and Thyme_: "A
 Simple Desultory Philippic (Or How I Was Robert McNamara'd into
 Submission)"
Date: Tue, 27 Sep 2022 13:34:41 +0200
Message-ID: <87czbh59v2.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 @@CONTACT_ADDRESS@@ for details.
 Content preview:  Stefan Kangas <stefankangas@HIDDEN> writes: >> I think
 jumprel would probably be better suited as an ELPA package. >> Like completion
 frameworks, there's no one size fits all in this area -- >> the DWIM for
 one person isn't the DWIM for another [...] 
 Content analysis details:   (-2.9 points, 5.0 required)
 pts rule name              description
 ---- ---------------------- --------------------------------------------------
 -1.0 ALL_TRUSTED            Passed through trusted hosts only via SMTP
 -1.9 BAYES_00               BODY: Bayes spam probability is 0 to 1%
 [score: 0.0000]
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: Damien Cassou <damien@HIDDEN>, 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Stefan Kangas <stefankangas@HIDDEN> writes:

>> I think jumprel would probably be better suited as an ELPA package.
>> Like completion frameworks, there's no one size fits all in this area --
>> the DWIM for one person isn't the DWIM for another person.
>
> I'd think we want such basic functionality built-in and working OOTB.

We already have this basic functionality built-in.  jumprel is a
different take on what find-file does, just like Helm is a different
take how completion should look.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 26 Sep 2022 13:37:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 26 09:37:49 2022
Received: from localhost ([127.0.0.1]:49728 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ocoIu-0005vu-QC
	for submit <at> debbugs.gnu.org; Mon, 26 Sep 2022 09:37:49 -0400
Received: from mail-oa1-f45.google.com ([209.85.160.45]:39823)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <stefankangas@HIDDEN>) id 1ocoIs-0005vh-QD
 for 58071 <at> debbugs.gnu.org; Mon, 26 Sep 2022 09:37:47 -0400
Received: by mail-oa1-f45.google.com with SMTP id
 586e51a60fabf-11e9a7135easo9232679fac.6
 for <58071 <at> debbugs.gnu.org>; Mon, 26 Sep 2022 06:37:46 -0700 (PDT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112;
 h=cc:to:subject:message-id:date:mime-version:references:in-reply-to
 :from:from:to:cc:subject:date;
 bh=DqQZjdLNXVx2DFYbvybya/uQT5Cik/Azv9Ih6CMUi1s=;
 b=FuKi0/qBViFLB1CSugzUOUyDIMc32ubZ8fUdvnu8UYWEiRu9tFRthykO8A0T7eAfcv
 qoiSjV0C5V7D6DlVsTSQ/dIE1GEDiMeuaw9OpvZOWyxG9KBsckljmcCeYrLrvWPILOnv
 NUrPzrwX2cHleeuaDbJRWflXXkMnlHt0LlRpiZShDGku6fUyMA8EDeUjeNdkAssHYw8y
 Sqt0f24eGaKOaClWfjz/IAn/kwGr+19aTYAw9AHbFBp3V95fFJ6WDOm4EC6j4eDuB5l+
 w2/b9ZO+qZV6bm5b5UjDAUzvHMkM0AiBpAAjJlr6x2CRj4oMUmu09KpKX5MDJ41b4hgF
 7s6Q==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20210112;
 h=cc:to:subject:message-id:date:mime-version:references:in-reply-to
 :from:x-gm-message-state:from:to:cc:subject:date;
 bh=DqQZjdLNXVx2DFYbvybya/uQT5Cik/Azv9Ih6CMUi1s=;
 b=L0hajv+VOcu8RiaqixIifr1EKZHBcAfvJAJqyRDTdUNObOM8qriPrxNEKpU5NkRGG7
 D+fXgHgGb60dAdnCo0MdesvGpbJ6bhUMy7j6hlxedK77S3OLtGZ28oycwMPoq31b9sA1
 rou54TRbib6v13gfxNdHhGxxr6VOEur7k7b4ETh/auJ3sEP+Vf/vtldntlLmaH9v6/iK
 dv6VkZdqMaKzQdkSiVEYVr5/OdnfWjezEYjD9abqJk1yKrYWcR29nUkaDx5YZ0E8o9Zx
 IcAIlsBAj1u3u5jKOLedaa7jMzDSDo7LJK5ZcCC0LRzHDN9PqzLzHaob56xrECswPiz8
 CB1Q==
X-Gm-Message-State: ACrzQf0WyMaPPpG1M/1ubU4GPBSyvNZ0r1a6kjbOjKRwH4w6NwWlkALV
 TKE2Z/pEwnFYhZrIAkvvRA0rM39+64+lOXmqpZtuYYJs
X-Google-Smtp-Source: AMsMyM6XLZ0BMjxZNKoWXU3qoR3/nux+h1Om/iHf2J7yXZPjcHlKerJxMFyISkqo2FXrNn0ry9yPPmkdtSJQEYwowQM=
X-Received: by 2002:a05:6870:b508:b0:12d:1c59:90d9 with SMTP id
 v8-20020a056870b50800b0012d1c5990d9mr18562586oap.199.1664199461171; Mon, 26
 Sep 2022 06:37:41 -0700 (PDT)
Received: from 753933720722 named unknown by gmailapi.google.com with
 HTTPREST; Mon, 26 Sep 2022 09:37:40 -0400
From: Stefan Kangas <stefankangas@HIDDEN>
In-Reply-To: <87pmfi8kgh.fsf@HIDDEN>
References: <878rm7wvib.fsf@HIDDEN> <87pmfi8kgh.fsf@HIDDEN>
X-Hashcash: 1:20:220926:58071 <at> debbugs.gnu.org::d6QlWd5q/i5KP/Qk:33gZ
MIME-Version: 1.0
Date: Mon, 26 Sep 2022 09:37:40 -0400
Message-ID: <CADwFkmn0559DdcLZhagOQr9U+mgB_UPYLtcbX57WcCXGtftu3A@HIDDEN>
Subject: Re: bug#58071: 28.2;
 [PATCH] jumprel: A tool to find/create related files
To: Lars Ingebrigtsen <larsi@HIDDEN>, Damien Cassou <damien@HIDDEN>
Content-Type: text/plain; charset="UTF-8"
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Lars Ingebrigtsen <larsi@HIDDEN> writes:

> I think jumprel would probably be better suited as an ELPA package.
> Like completion frameworks, there's no one size fits all in this area --
> the DWIM for one person isn't the DWIM for another person.

I'd think we want such basic functionality built-in and working OOTB.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 26 Sep 2022 11:05:29 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 26 07:05:29 2022
Received: from localhost ([127.0.0.1]:49410 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1oclvV-0007qZ-9t
	for submit <at> debbugs.gnu.org; Mon, 26 Sep 2022 07:05:29 -0400
Received: from quimby.gnus.org ([95.216.78.240]:39900)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <larsi@HIDDEN>) id 1oclvT-0007qK-Mt
 for 58071 <at> debbugs.gnu.org; Mon, 26 Sep 2022 07:05:28 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org;
 s=20200322; h=Content-Type:MIME-Version:Message-ID:Date:References:
 In-Reply-To:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:
 Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender:
 Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:
 List-Subscribe:List-Post:List-Owner:List-Archive;
 bh=2+IyILvOzQdgFbFozBibDZWS7IJjrMdCaQphgKrK1/I=; b=rLbqr+Z93RiCLELR+g5aU3BNsg
 Nc3Dd0ZWMhS+UijMAhKeb7FDPkbFE+GkrnwViaNQE5xxke6R88EaLYMLAqJZlwOkDxceN6H0ChGWk
 sL5gX8PSMK5eHRhwj/8SpPCwiFmDeaSYUaRqx8t+r8Uxk1RVmwAvG9C+ZWe7ZJNr7J4Q=;
Received: from [84.212.220.105] (helo=joga)
 by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.92) (envelope-from <larsi@HIDDEN>)
 id 1oclvL-0007GZ-Em; Mon, 26 Sep 2022 13:05:21 +0200
From: Lars Ingebrigtsen <larsi@HIDDEN>
To: Damien Cassou <damien@HIDDEN>
Subject: Re: bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related
 files
In-Reply-To: <878rm7wvib.fsf@HIDDEN> (Damien Cassou's message of "Sun, 25
 Sep 2022 13:20:28 +0200")
References: <878rm7wvib.fsf@HIDDEN>
Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAABGdBTUEAALGPC/xhBQAAACBj
 SFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAD1BMVEUiHy9ANEEaGDPL
 e0n///8Oec6aAAAAAWJLR0QEj2jZUQAAAAd0SU1FB+YJGgoyLOxCOvEAAAGpSURBVDjLbZSJdcQw
 CEQBNwBSA1hpIIr77y0Durx5YS+vvmEAIROFsRneL1Om5u1fAyB6L7DJAGlywIVAJT2W66QXxOQA
 p/m/MZG3A4RV2UtqwNlYBnBhaeKKyy97oNLLBOSCe7mEh6l1m6G8Qfo2/c5orZWlAT0UZF352Vlm
 KpByLPbGtezKE4QEVxG6+yeI+kzDcQPKbNEwMnL19vjLw4VMHB7O0v2IO0n+qOAWe2sgEGo3C8wn
 lGTv+UG2Uf1LI7ekPiD4umb7EzhpgjCk8OnxLFNawP8CeQHmuVyPxxisCWrfIG1pdzYAmr3yCQzA
 qC4glP27sopvgDLFMyeuhrsxBnj90EgowzEcVK+I9pSI7u2A3vFBXqlBEaqdbAeIjY6B9jgfBxg8
 IqNRi64eookx3kS7JYPEfI6aF7AM1iPrD7BUaoI2Qo2ErQ51Mx9jsFoZIIsfYE37FEG7dG1t+GAS
 cQZGrHliAHDYWQ0NzuoxW+s4axwh4+65WYZ2vA4nmoks7xqR9sA5ltijO3Kb7sdEAMRyWiYjQj5L
 cHfb6yspOhezRcOFfgEKDG6WHUUrNgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMi0wOS0yNlQxMDo1
 MDo0NCswMDowMOd/rFEAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjItMDktMjZUMTA6NTA6NDQrMDA6
 MDCWIhTtAAAAAElFTkSuQmCC
X-Now-Playing: Fire Escape's _Abandon Head_: "Dreaming I'm Asleep"
Date: Mon, 26 Sep 2022 13:05:18 +0200
Message-ID: <87pmfi8kgh.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 @@CONTACT_ADDRESS@@ for details.
 Content preview: Damien Cassou <damien@HIDDEN> writes: > - jumprel.el: The
 core of the library. This is where you will find an > introductory
 documentation.
 I think jumprel would probably be better suited as an ELPA package. Like
 completion frameworks, there's no one size fits all in this area -- the DWIM
 for one person isn't the DWIM for another person. 
 Content analysis details:   (-2.9 points, 5.0 required)
 pts rule name              description
 ---- ---------------------- --------------------------------------------------
 -1.0 ALL_TRUSTED            Passed through trusted hosts only via SMTP
 -1.9 BAYES_00               BODY: Bayes spam probability is 0 to 1%
 [score: 0.0000]
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Damien Cassou <damien@HIDDEN> writes:

> - jumprel.el: The core of the library. This is where you will find an
>   introductory documentation.

I think jumprel would probably be better suited as an ELPA package.
Like completion frameworks, there's no one size fits all in this area --
the DWIM for one person isn't the DWIM for another person.




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at 58071 <at> debbugs.gnu.org:


Received: (at 58071) by debbugs.gnu.org; 26 Sep 2022 07:42:34 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 26 03:42:34 2022
Received: from localhost ([127.0.0.1]:49173 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ocil8-0000FE-AA
	for submit <at> debbugs.gnu.org; Mon, 26 Sep 2022 03:42:34 -0400
Received: from eggs.gnu.org ([209.51.188.92]:46956)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <eliz@HIDDEN>) id 1ocil6-0000F1-E4
 for 58071 <at> debbugs.gnu.org; Mon, 26 Sep 2022 03:42:32 -0400
Received: from fencepost.gnu.org ([2001:470:142:3::e]:45526)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1ocikz-0008Sa-UG; Mon, 26 Sep 2022 03:42:25 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date:
 mime-version; bh=owk2yhYPbnifrN3pbKWlfVjwauvuHI98VXebDoEmuWA=; b=AX0STOgnS14O
 DW6ENoG/b7umi3N3C2fkENJu8BXmI9xKySsFOPHQu1x+bz6RBkWO9l8GU8LPT4+bed52Ee7lCq8Fr
 ADStYCtrIVZIqFrgz8VEnWbOjfVjl0bFzrXyYO1zsbKSACW0uDJKZYvXPQJq2FJXA3odpOf6ykB3M
 uloSVFKRnyfNx4bUrw0jhgVxX5NYWvHXQERGqYXhkNHRgEyQkmGn03hGgYbvwj+klygFoNGE9pDVm
 Gnwamb/gMS+6IFp7disiwawNRrsaTGuD032OIKUArVvuRSear2G14gmiHxicT8bmDIpDwRW59Rmh7
 8DNEu5XEYqKxbYJ7sHcT3Q==;
Received: from [87.69.77.57] (port=1675 helo=home-c4e4a596f7)
 by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <eliz@HIDDEN>)
 id 1ocikz-0002s5-CT; Mon, 26 Sep 2022 03:42:25 -0400
Date: Mon, 26 Sep 2022 10:42:15 +0300
Message-Id: <83k05qlgyw.fsf@HIDDEN>
From: Eli Zaretskii <eliz@HIDDEN>
To: Damien Cassou <damien@HIDDEN>
In-Reply-To: <878rm7wvib.fsf@HIDDEN> (message from Damien Cassou on Sun, 25
 Sep 2022 13:20:28 +0200)
Subject: Re: bug#58071: 28.2;
 [PATCH] jumprel: A tool to find/create related files
References: <878rm7wvib.fsf@HIDDEN>
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 58071
Cc: 58071 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

> From: Damien Cassou <damien@HIDDEN>
> Date: Sun, 25 Sep 2022 13:20:28 +0200
> 
> 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".

Thanks.  A few high-level comments I have are:

 . "jumprel" is not the best name, IMO; something like "related-files"
   would be better
 . 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, and the other places that use recipes
   should reference the symbol whose doc string documents them
   (currently, it looks like the documentation is scattered all over
   the code and comments, and mainly as examples; there's no single
   exhaustive list with descriptions)
 . I find no documentation of how to describe alternatives -- several
   alternative file names produced from a single original file name
 . I wonder whether "recipes" like these are a convenient method of
   customizing this facility: do people really find it easy to write
   "ordered" property lists for this purpose?




Information forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 25 Sep 2022 11:21:17 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Sep 25 07:21:17 2022
Received: from localhost ([127.0.0.1]:45962 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ocPhC-0007zc-Ne
	for submit <at> debbugs.gnu.org; Sun, 25 Sep 2022 07:21:17 -0400
Received: from lists.gnu.org ([209.51.188.17]:37808)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <damien@HIDDEN>) id 1ocPh7-0007zR-TX
 for submit <at> debbugs.gnu.org; Sun, 25 Sep 2022 07:21:13 -0400
Received: from eggs.gnu.org ([2001:470:142:3::10]:52562)
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <damien@HIDDEN>) id 1ocPh7-0005w7-NG
 for bug-gnu-emacs@HIDDEN; Sun, 25 Sep 2022 07:21:09 -0400
Received: from mail.choca.pics ([80.67.172.235]:42756)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <damien@HIDDEN>) id 1ocPh2-0004pB-Ej
 for bug-gnu-emacs@HIDDEN; Sun, 25 Sep 2022 07:21:09 -0400
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id 777E2181942C4
 for <bug-gnu-emacs@HIDDEN>; Sun, 25 Sep 2022 13:20:41 +0200 (CEST)
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032)
 with ESMTP id QDnhMjspfSsl for <bug-gnu-emacs@HIDDEN>;
 Sun, 25 Sep 2022 13:20:37 +0200 (CEST)
Received: from localhost (localhost.localdomain [IPv6:::1])
 by mail.choca.pics (Postfix) with ESMTP id BF703181942C5
 for <bug-gnu-emacs@HIDDEN>; Sun, 25 Sep 2022 13:20:37 +0200 (CEST)
X-Virus-Scanned: amavisd-new at choca.pics
Received: from mail.choca.pics ([IPv6:::1])
 by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026)
 with ESMTP id w4tJ7APtMK2N for <bug-gnu-emacs@HIDDEN>;
 Sun, 25 Sep 2022 13:20:37 +0200 (CEST)
Received: from localhost (153.226.95.79.rev.sfr.net [79.95.226.153])
 by mail.choca.pics (Postfix) with ESMTPSA id 3C0F5181942C4
 for <bug-gnu-emacs@HIDDEN>; Sun, 25 Sep 2022 13:20:37 +0200 (CEST)
From: Damien Cassou <damien@HIDDEN>
To: bug-gnu-emacs@HIDDEN
Subject: 28.2; [PATCH] jumprel: A tool to find/create related files
Date: Sun, 25 Sep 2022 13:20:28 +0200
Message-ID: <878rm7wvib.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Received-SPF: pass client-ip=80.67.172.235; envelope-from=damien@HIDDEN;
 helo=mail.choca.pics
X-Spam_score_int: -18
X-Spam_score: -1.9
X-Spam_bar: -
X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.4 (-)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.4 (--)

--=-=-=
Content-Type: text/plain

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@HIDDEN> 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

--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
 filename=0001-.dir-locals.el-Configure-jumprel-jumpers.patch

From f3d6b1b4614d0bc4962404527e0960924d9722e5 Mon Sep 17 00:00:00 2001
From: Damien Cassou <damien@HIDDEN>
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


--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=jumprel.el

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

;; Copyright (C) 2022  Damien Cassou

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

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)


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

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


;;; 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.")


;;; 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.")

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

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

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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=jumprel-recipe.el

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)

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

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

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Disposition: attachment; filename=jumprel-regexp.el
Content-Transfer-Encoding: quoted-printable

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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@HIDDEN>.  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=E2=80=99re in src/emacs/emacs-27/lisp/abbrev.el,
;; and an src/emacs/emacs-28/lisp/abbrev.el file exists, it=E2=80=99s now
;; defined as a sibling.

;; Regexp-based jumpers as defined here do not support fillers.

;;; Code:

(require 'jumprel)
(require 'map)

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


;;; 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-ex=
pand-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 expansi=
on 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-nondirect=
ory 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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=jumprel-recipe-test.el

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)


;;; 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")))))

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

--=-=-=
Content-Type: text/plain
Content-Disposition: attachment; filename=jumprel-test.el

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

;; Copyright (C) 2022  Damien Cassou

;; Author: Damien Cassou <damien@HIDDEN>
;; 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)

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

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


;;; 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!)"))))

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

--=-=-=--




Acknowledgement sent to Damien Cassou <damien@HIDDEN>:
New bug report received and forwarded. Copy sent to bug-gnu-emacs@HIDDEN. Full text available.
Report forwarded to bug-gnu-emacs@HIDDEN:
bug#58071; Package emacs. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Thu, 13 Oct 2022 14:00:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.