* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
@ 2022-09-25 11:20 Damien Cassou
2022-09-26 7:42 ` Eli Zaretskii
` (2 more replies)
0 siblings, 3 replies; 13+ messages in thread
From: Damien Cassou @ 2022-09-25 11:20 UTC (permalink / raw)
To: 58071
[-- Attachment #1: Type: text/plain, Size: 1479 bytes --]
Please find attached jumprel, a tool to find/create related files. This
tool has been described (and compared with `find-file.el' and
`find-sibling-file') in emacs-devel's thread "Comparison of tools to
search for related files".
You will find a few files attached to this email:
- jumprel.el: The core of the library. This is where you will find an
introductory documentation.
- tests/jumprel-test.el: Corresponding tests.
- jumprel-recipe.el: Support for recipe-based jumpers. This makes it
easy to define powerful jumpers.
- tests/jumprel-recipe-test.el: Corresponding tests.
- jumprel-regexp.el: A proof-of-concept way to define regexp-based
jumpers. This files provides the same kind of support as
`find-sibling-file' and `find-file.el'. This file is heavily based on
previous work from Lars Ingebrigtsen <larsi@gnus.org> and others.
- 0001-.dir-locals.el-Configure-jumprel-jumpers.patch: A patch for
Emacs' .dir-locals.el making use of jumprel for .el and .c/.h files.
Because there are already 2 mechanisms to find related files in Emacs
(see above-mentioned thread), I think we should only consider
integrating jumprel into Emacs core if the other 2 are somewhat
deprecated (find-sibling-file hasn't been part of any release yet).
Even if you don't want to include this package in Emacs core, I would
really welcome feedback.
--
Damien Cassou
"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-.dir-locals.el-Configure-jumprel-jumpers.patch --]
[-- Type: text/x-patch, Size: 1299 bytes --]
From f3d6b1b4614d0bc4962404527e0960924d9722e5 Mon Sep 17 00:00:00 2001
From: Damien Cassou <damien@cassou.me>
Date: Sun, 25 Sep 2022 13:07:18 +0200
Subject: [PATCH] * .dir-locals.el: Configure jumprel-jumpers
---
.dir-locals.el | 2 ++
1 file changed, 2 insertions(+)
diff --git a/.dir-locals.el b/.dir-locals.el
index 84617a7980..cced69e9c2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,6 +9,7 @@
(bug-reference-url-format . "https://debbugs.gnu.org/%s")
(diff-add-log-use-relative-names . t)))
(c-mode . ((c-file-style . "GNU")
+ (jumprel-jumpers . ((recipe :remove-suffix ".c" :add-suffix ".h" :filler auto-insert)))
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
(electric-quote-string . nil)
@@ -26,6 +27,7 @@
(mode . bug-reference)))
(diff-mode . ((mode . whitespace)))
(emacs-lisp-mode . ((indent-tabs-mode . nil)
+ (jumprel-jumpers . ((recipe :remove-suffix ".el" :add-suffix "-tests.el" :add-directory "test" :filler auto-insert)))
(electric-quote-comment . nil)
(electric-quote-string . nil)
(mode . bug-reference-prog)))
--
2.36.2
[-- Attachment #3: jumprel.el --]
[-- Type: text/plain, Size: 17435 bytes --]
;;; jumprel.el --- Easily find files related to the current one -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; Author: Damien Cassou <damien@cassou.me>
;; Keywords: tools
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Thousands times a day you want to jump from a file to its test file
;; (or to its CSS file, or to its header file, or any other related
;; file) and just as many times you want to go back to the initial
;; file. JUMPing to RELated (jumprel) files is what this package is
;; about.
;; The question is: how does a user specify that a file is related to
;; a set of other files? One way is to create a function that takes a
;; file as argument and returns a list of related filenames:
;;
;; (defun my/jumprel-jumper (file)
;; (let ((without-ext (file-name-sans-extension file)))
;; (list
;; (concat without-ext ".js")
;; (concat without-ext ".css"))))
;;
;; (setq jumprel-jumpers (list #'my/jumprel-jumper))
;;
;; `my/jumprel-jumper' is called a 'jumper. With this setup,
;; `jumprel-jump' will let the user jump from Foo.js to Foo.css and
;; back.
;;
;; This is working good but has several limitations:
;;
;; 1. If Foo.css is not in the same directory as Foo.js or if you want
;; to include test files which end with "-tests.js",
;; `my/jumprel-jumper' has to be modified in a non-obvious way or a
;; complicated new jumper must be written and added to
;; `jumprel-jumpers';
;;
;; 2. The function `my/jumprel-jumper' has to be shared with all Emacs
;; users working on the same project
;; So jumprel recommends another approach that is less powerful but
;; much simpler. Here is another way to define the same jumper:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css")
;;
;; This list must replace `my/jumprel-jumper' in `jumprel-jumpers'.
;; This jumper lets the user go from Foo.js to Foo.css. jumprel will
;; automatically inverse the meaning of :remove-suffix and :add-suffix
;; arguments so the user can also go from Foo.css to Foo.js with this
;; jumper. See `jumprel-recipe.el' for more powerful examples.
;;
;; This kind of jumper can easily be shared with the members of a team
;; through a .dir-locals.el file. See (info "(Emacs) Directory Variables").
;;
;; jumprel also makes it easy to create a related file and fill it
;; with some content. If the content is always the same, a string can
;; be used to specify it:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler "Fill the CSS file")
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler "Fill the CSS file")
;;
;; This is rather limited though. Another solution is to use the
;; 'auto-insert filler:
;;
;; (recipe :remove-suffix ".el" :add-suffix "-test.el" :filler auto-insert)
;;
;; This will execute `auto-insert' in the new file. New kinds of
;; filler can easily be implemented by overriding `jumprel-fill'. For
;; example, if you are using the popular `yasnippet' package (not part
;; of Emacs), you can
;;
;; (cl-defmethod jumprel-fill ((filler (head yasnippet)) &allow-other-keys &rest)
;; (when-let* ((snippet (map-elt (cdr filler) :name)))
;; (yas-expand-snippet (yas-lookup-snippet snippet major-mode))))
;;
;; Which means the user can now specify a yasnippet snippet in their
;; `.dir-locals.el' file:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".spec.js" :filler (yasnippet :name "spec"))
;;
;; This will execute `yasnippet' in the new file with the "spec"
;; snippet.
;; If you want to add a new kind of jump, override `jumprel-apply' and
;; optionally `jumprel-get-filler', call `jumprel-add-jumper-type' and
;; add a function to `jumprel-jumper-safety-functions'.
;;
;; If you want to add a new kind of filler, override `jumprel-fill'
;; and call `jumprel-add-filler-type'.
;;; Code:
(require 'subr-x)
(require 'cl-lib)
\f
;;; Customization Options
(defgroup jumprel nil
"Facilitate navigation between the current file and related files."
:group 'tools)
(define-widget 'jumprel-jumper 'lazy
"A description of how two files relate to each other."
:tag "Jumper"
:type '(choice))
(define-widget 'jumprel-filler 'lazy
"A description of how to fill a new file."
:tag "Filler"
:type '(choice))
;;;###autoload
(defvar jumprel-jumper-safety-functions nil
"Functions checking if a given jumper is safe or not.
Each function should take a jumper as argument and should return
either nil, 'safe or 'unsafe. Nil must be returned if the
function doesn't know if the jumper is safe.
The first function returning non-nil will determine the safety of
the jumper and other functions won't be executed.")
;;;###autoload (put 'jumprel-jumpers 'safe-local-variable (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'jumprel-jumper-safety-functions jumper))) jumpers)))
(defcustom jumprel-jumpers nil
"List of jumpers to consider to go from the current file to related files.
A jumper is basically a function taking the current place as
argument (a filename) and returning a list of (existing and
non-existing) places the user might want to go to from the
current place.
There are different ways to specify a jumper. Look at the
`customize' interface of this variable for more information."
:type '(repeat jumprel-jumper)
:safe (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'jumprel-jumper-safety-functions jumper))) jumpers)))
\f
;;; Public Functions
;;;###autoload
(defun jumprel-jump (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Only existing files are presented to the user. Look at
`jumprel-make' and `jumprel-jump-or-make' if you also want to be
able to create new files.
If JUMPERS is not provided, use `jumprel-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `jumprel-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt jumprel-jumpers current-prefix-arg)))))
(jumprel--jump-or-make jumpers current-place :include-existing-places t))
;;;###autoload
(defun jumprel-make (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Only non-existing files are presented to the user so the user can
easily create them. This is useful to create a test file for the
current file for example. Look at `jumprel-jump' and
`jumprel-jump-or-make' if you also want to be able to jump to
existing files.
If JUMPERS is not provided, use `jumprel-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `jumprel-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt jumprel-jumpers current-prefix-arg)))))
(jumprel--jump-or-make jumpers current-place :include-non-existing-places t))
;;;###autoload
(defun jumprel-jump-or-make (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Both existing and non-existing files are presented to the user so
the user can easily jump to existing files or create missing
ones. Look at `jumprel-jump' and `jumprel-make' if you don't
want to mix existing and non-existing files in the same list..
If JUMPERS is not provided, use `jumprel-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `jumprel-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt jumprel-jumpers current-prefix-arg)))))
(jumprel--jump-or-make jumpers current-place
:include-existing-places t
:include-non-existing-places t))
\f
;;; Jumpers Public API
(cl-defgeneric jumprel-apply (jumper place)
"Apply JUMPER to PLACE and return related places or nil.
PLACE is a filename and the result must be a possibly-empty list
of filenames."
(funcall jumper place))
(cl-defgeneric jumprel-get-filler (jumper)
"Return a filler associated with JUMPER.
There is no filler associated to a function-based jumper but
other kinds of jumpers may be able to specify a filler.")
\f
;;; Filler Public API
(cl-defgeneric jumprel-fill (filler &allow-other-keys &rest)
"Use FILLER to fill the current buffer with some content.
The current buffer is empty when this function is called.
Beyond the filler, this function is called with the :jumper and
:place keyword arguments.")
\f
;;; Functions Manipulating Places
(defun jumprel--choose-place (places initial-place)
"Let the user pick one of PLACES and return it.
PLACES is a list of filenames and INITIAL-PLACE is a filename.
INITIAL-PLACE is the place that was current when the user started
jumprel. It is used to format each place in PLACES."
(cond
((length= places 0) (user-error "No place to go to. Consider configuring `jumprel-jumpers' or using `jumprel-make'") nil)
((length= places 1) (car places))
(t (let ((initial-directory (file-name-directory initial-place)))
(jumprel--completing-read "Place: " places (apply-partially #'jumprel--format-place initial-directory))))))
(defun jumprel--act-on-place (place)
"Either open or create PLACE, a filename."
(if (file-exists-p place)
(find-file place)
(jumprel--make-place place)))
(defun jumprel--format-place (initial-directory place)
"Return a string representing PLACE.
INITIAL-DIRECTORY is used to format PLACE relatively.
If PLACE doesn't exist, append \"(create it!)\" to the return
value."
(when-let* ((relative-name (file-relative-name place initial-directory)))
(if (file-exists-p place)
relative-name
(format "%s (create it!)" relative-name))))
(defun jumprel--make-place (place)
"Create the file at PLACE.
If a jumper is attached to PLACE and if this jumper has a filler,
use the filler to populate the new file with initial content."
(find-file place)
(when-let* ((jumper (get-text-property 0 :jumprel-jumper place))
(filler (jumprel-get-filler jumper)))
(jumprel-fill filler :jumper jumper :place place)))
\f
;;; Fillers
(cl-defmethod jumprel-fill ((filler string) &allow-other-keys &rest)
"Fill the current buffer with FILLER, a string."
(insert filler))
(cl-defmethod jumprel-fill ((_filler (eql auto-insert)) &allow-other-keys &rest)
"Fill the current buffer by calling `auto-insert'."
(auto-insert))
\f
;;; Utility Functions
(cl-defun jumprel--jump-or-make (jumpers current-place &key include-existing-places include-non-existing-places)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Existing files are presented to the user if
INCLUDE-EXISTING-PLACES is non-nil. Non-existing files are
presented to the user if INCLUDE-NON-EXISTING-PLACES is non-nil.
If JUMPERS is not provided, use `jumprel-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'."
(let* ((jumpers (or jumpers jumprel-jumpers))
(current-place (or current-place (buffer-file-name))))
(cond ((not jumpers)
(user-error "No jumpers. Consider configuring `jumprel-jumpers'"))
((not current-place)
(user-error "Jumprel only works from file-based buffers"))
(t
(let ((existing-places (when include-existing-places
(jumprel--collect-existing-places jumpers current-place)))
(non-existing-places (when include-non-existing-places
(jumprel--collect-non-existing-places jumpers current-place))))
(when-let* ((place (jumprel--choose-place (append existing-places non-existing-places) current-place)))
(jumprel--act-on-place place)))))))
(defun jumprel--collect-existing-places (jumpers current-place)
"Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.
Each jumper in JUMPERS is not only called with CURRENT-PLACE as
argument but also with all places generated by other jumpers,
recursively. Only existing places are considered and returned.
The returned value doesn't contain CURRENT-PLACE."
(when current-place
(let* ((places nil)
(places-queue (list current-place)))
(while places-queue
(when-let* ((place (pop places-queue))
((file-exists-p place))
((not (seq-contains-p places place))))
(unless (equal place current-place) (push place places))
(let ((new-places (jumprel--call-jumpers jumpers place)))
(setq places-queue (nconc places-queue new-places)))))
places)))
(defun jumprel--collect-non-existing-places (jumpers current-place)
"Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.
Only non-existing places are considered and returned. The
returned value doesn't contain CURRENT-PLACE."
(cl-delete-if
(lambda (place) (or (equal place current-place)
(file-exists-p place)))
(jumprel--call-jumpers jumpers current-place)))
(defun jumprel--call-jumpers (jumpers place)
"Return a list of places that can be accessed from PLACE with JUMPERS."
(mapcan (apply-partially #'jumprel--call-jumper place) jumpers))
(defun jumprel--call-jumper (place jumper)
"Return a list of places that can be accessed from PLACE with JUMPER."
(when-let* ((place-or-places (jumprel-apply jumper place))
(places (if (proper-list-p place-or-places)
place-or-places
(list place-or-places))))
(jumprel--attach-jumper-to-places jumper places)))
(defun jumprel--attach-jumper-to-places (jumper places)
"Return PLACES with JUMPER attached to each.
Each item of the return value remembers it was created with
JUMPER."
(mapcar
(lambda (place) (propertize place :jumprel-jumper jumper))
places))
(defun jumprel--completing-read (prompt entities formatter)
"Display PROMPT and let the user choose one of ENTITIES in the minibuffer.
Format each entity with FORMATTER before presenting it to the
user."
(let* ((entity-string-to-entity (make-hash-table :test 'equal :size (length entities)))
(entity-strings (mapcar formatter entities)))
(cl-loop
for entity in entities
for entity-string in entity-strings
do (puthash entity-string entity entity-string-to-entity))
(when-let* ((entity-string (completing-read prompt entity-strings nil t)))
(gethash entity-string entity-string-to-entity))))
(defun jumprel-add-jumper-type (customization-type)
"Add CUSTOMIZATION-TYPE choice to `jumprel-jumper' widget.
This function should be called when creating a new kind of jumper
to add an alternative customization type to the `customize'
interface of `jumprel-jumpers'.
CUSTOMIZATION-TYPE describes what the new kind of jumper should
look like and should contain the same kind of data as the :type
argument of `defcustom'. See Info node `(elisp) Customization
Types' for more information."
(jumprel--add-choice-to-type 'jumprel-jumper customization-type))
(defun jumprel-add-filler-type (customization-type)
"Add CUSTOMIZATION-TYPE choice to `jumprel-filler' widget.
This function should be called when creating a new kind of filler
to add an alternative customization type to the `customize'
interface of `jumprel-jumpers'.
CUSTOMIZATION-TYPE describes what the new kind of filler should
look like and should contain the same kind of data as the :type
argument of `defcustom'. See Info node `(elisp) Customization
Types' for more information."
(jumprel--add-choice-to-type 'jumprel-filler customization-type))
(defun jumprel--add-choice-to-type (widget-symbol customization-type)
"Add CUSTOMIZATION-TYPE to the choice type of WIDGET-SYMBOL.
CUSTOMIZATION-TYPE is only added if absent from the type
alternatives."
(when-let* ((widget (get widget-symbol 'widget-type))
(choice (widget-get widget :type))
((not (seq-contains-p (cdr choice) customization-type))))
(widget-put widget :type `(,@choice ,customization-type))))
(jumprel-add-jumper-type 'function)
(jumprel-add-filler-type '(string :tag "Fill with pre-defined content"))
(jumprel-add-filler-type '(const :tag "Use `auto-insert'" auto-insert))
(provide 'jumprel)
;;; jumprel.el ends here
;; LocalWords: minibuffer jumprel
[-- Attachment #4: jumprel-recipe.el --]
[-- Type: text/plain, Size: 10442 bytes --]
;;; jumprel-recipe.el --- Provide a recipe DSL to define jumprel jumpers -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The code below defines a file-creation recipe DSL to create jumprel
;; jumpers. Such a jumper should be defined as a list starting with the
;; symbol 'recipe. Here are some examples:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css")
;;
;; The jumper above will let the user jump from MyComponent.js to
;; MyComponent.css in the same directory and back from the CSS to the
;; JS file. Sometimes, a related file is in a parallel folder
;; hierarchy. This can be specified by using the :add-directory
;; keyword:
;;
;; (recipe :remove-suffix ".el" :add-suffix "-tests.el" :add-directory "test")
;;
;; This is the typical elisp code base example where test files end
;; with "-tests.el" and are located in a "test/" directory. With such
;; a jumper, the user can jump from
;; /project/src/lisp/calendar/parse-time.el to
;; /project/src/test/lisp/calendar/parse-time-tests.el and back.
;;
;; Sometimes, capitalization between a file and its related file isn't
;; similar. In this case, the :case-transformer keyword can be used:
;;
;; (recipe :remove-suffix ".js" :add-suffix "-tests.js" :case-transformer uncapitalize)
;;
;; This makes it possible for a user to jump from /project/src/Foo.js
;; to /project/src/foo-tests.js and back.
;;
;; A filler (see jumprel's main documentation) can be specified with
;; the :filler keyword:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler auto-insert)
;;
;; This will call `auto-insert' on newly created files. See jumprel's
;; main documentation for the syntax of other kinds of fillers.
;;; Code:
(require 'subr-x)
(require 'map)
(require 'jumprel)
\f
;;; Overrides of Public Methods
(cl-defmethod jumprel-apply ((jumper (head recipe)) place)
"Return a list of new places built by applying recipe JUMPER to PLACE."
(append
(apply #'jumprel-recipe--apply-filename-jumper place (cdr jumper))
(apply #'jumprel-recipe--unapply-filename-jumper place (cdr jumper))))
(cl-defmethod jumprel-get-filler ((jumper (head recipe)))
"Return the filler of recipe JUMPER."
(map-elt (cdr jumper) :filler))
\f
;;; Utility Functions
(cl-defun jumprel-recipe--apply-filename-jumper
(place &key (remove-suffix "") (add-suffix "") case-transformer add-directory
&allow-other-keys)
"Return places built after applying some modifications to PLACE.
Modifications are applied in the order below.
REMOVE-SUFFIX is a string (e.g., \".el\") that PLACE should
end with and that is going to be removed from it.
ADD-SUFFIX is a string (e.g., \"-tests.el\") that will be
added at the end.
CASE-TRANSFORMER is one of the kind of tranformers defined by
`jumprel-recipe--apply-case-transformer' and is used to change
the case of the filename.
ADD-DIRECTORY is a string (e.g., \"test\") that is added next to
directory names in PLACE."
(when-let* (((jumprel-recipe--suffix-can-be-changed-p place add-suffix remove-suffix))
(path-without-suffix (substring place 0 (- (length remove-suffix))))
(path-with-suffix (concat path-without-suffix add-suffix))
(path-with-changed-case (jumprel-recipe--apply-to-filename
path-with-suffix
(apply-partially #'jumprel-recipe--apply-case-transformer case-transformer))))
(if add-directory
(jumprel-recipe--add-directory-to-path path-with-changed-case add-directory)
(list path-with-changed-case))))
(cl-defun jumprel-recipe--unapply-filename-jumper (place &key (add-suffix "") (remove-suffix "") case-transformer add-directory &allow-other-keys)
"Return places built after un-applying some modifications to PLACE.
The meaning of ADD-SUFFIX, REMOVE-SUFFIX, CASE-TRANSFORMER and
ADD-DIRECTORY is the opposite of the one of
`jumprel-recipe--apply-filename-jumper'. For example, ADD-SUFFIX
should already be present in PLACE and will be removed from it."
(when-let* (((jumprel-recipe--suffix-can-be-changed-p place remove-suffix add-suffix))
(path-without-suffix (substring place 0 (- (length add-suffix))))
(path-with-suffix (concat path-without-suffix remove-suffix))
(path-with-changed-case (jumprel-recipe--apply-to-filename
path-with-suffix
(apply-partially #'jumprel-recipe--unapply-case-transformer case-transformer))))
(if add-directory
(jumprel-recipe--remove-directory-from-path path-with-changed-case add-directory)
(list path-with-changed-case))))
(defun jumprel-recipe--add-directory-to-path (file add-directory)
"Return the paths to files looking like FILE but with ADD-DIRECTORY inside it.
The file-system is searched for existing directories but the
returned paths don't have to exist."
(cl-labels
((parent-directory (directory) (file-name-directory (directory-file-name directory)))
(root-p (directory) (string= directory (parent-directory directory))))
(cl-loop
for current-directory = (file-name-directory file) then (parent-directory current-directory)
for candidate = (expand-file-name
(substring file (length (expand-file-name current-directory)))
(expand-file-name add-directory current-directory))
if (file-exists-p (file-name-directory candidate)) collect candidate into result
if (root-p current-directory) return result)))
(defun jumprel-recipe--remove-directory-from-path (file remove-directory)
"Return the paths to files looking like FILE but with REMOVE-DIRECTORY removed.
The file-system is searched for existing directories but the
returned paths don't have to exist."
(when-let* ((path-segments (split-string file "/"))
(positions (jumprel-recipe--seq-positions path-segments remove-directory)))
(cl-loop
for position in positions
for candidate = (string-join (jumprel-recipe--seq-remove-at-position path-segments position) "/")
if (file-exists-p (file-name-directory candidate)) collect candidate)))
(defun jumprel-recipe--apply-to-filename (path fn)
"Apply FN to the filename part of PATH."
(let* ((filename (file-name-nondirectory path))
(directory (file-name-directory path)))
(expand-file-name (funcall fn filename) directory)))
(defun jumprel-recipe--apply-case-transformer (transformer string)
"Return the result of applying TRANFORMER to STRING.
TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
(cl-case transformer
(capitalize (concat (upcase (substring string 0 1)) (substring string 1)))
(uncapitalize (concat (downcase (substring string 0 1)) (substring string 1)))
(t (if transformer
(user-error "Unknown transformer %s" transformer)
string))))
(defun jumprel-recipe--unapply-case-transformer (transformer string)
"Return the result of un-applying TRANFORMER to STRING.
TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
(let ((untransformer (cl-case transformer
(capitalize 'uncapitalize)
(uncapitalize 'capitalize)
(t transformer))))
(jumprel-recipe--apply-case-transformer untransformer string)))
(defun jumprel-recipe--suffix-can-be-changed-p (path add-suffix remove-suffix)
"Return nil if REMOVE-SUFFIX cannot be replaced with ADD-SUFFIX in PATH.
The function also returns nil if ADD-SUFFIX is already present in
PATH. This avoids adding the same suffix again. For example,
the function returns nil if -tests.el is added to
/project/foo-tests.el to avoid getting
/project/foo-tests-tests.el as candidate."
(and
(string-suffix-p remove-suffix path)
(or (not (string-suffix-p add-suffix path))
(string-suffix-p add-suffix remove-suffix))))
;; NOTE: This is in Emacs 29 already under the name `seq-positions'
(defun jumprel-recipe--seq-positions (seq elt &optional testfn)
"Return the positions of ELT in SEQ.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(cl-loop for i from 0 below (length seq)
if (funcall (or testfn #'equal) (nth i seq) elt) collect i))
;; NOTE: This is in Emacs 29 already under the name `seq-remove-at-position'
(defun jumprel-recipe--seq-remove-at-position (seq position)
"Return a copy of SEQ where the element at POSITION got removed."
(append
(cl-subseq seq 0 position)
(cl-subseq seq (1+ position))))
(jumprel-add-jumper-type
'(cons
:tag "Recipe"
(const :tag "" recipe)
(set
:tag "Transformations"
(list :inline t
:tag "Remove suffix"
(const :remove-suffix)
string)
(list :inline t
:tag "Add suffix"
(const :add-suffix)
string)
(list :inline t
:tag "Case transformer"
(const :case-transformer)
(choice
:value capitalize
(const :tag "Capitalize" capitalize)
(const :tag "Uncapitalize" uncapitalize)))
(list :inline t
:tag "Add directory"
(const :add-directory)
string)
(list :inline t
:tag "Filler"
(const :filler)
jumprel-filler))))
;;;###autoload
(add-hook 'jumprel-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'recipe) 'safe)))
(provide 'jumprel-recipe)
;;; jumprel-recipe.el ends here
;; LocalWords: tranformers el
[-- Attachment #5: jumprel-regexp.el --]
[-- Type: text/plain, Size: 7977 bytes --]
;;; jumprel-recipe.el --- Provide a recipe DSL to define jumprel jumpers -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; NOTE The code and documentation below is heavily copy/pasted from
;; `find-sibling-rules' and `find-sibling-file' by Lars Ingebrigtsen
;; <larsi@gnus.org>. TODO: This NOTE should probably be deleted if we
;; decide to replace `find-sibling-file' with jumprel.
;; The code below makes it possible to create jumprel jumpers from
;; regular expressions. Such a jumper should be defined as a list
;; starting with the symbol 'regexp followed by two strings MATCH and
;; EXPANSION. MATCH is a regular expression that should match a file
;; name that has a sibling. It can contain sub-expressions that will
;; be used in EXPANSION.
;; EXPANSION is a string that matches file names. For instance, to
;; define ".h" files as siblings of any ".c", you could say:
;;
;; (regexp "\\([^/]+\\)\\.c\\'" "\\1.h")
;; MATCH and EXPANSION can also be fuller paths. For instance, if
;; you want to define other versions of a project as being sibling
;; files, you could say something like:
;;
;; (regexp "src/emacs/[^/]+/\\(.*\\)\\'" "src/emacs/.*/\\1\\'")
;; In this example, if you’re in src/emacs/emacs-27/lisp/abbrev.el,
;; and an src/emacs/emacs-28/lisp/abbrev.el file exists, it’s now
;; defined as a sibling.
;; Regexp-based jumpers as defined here do not support fillers.
;;; Code:
(require 'jumprel)
(require 'map)
\f
;;; Overrides of Public Methods
(cl-defmethod jumprel-apply ((jumper (head regexp)) place)
"Return a list of new places built by applying regexp JUMPER to PLACE."
(jumprel-recipe--find-sibling-file-search
place
(list (list (nth 1 jumper) (nth 2 jumper)))))
(cl-defmethod jumprel-get-filler ((_jumper (head regexp)))
"Return nil as no filler can be associated with regexp-based jumpers."
nil)
\f
;;; Emacs 29 functions adapted
(defun jumprel-recipe--find-sibling-file-search (file rules)
;; Same as `find-sibling-file-search' in Emacs 29 except that
;;
;; - `rules' is a mandatory parameter;
;;
;; - it calls `jumprel-recipe--file-expand-wildcards' instead of `file-expand-wildcards'.
"Return a list of FILE's \"siblings\"
RULES should be a list on the form defined by `find-sibling-rules' (which
see), and if nil, defaults to `find-sibling-rules'."
(let ((results nil))
(pcase-dolist (`(,match . ,expansions) rules)
;; Go through the list and find matches.
(when (string-match match file)
(let ((match-data (match-data)))
(dolist (expansion expansions)
(let ((start 0))
;; Expand \\1 forms in the expansions.
(while (string-match "\\\\\\([&0-9]+\\)" expansion start)
(let ((index (string-to-number (match-string 1 expansion))))
(setq start (match-end 0)
expansion
(replace-match
(substring file
(elt match-data (* index 2))
(elt match-data (1+ (* index 2))))
t t expansion)))))
;; Then see which files we have that are matching. (And
;; expand from the end of the file's match, since we might
;; be doing a relative match.)
(let ((default-directory (substring file 0 (car match-data))))
;; Keep the first matches first.
(setq results
(nconc
results
(mapcar #'expand-file-name
(jumprel-recipe--file-expand-wildcards expansion nil t)))))))))
;; Delete the file itself (in case it matched), and remove
;; duplicates, in case we have several expansions and some match
;; the same subsets of files.
(delete file (delete-dups results))))
(defun jumprel-recipe--file-expand-wildcards (pattern &optional full regexp)
;; Same as `file-expand-wildcards' in Emacs 29
"Expand (a.k.a. \"glob\") file-name wildcard pattern PATTERN.
This returns a list of file names that match PATTERN.
The returned list of file names is sorted in the `string<' order.
PATTERN is, by default, a \"glob\"/wildcard string, e.g.,
\"/tmp/*.png\" or \"/*/*/foo.png\", but can also be a regular
expression if the optional REGEXP parameter is non-nil. In any
case, the matches are applied per sub-directory, so a match can't
span a parent/sub directory, which means that a regexp bit can't
contain the \"/\" character.
The returned list of file names is sorted in the `string<' order.
If PATTERN is written as an absolute file name, the expansions in
the returned list are also absolute.
If PATTERN is written as a relative file name, it is interpreted
relative to the current `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
(save-match-data
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
;; A list of all dirs that DIRPART specifies.
;; This can be more than one dir
;; if DIRPART contains wildcards.
(dirs (if (and dirpart
(string-match "[[*?]" (file-local-name dirpart)))
(mapcar 'file-name-as-directory
(jumprel-recipe--file-expand-wildcards
(directory-file-name dirpart) nil regexp))
(list dirpart)))
contents)
(dolist (dir dirs)
(when (or (null dir) ; Possible if DIRPART is not wild.
(file-accessible-directory-p dir))
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
(mapcar (lambda (name)
(unless (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory name))
name))
(directory-files
(or dir ".") full
(if regexp
;; We're matching each file name
;; element separately.
(concat "\\`" nondir "\\'")
(wildcard-to-regexp nondir)))))))
(setq contents
(nconc
(if (and dir (not full))
(mapcar (lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
contents)))))
contents)))
(jumprel-add-jumper-type
'(list
:tag "Regexp"
(const :tag "" regexp)
(regexp :tag "match")
(regexp :tag "expansion")
(set
:tag ""
(list :inline t
:tag "Filler"
(const :filler)
jumprel-filler))))
;;;###autoload
(add-hook 'jumprel-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'regexp) 'safe)))
(provide 'jumprel-regexp)
;;; jumprel-regexp.el ends here
;; LocalWords: tranformers el
[-- Attachment #6: jumprel-recipe-test.el --]
[-- Type: text/plain, Size: 6722 bytes --]
;;; jumprel-recipe-test.el --- Tests for jumprel-recipe -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for jumprel-recipe.el.
;;; Code:
(require 'jumprel-recipe)
\f
;;; Customization Options
(ert-deftest jumprel-recipe-test-jumpers-safe-values ()
(should (safe-local-variable-p 'jumprel-jumpers '((recipe :remove-suffix ".el" add-suffix "-tests.el")))))
\f
;;; Utility Functions
(ert-deftest jumprel-recipe-test-apply-filename-jumper ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let* ((place "/emacs-src/lisp/Abbrev.el")
(places (jumprel-recipe--apply-filename-jumper
place
:remove-suffix ".el"
:add-suffix "-tests.el"
:case-transformer 'uncapitalize
:add-directory "test"
:filler 'foo)))
(should (seq-set-equal-p
places
'("/test/emacs-src/lisp/abbrev-tests.el"
"/emacs-src/test/lisp/abbrev-tests.el"
"/emacs-src/lisp/test/abbrev-tests.el"))))))
(ert-deftest jumprel-recipe-test-unapply-filename-jumper ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let* ((place "/emacs-src/test/lisp/abbrev-tests.el")
(places (jumprel-recipe--unapply-filename-jumper
place
:remove-suffix ".el"
:add-suffix "-tests.el"
:case-transformer 'uncapitalize
:add-directory "test"
:filler 'foo)))
(should (seq-set-equal-p places '("/emacs-src/lisp/Abbrev.el"))))))
(ert-deftest jumprel-recipe-test-add-directory-to-path ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let ((result (jumprel-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
(should (seq-set-equal-p
result
'("/test/emacs-src/lisp/abbrev.el"
"/emacs-src/test/lisp/abbrev.el"
"/emacs-src/lisp/test/abbrev.el"))))))
(ert-deftest jumprel-recipe-test-add-directory-to-path-filter-non-existing-directories ()
"To reduce the number of candidates, the directories must already exist."
(let ((existing-directory "/emacs-src/test/lisp/"))
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'string= existing-directory)))
(let ((result (jumprel-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
(should (equal
result
(list (concat existing-directory "abbrev.el"))))))))
(ert-deftest jumprel-recipe-test-remove-directory-from-path ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let ((result (jumprel-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
(should (seq-set-equal-p
result
'("/emacs-src/test/lisp/test/abbrev-tests.el"
"/test/emacs-src/lisp/test/abbrev-tests.el"
"/test/emacs-src/test/lisp/abbrev-tests.el"))))))
(ert-deftest jumprel-recipe-test-remove-directory-from-path-filter-non-existing-directories ()
"To reduce the number of candidates, the directories must already exist."
(let ((existing-directory "/test/emacs-src/lisp/test/"))
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'string= existing-directory)))
(let ((result (jumprel-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
(should (equal
result
(list (concat existing-directory "abbrev-tests.el"))))))))
(ert-deftest jumprel-recipe-test-apply-to-filename ()
(should (equal (jumprel-recipe--apply-to-filename "/foo/bar" #'upcase) "/foo/BAR"))
(should (equal (jumprel-recipe--apply-to-filename "/foo/bar/BAZ.EL" #'downcase) "/foo/bar/baz.el")))
(ert-deftest jumprel-recipe-test-apply-case-transformer ()
(should (equal (jumprel-recipe--apply-case-transformer 'capitalize "foo") "Foo"))
(should (equal (jumprel-recipe--apply-case-transformer 'uncapitalize "Foo") "foo"))
(should (equal (jumprel-recipe--apply-case-transformer nil "foo") "foo"))
(should-error (jumprel-recipe--apply-case-transformer 'unknown "foo")))
(ert-deftest jumprel-recipe-test-unapply-case-transformer ()
(should (equal (jumprel-recipe--unapply-case-transformer 'capitalize "Foo") "foo"))
(should (equal (jumprel-recipe--unapply-case-transformer 'uncapitalize "foo") "Foo"))
(should (equal (jumprel-recipe--unapply-case-transformer nil "foo") "foo"))
(should-error (jumprel-recipe--unapply-case-transformer 'unknown "foo")))
(ert-deftest jumprel-recipe-test-suffix-can-be-changed-p ()
(should-not (jumprel-recipe--suffix-can-be-changed-p "/a/b.el" ".el" "-tests.el"))
(should-not (jumprel-recipe--suffix-can-be-changed-p "/a/b-tests.el" "-tests.el" ".el"))
(should (jumprel-recipe--suffix-can-be-changed-p "/a/b-tests.el" ".el" "-tests.el"))
(should (jumprel-recipe--suffix-can-be-changed-p "/a/b.el" "-tests.el" ".el"))
(should (jumprel-recipe--suffix-can-be-changed-p "/a/b.less" ".js" ".less")))
(ert-deftest jumprel-recipe-test-seq-positions ()
(should (equal '(0 3) (jumprel-recipe--seq-positions '("a" "b" "c" "a" "d") "a")))
(should (equal '() (jumprel-recipe--seq-positions '("a" "b" "c" "a" "d") "Z"))))
(ert-deftest jumprel-recipe-test-seq-remove-at-position ()
(let ((letters '(a b c d)))
(should (equal '(a b d) (jumprel-recipe--seq-remove-at-position letters 2)))
(should (equal '(b c d) (jumprel-recipe--seq-remove-at-position letters 0)))
(should (equal '(a b c) (jumprel-recipe--seq-remove-at-position letters 3)))))
(provide 'jumprel-recipe-test)
;;; jumprel-recipe-test.el ends here
[-- Attachment #7: jumprel-test.el --]
[-- Type: text/plain, Size: 5012 bytes --]
;;; jumprel-test.el --- Tests for jumprel -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for jumprel.el.
;;; Code:
(require 'jumprel)
(require 'ert)
(require 'cl-lib)
(require 'seq)
\f
;;; Customization Options
(ert-deftest jumprel-test-jumpers-safe-values ()
(should (safe-local-variable-p 'jumprel-jumpers nil))
(should-not (safe-local-variable-p 'jumprel-jumpers (list (lambda (place) place)))))
\f
;;; Jumpers Public API
(ert-deftest jumprel-test-apply-function-jumper ()
(let* ((place 'place)
(jumperIdentity #'identity)
(jumperConst (lambda (_) place)))
(should (equal (jumprel-apply jumperIdentity "/foo/bar") "/foo/bar"))
(should (equal (jumprel-apply jumperConst "/foo/bar") place))))
\f
;;; Functions Manipulating Places
(ert-deftest jumprel-test-format-place ()
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'equal "/project/foo/exists.el")))
(should (equal (jumprel--format-place "/project/foo/" "/project/foo/exists.el") "exists.el"))
(should (equal (jumprel--format-place "/project/bar/" "/project/foo/exists.el") "../foo/exists.el"))
(should (equal (jumprel--format-place "/project/foo/" "/project/foo/non-existing.el") "non-existing.el (create it!)"))))
\f
;;; Utility Functions
(ert-deftest jumprel-test-collect-existing-places-does-not-return-current-place ()
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'seq-contains-p '("/bar" "/foo"))))
(let* ((current-place "/bar")
(new-place "/foo")
(jumper1 (lambda (_) new-place)))
(should (equal
(jumprel--collect-existing-places (list jumper1) current-place)
(list new-place))))))
(ert-deftest jumprel-test-collect-existing-places-returns-uniq-results ()
"If 2 jumpers produce the same place, the place should only appear once."
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'seq-contains-p '("/bar" "/foo"))))
(let* ((current-place "/bar")
(new-place "/foo")
(jumper1 (lambda (_) new-place))
(jumper2 (lambda (_) new-place)))
(should (seq-set-equal-p
(jumprel--collect-existing-places (list jumper1 jumper2) current-place)
(list new-place))))))
(ert-deftest jumprel-test-collect-existing-places-returns-no-place-when-no-current-place ()
"If there is no current place, there shouldn't be any destination place."
(should-not (jumprel--collect-existing-places '(jumper) nil)))
(ert-deftest jumprel-test-call-jumpers ()
(let* ((jumperAtom (lambda (_) "/foo"))
(jumperList (lambda (_) (list "/bar1" "/bar2")))
(jumperSingleton (lambda (_) (list "/baz")))
(jumperNil (lambda (_)))
(jumperIdentity #'identity))
(should (seq-set-equal-p (jumprel--call-jumpers
(list jumperAtom jumperList)
"/")
'("/foo" "/bar1" "/bar2")))
(should (seq-set-equal-p (jumprel--call-jumpers
(list jumperAtom jumperSingleton)
"/")
'("/foo" "/baz")))
(should (seq-set-equal-p (jumprel--call-jumpers
(list jumperAtom jumperNil)
"/")
'("/foo")))
(should (seq-set-equal-p (jumprel--call-jumpers
(list jumperAtom jumperIdentity)
'"/")
'("/foo" "/")))
(should (seq-set-equal-p (jumprel--call-jumpers
(list jumperAtom jumperList jumperSingleton jumperNil jumperIdentity)
'"/")
'("/foo" "/bar1" "/bar2" "/baz" "/")))))
(ert-deftest jumprel-test-test--call-jumpers-attach-jumper-to-all-places ()
(let* ((jumper (lambda (_) "/foo"))
(place (car (jumprel--call-jumpers (list jumper) "/"))))
(should (eq (get-text-property 0 :jumprel-jumper place) jumper))))
(provide 'jumprel-test)
;;; jumprel-test.el ends here
^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-25 11:20 bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files Damien Cassou
@ 2022-09-26 7:42 ` Eli Zaretskii
2022-09-28 19:26 ` Damien Cassou
2022-10-06 6:09 ` Damien Cassou
2022-09-26 11:05 ` Lars Ingebrigtsen
2022-10-28 22:08 ` hugo
2 siblings, 2 replies; 13+ messages in thread
From: Eli Zaretskii @ 2022-09-26 7:42 UTC (permalink / raw)
To: Damien Cassou; +Cc: 58071
> From: Damien Cassou <damien@cassou.me>
> 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?
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-25 11:20 bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files Damien Cassou
2022-09-26 7:42 ` Eli Zaretskii
@ 2022-09-26 11:05 ` Lars Ingebrigtsen
2022-09-26 13:37 ` Stefan Kangas
2022-10-28 22:08 ` hugo
2 siblings, 1 reply; 13+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-26 11:05 UTC (permalink / raw)
To: Damien Cassou; +Cc: 58071
Damien Cassou <damien@cassou.me> 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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-26 11:05 ` Lars Ingebrigtsen
@ 2022-09-26 13:37 ` Stefan Kangas
2022-09-27 11:34 ` Lars Ingebrigtsen
0 siblings, 1 reply; 13+ messages in thread
From: Stefan Kangas @ 2022-09-26 13:37 UTC (permalink / raw)
To: Lars Ingebrigtsen, Damien Cassou; +Cc: 58071
Lars Ingebrigtsen <larsi@gnus.org> 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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-26 13:37 ` Stefan Kangas
@ 2022-09-27 11:34 ` Lars Ingebrigtsen
0 siblings, 0 replies; 13+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-27 11:34 UTC (permalink / raw)
To: Stefan Kangas; +Cc: Damien Cassou, 58071
Stefan Kangas <stefankangas@gmail.com> 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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-26 7:42 ` Eli Zaretskii
@ 2022-09-28 19:26 ` Damien Cassou
2022-09-29 8:54 ` Eli Zaretskii
2022-09-29 10:46 ` Lars Ingebrigtsen
2022-10-06 6:09 ` Damien Cassou
1 sibling, 2 replies; 13+ messages in thread
From: Damien Cassou @ 2022-09-28 19:26 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 58071
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@gnu.org> 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 (yasnippet :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@gnus.org> 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 😊).
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
--
Damien Cassou
"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-28 19:26 ` Damien Cassou
@ 2022-09-29 8:54 ` Eli Zaretskii
2022-09-30 8:43 ` Damien Cassou
2022-09-29 10:46 ` Lars Ingebrigtsen
1 sibling, 1 reply; 13+ messages in thread
From: Eli Zaretskii @ 2022-09-29 8:54 UTC (permalink / raw)
To: Damien Cassou; +Cc: 58071
> From: Damien Cassou <damien@cassou.me>
> Cc: 58071@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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-28 19:26 ` Damien Cassou
2022-09-29 8:54 ` Eli Zaretskii
@ 2022-09-29 10:46 ` Lars Ingebrigtsen
2022-09-30 8:44 ` Damien Cassou
1 sibling, 1 reply; 13+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-29 10:46 UTC (permalink / raw)
To: Damien Cassou; +Cc: Eli Zaretskii, 58071
Damien Cassou <damien@cassou.me> 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 😊).
>
> 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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-29 8:54 ` Eli Zaretskii
@ 2022-09-30 8:43 ` Damien Cassou
2022-09-30 10:38 ` Eli Zaretskii
0 siblings, 1 reply; 13+ messages in thread
From: Damien Cassou @ 2022-09-30 8:43 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 58071
>> Eli Zaretskii <eliz@gnu.org> writes:
>>> what you call "recipes", […] should be documented in a single doc
>>> string, and the other places that use recipes should reference the
>>> symbol whose doc string documents them
> From: Damien Cassou <damien@cassou.me>
>> do you have any suggestion for this?
Eli Zaretskii <eliz@gnu.org> 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.
--
Damien Cassou
"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-29 10:46 ` Lars Ingebrigtsen
@ 2022-09-30 8:44 ` Damien Cassou
0 siblings, 0 replies; 13+ messages in thread
From: Damien Cassou @ 2022-09-30 8:44 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: Eli Zaretskii, 58071
Lars Ingebrigtsen <larsi@gnus.org> 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
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-30 8:43 ` Damien Cassou
@ 2022-09-30 10:38 ` Eli Zaretskii
0 siblings, 0 replies; 13+ messages in thread
From: Eli Zaretskii @ 2022-09-30 10:38 UTC (permalink / raw)
To: Damien Cassou; +Cc: 58071
> From: Damien Cassou <damien@cassou.me>
> Cc: 58071@debbugs.gnu.org
> Date: Fri, 30 Sep 2022 10:43:48 +0200
>
> Eli Zaretskii <eliz@gnu.org> 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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-26 7:42 ` Eli Zaretskii
2022-09-28 19:26 ` Damien Cassou
@ 2022-10-06 6:09 ` Damien Cassou
1 sibling, 0 replies; 13+ messages in thread
From: Damien Cassou @ 2022-10-06 6:09 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 58071
[-- Attachment #1: Type: text/plain, Size: 2460 bytes --]
Please find a new version of the files attached and my answers to your
feedback below.
Eli Zaretskii <eliz@gnu.org> writes:
> "jumprel" is not the best name, IMO; something like
> "related-files" would be better
Renamed to related-files.
> what you call "recipes", i.e. descriptors of how to generate the
> name of related files from a given file name, should be documented
> in a single doc string
Agree. Doc strings and file headers have been rewritten. The doc
string of `related-files-jumpers' quickly describes all known kinds of
jumpers and refer to the customization interface and the manual (to be
written) for the details. I refrained from describing the full syntax of
every kind of jumper in `related-files-jumpers' to keep it
understandable.
The customization interface of `related-file-jumpers' has received a lot
of love with default values, clearer tags, documentation, and better
overall presentation.
> I find no documentation of how to describe alternatives -- several
> alternative file names produced from a single original file name
I fixed that by improving the doc strings of `related-files-jumpers',
`related-files-jump', `related-files-make',
`related-files-jump-or-make' and `related-files-apply'.
> jumprel-recipe.el is AFAICT devoid of any recipe-related public
> APIs, so I don't see how such a separation can be possible.
related-files-recipe.el overrides the `related-files-apply' method. So
loading this file introduces a new kind of jumper. This is the same for
related-files-regexp.el. Both files are completely optional and serve as
examples to implement more kinds of jumpers.
> I also question the motivation: is jumprel.el really independent of
> the inner workings of the recipes as implemented in
> jumprel-recipe.el?
I think it is and it has been designed with this in mind. As far as I
know, related-files.el works perfectly with 3 kinds of jumpers whose
implementation is really different:
- function-based jumpers are implemented in related-files.el as a
default in cl-defgeneric methods.
- recipe-based jumpers are optional and implemented in
related-files-recipe.el.
- regexp-based jumpers are optional and implemented in
related-files-regexp.el.
> The interface doesn't seem to me abstract enough to justify the
> separation.
Would you mind explaining this part?
--
Damien Cassou
"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
[-- Attachment #2: related-files.el --]
[-- Type: text/plain, Size: 20132 bytes --]
;;; related-files.el --- Easily find files related to the current one -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; Author: Damien Cassou <damien@cassou.me>
;; Keywords: tools
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Thousands times a day you want to jump from a file to its test file
;; (or to its CSS file, or to its header file, or any other related
;; file) and just as many times you want to go back to the initial
;; file. JUMPing to RELated (related-files) files is what this package is
;; about.
;; The question is: how does a user specify that a file is related to
;; a set of other files? One way is to create a function that takes a
;; file as argument and returns a list of related filenames:
;;
;; (defun my/related-files-jumper (file)
;; (let ((without-ext (file-name-sans-extension file)))
;; (list
;; (concat without-ext ".js")
;; (concat without-ext ".css"))))
;;
;; (setq related-files-jumpers (list #'my/related-files-jumper))
;;
;; `my/related-files-jumper' is called a 'jumper. With this setup,
;; `related-files-jump' will let the user jump from Foo.js to Foo.css and
;; back.
;;
;; This is working good but has several limitations:
;;
;; 1. If Foo.css is not in the same directory as Foo.js or if you want
;; to include test files which end with "-tests.js",
;; `my/related-files-jumper' has to be modified in a non-obvious way or a
;; complicated new jumper must be written and added to
;; `related-files-jumpers';
;;
;; 2. The function `my/related-files-jumper' has to be shared with all Emacs
;; users working on the same project
;; So related-files recommends another approach that is less powerful but
;; much simpler. Here is another way to define the same jumper:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css")
;;
;; This list must replace `my/related-files-jumper' in
;; `related-files-jumpers'. This jumper lets the user go from Foo.js
;; to Foo.css. related-files will automatically inverse the meaning
;; of :remove-suffix and :add-suffix arguments so the user can also go
;; from Foo.css to Foo.js with this jumper. See
;; `related-files-jumpers' and THE MANUAL (TODO) for more information.
;;
;; This kind of jumper can easily be shared with the members of a team
;; through a .dir-locals.el file. See (info "(Emacs) Directory Variables").
;;
;; `related-files-make' also makes it easy to create a related file and fill
;; it with some content. If the content is always the same, a string
;; can be used to specify it:
;;
;; (recipe :remove-suffix ".js" :add-suffix ".css" :filler "Fill the CSS file")
;;
;; There is also an `auto-insert'-based way to fill new files and new
;; kinds of fillers can easily be implemented. See the manual for
;; more information.
;; If you want to add a new kind of jump, override `related-files-apply' and
;; optionally `related-files-get-filler', call `related-files-add-jumper-type' and
;; add a function to `related-files-jumper-safety-functions'.
;;
;; If you want to add a new kind of filler, override `related-files-fill'
;; and call `related-files-add-filler-type'.
;;; Code:
(require 'subr-x)
(require 'cl-lib)
\f
;;; Customization Options
(defgroup related-files nil
"Facilitate navigation between the current file and related files."
:group 'tools)
(define-widget 'related-files-jumper 'lazy
"A description of how two files relate to each other."
:tag "Jumper"
:type '(choice))
(define-widget 'related-files-filler 'lazy
"A description of how to fill a new file."
:format "%v"
:type '(choice :value ""))
;;;###autoload
(defvar related-files-jumper-safety-functions nil
"Functions checking if a given jumper is safe or not.
Each function should take a jumper as argument and should return
either nil, 'safe or 'unsafe. Nil must be returned if the
function doesn't know if the jumper is safe.
The first function returning non-nil will determine the safety of
the jumper and other functions won't be executed.")
;;;###autoload (put 'related-files-jumpers 'safe-local-variable (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'related-files-jumper-safety-functions jumper))) jumpers)))
(defcustom related-files-jumpers nil
"List of jumpers to consider to go from the current file to related files.
There are different kinds of jumpers:
- A jumper can be a function. In this case, the function should
accept the current place as argument (a filename) and should
return a (possibly-empty) list of (existing and non-existing)
places the user might want to go to or create from the current
place. Instead of returning a list, the jumper may also just
return a place.
- A jumper can also be a list (regexp MATCH EXPANSION...). MATCH
is a regular expression that should match a file name that has a
sibling. It can contain sub-expressions that will be used in
EXPANSIONS. EXPANSION is a string that matches file names.
- A jumper can also be a list (recipe [:remove-suffix
REMOVE-SUFFIX] [:add-suffix ADD-SUFFIX] [:add-directory
ADD-DIRECTORY] [:case-transformer TRANSFORMATION]). Such a
jumper defines transformations to apply to the current file name
to get related file names. A :filler keyword can also be added
to the list to specify how to create a missing file. Such a
jumper has the advantage that is works both ways: you can go from
a file to its related files but also from any related file to the
initial file and other related files.
Other kinds of jumpers can be created by writing Emacs Lisp.
Defining a new kind of jumper requires overriding
`related-files-apply' and optionally `related-files-get-filler'.
It also requires calling `related-files-add-jumper-type' and
adding a function to `related-files-jumper-safety-functions'.
Get more information about jumper types defined above, new
jumpers and fillers through the customization interface and THE
MANUAL (TODO)."
:type '(repeat :tag "Jumpers" related-files-jumper)
:safe (lambda (jumpers) (seq-every-p (lambda (jumper) (eq 'safe (run-hook-with-args-until-success 'related-files-jumper-safety-functions jumper))) jumpers)))
\f
;;; Public Functions
;;;###autoload
(defun related-files-jump (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed. The
resulting list of candidates is shown to the user so one can be
selected. If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates. If the resulting list contains only one item, this
item is automatically selected.
Only existing files are presented to the user. Look at
`related-files-make' and `related-files-jump-or-make' if you also want to be
able to create new files.
If JUMPERS is not provided, use `related-files-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt related-files-jumpers current-prefix-arg)))))
(related-files--jump-or-make jumpers current-place :include-existing-places t))
;;;###autoload
(defun related-files-make (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed. The
resulting list of candidates is shown to the user so one can be
selected. If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates. If the resulting list contains only one item, this
item is automatically selected.
Only non-existing files are presented to the user so the user can
easily create them. This is useful to create a test file for the
current file for example. Look at `related-files-jump' and
`related-files-jump-or-make' if you also want to be able to jump to
existing files.
If JUMPERS is not provided, use `related-files-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt related-files-jumpers current-prefix-arg)))))
(related-files--jump-or-make jumpers current-place :include-non-existing-places t))
;;;###autoload
(defun related-files-jump-or-make (&optional jumpers current-place)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Each element of JUMPERS is asked for a list of candidates and the
resulting lists are concatenated with duplicates removed. The
resulting list of candidates is shown to the user so one can be
selected. If the resulting list is empty, the user will get an
error message with some ideas on what to configure to get
candidates. If the resulting list contains only one item, this
item is automatically selected.
Both existing and non-existing files are presented to the user so
the user can easily jump to existing files or create missing
ones. Look at `related-files-jump' and `related-files-make' if you don't
want to mix existing and non-existing files in the same list..
If JUMPERS is not provided, use `related-files-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'.
Interactively, a numeric prefix argument selects the jumper at
the specified position (zero-based index) in `related-files-jumpers'."
(interactive (list (when (numberp current-prefix-arg)
(list (seq-elt related-files-jumpers current-prefix-arg)))))
(related-files--jump-or-make jumpers current-place
:include-existing-places t
:include-non-existing-places t))
\f
;;; Jumpers Public API
(cl-defgeneric related-files-apply (jumper place)
"Apply JUMPER to PLACE and return related places or nil.
PLACE is a filename and the result must be a possibly-empty list
of filenames.
The default implementation allows JUMPER to be a function. The
function can return either a single place or a possibly-empty
list of places."
(funcall jumper place))
(cl-defgeneric related-files-get-filler (jumper)
"Return a filler associated with JUMPER.
There is no filler associated to a function-based jumper but
other kinds of jumpers may be able to specify a filler.")
\f
;;; Filler Public API
(cl-defgeneric related-files-fill (filler &allow-other-keys &rest)
"Use FILLER to fill the current buffer with some content.
The current buffer is empty when this function is called.
Beyond the filler, this function is called with the :jumper and
:place keyword arguments.")
\f
;;; Functions Manipulating Places
(defun related-files--choose-place (places initial-place)
"Let the user pick one of PLACES and return it.
PLACES is a list of filenames and INITIAL-PLACE is a filename.
INITIAL-PLACE is the place that was current when the user started
related-files. It is used to format each place in PLACES."
(cond
((length= places 0) (user-error "No place to go to. Consider configuring `related-files-jumpers' or using `related-files-make'") nil)
((length= places 1) (car places))
(t (let ((initial-directory (file-name-directory initial-place)))
(related-files--completing-read "Place: " places (apply-partially #'related-files--format-place initial-directory))))))
(defun related-files--act-on-place (place)
"Either open or create PLACE, a filename."
(if (file-exists-p place)
(find-file place)
(related-files--make-place place)))
(defun related-files--format-place (initial-directory place)
"Return a string representing PLACE.
INITIAL-DIRECTORY is used to format PLACE relatively.
If PLACE doesn't exist, append \"(create it!)\" to the return
value."
(when-let* ((relative-name (file-relative-name place initial-directory)))
(if (file-exists-p place)
relative-name
(format "%s (create it!)" relative-name))))
(defun related-files--make-place (place)
"Create the file at PLACE.
If a jumper is attached to PLACE and if this jumper has a filler,
use the filler to populate the new file with initial content."
(find-file place)
(when-let* ((jumper (get-text-property 0 :related-files-jumper place))
(filler (related-files-get-filler jumper)))
(related-files-fill filler :jumper jumper :place place)))
\f
;;; Fillers
(cl-defmethod related-files-fill ((filler string) &allow-other-keys &rest)
"Fill the current buffer with FILLER, a string."
(insert filler))
(cl-defmethod related-files-fill ((_filler (eql auto-insert)) &allow-other-keys &rest)
"Fill the current buffer by calling `auto-insert'."
(auto-insert))
\f
;;; Utility Functions
(cl-defun related-files--jump-or-make (jumpers current-place &key include-existing-places include-non-existing-places)
"Let the user choose where to go from CURRENT-PLACE by asking JUMPERS.
Existing files are presented to the user if
INCLUDE-EXISTING-PLACES is non-nil. Non-existing files are
presented to the user if INCLUDE-NON-EXISTING-PLACES is non-nil.
If JUMPERS is not provided, use `related-files-jumpers'. If
CURRENT-PLACE is not provided, use the function
`buffer-file-name'."
(let* ((jumpers (or jumpers related-files-jumpers))
(current-place (or current-place (buffer-file-name))))
(cond ((not jumpers)
(user-error "No jumpers. Consider configuring `related-files-jumpers'"))
((not current-place)
(user-error "Related-Files only works from file-based buffers"))
(t
(let ((existing-places (when include-existing-places
(related-files--collect-existing-places jumpers current-place)))
(non-existing-places (when include-non-existing-places
(related-files--collect-non-existing-places jumpers current-place))))
(when-let* ((place (related-files--choose-place (append existing-places non-existing-places) current-place)))
(related-files--act-on-place place)))))))
(defun related-files--collect-existing-places (jumpers current-place)
"Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.
Each jumper in JUMPERS is not only called with CURRENT-PLACE as
argument but also with all places generated by other jumpers,
recursively. Only existing places are considered and returned.
The returned value doesn't contain CURRENT-PLACE."
(when current-place
(let* ((places nil)
(places-queue (list current-place)))
(while places-queue
(when-let* ((place (pop places-queue))
((file-exists-p place))
((not (seq-contains-p places place))))
(unless (equal place current-place) (push place places))
(let ((new-places (related-files--call-jumpers jumpers place)))
(setq places-queue (nconc places-queue new-places)))))
places)))
(defun related-files--collect-non-existing-places (jumpers current-place)
"Return a list of places that can be accessed from CURRENT-PLACE with JUMPERS.
Only non-existing places are considered and returned. The
returned value doesn't contain CURRENT-PLACE."
(cl-delete-if
(lambda (place) (or (equal place current-place)
(file-exists-p place)))
(related-files--call-jumpers jumpers current-place)))
(defun related-files--call-jumpers (jumpers place)
"Return a list of places that can be accessed from PLACE with JUMPERS."
(mapcan (apply-partially #'related-files--call-jumper place) jumpers))
(defun related-files--call-jumper (place jumper)
"Return a list of places that can be accessed from PLACE with JUMPER."
(when-let* ((place-or-places (related-files-apply jumper place))
(places (if (proper-list-p place-or-places)
place-or-places
(list place-or-places))))
(related-files--attach-jumper-to-places jumper places)))
(defun related-files--attach-jumper-to-places (jumper places)
"Return PLACES with JUMPER attached to each.
Each item of the return value remembers it was created with
JUMPER."
(mapcar
(lambda (place) (propertize place :related-files-jumper jumper))
places))
(defun related-files--completing-read (prompt entities formatter)
"Display PROMPT and let the user choose one of ENTITIES in the minibuffer.
Format each entity with FORMATTER before presenting it to the
user."
(let* ((entity-string-to-entity (make-hash-table :test 'equal :size (length entities)))
(entity-strings (mapcar formatter entities)))
(cl-loop
for entity in entities
for entity-string in entity-strings
do (puthash entity-string entity entity-string-to-entity))
(when-let* ((entity-string (completing-read prompt entity-strings nil t)))
(gethash entity-string entity-string-to-entity))))
(defun related-files-add-jumper-type (customization-type)
"Add CUSTOMIZATION-TYPE choice to `related-files-jumper' widget.
This function should be called when creating a new kind of jumper
to add an alternative customization type to the `customize'
interface of `related-files-jumpers'.
CUSTOMIZATION-TYPE describes what the new kind of jumper should
look like and should contain the same kind of data as the :type
argument of `defcustom'. See Info node `(elisp) Customization
Types' for more information."
(related-files--add-choice-to-type 'related-files-jumper customization-type))
(defun related-files-add-filler-type (customization-type)
"Add CUSTOMIZATION-TYPE choice to `related-files-filler' widget.
This function should be called when creating a new kind of filler
to add an alternative customization type to the `customize'
interface of `related-files-jumpers'.
CUSTOMIZATION-TYPE describes what the new kind of filler should
look like and should contain the same kind of data as the :type
argument of `defcustom'. See Info node `(elisp) Customization
Types' for more information."
(related-files--add-choice-to-type 'related-files-filler customization-type))
(defun related-files--add-choice-to-type (widget-symbol customization-type)
"Add CUSTOMIZATION-TYPE to the choice type of WIDGET-SYMBOL.
CUSTOMIZATION-TYPE is only added if absent from the type
alternatives."
(when-let* ((widget (get widget-symbol 'widget-type))
(choice (widget-get widget :type))
((not (seq-contains-p (cdr choice) customization-type))))
(widget-put widget :type `(,@choice ,customization-type))))
(related-files-add-jumper-type
'(function
:format "%t: %v\n%h\n"
:doc "Should accept a place as argument and return a list of related places."))
(related-files-add-filler-type '(string :tag "Fill with pre-defined content" :value "Replace me with a better default"))
(related-files-add-filler-type '(const :tag "Use `auto-insert'" auto-insert))
(provide 'related-files)
;;; related-files.el ends here
;; LocalWords: minibuffer related-files
[-- Attachment #3: related-files-recipe.el --]
[-- Type: text/plain, Size: 10130 bytes --]
;;; related-files-recipe.el --- Provide a recipe DSL to define related-files jumpers -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The code below defines a file name recipe DSL to create related-files
;; jumpers. Such a jumper should be defined as a list starting with the
;; symbol 'recipe.
;;; Code:
(require 'subr-x)
(require 'map)
(require 'related-files)
\f
;;; Overrides of Public Methods
(cl-defmethod related-files-apply ((jumper (head recipe)) place)
"Return a list of new places built by applying recipe JUMPER to PLACE."
(append
(apply #'related-files-recipe--apply-filename-jumper place (cdr jumper))
(apply #'related-files-recipe--unapply-filename-jumper place (cdr jumper))))
(cl-defmethod related-files-get-filler ((jumper (head recipe)))
"Return the filler of recipe JUMPER."
(map-elt (cdr jumper) :filler))
\f
;;; Utility Functions
(cl-defun related-files-recipe--apply-filename-jumper
(place &key (remove-suffix "") (add-suffix "") case-transformer add-directory
&allow-other-keys)
"Return places built after applying some modifications to PLACE.
Modifications are applied in the order below.
REMOVE-SUFFIX is a string (e.g., \".el\") that PLACE should
end with and that is going to be removed from it.
ADD-SUFFIX is a string (e.g., \"-tests.el\") that will be
added at the end.
CASE-TRANSFORMER is one of the kind of tranformers defined by
`related-files-recipe--apply-case-transformer' and is used to change
the case of the filename.
ADD-DIRECTORY is a string (e.g., \"test\") that is added next to
directory names in PLACE."
(when-let* (((related-files-recipe--suffix-can-be-changed-p place add-suffix remove-suffix))
(path-without-suffix (substring place 0 (- (length remove-suffix))))
(path-with-suffix (concat path-without-suffix add-suffix))
(path-with-changed-case (related-files-recipe--apply-to-filename
path-with-suffix
(apply-partially #'related-files-recipe--apply-case-transformer case-transformer))))
(if add-directory
(related-files-recipe--add-directory-to-path path-with-changed-case add-directory)
(list path-with-changed-case))))
(cl-defun related-files-recipe--unapply-filename-jumper (place &key (add-suffix "") (remove-suffix "") case-transformer add-directory &allow-other-keys)
"Return places built after un-applying some modifications to PLACE.
The meaning of ADD-SUFFIX, REMOVE-SUFFIX, CASE-TRANSFORMER and
ADD-DIRECTORY is the opposite of the one of
`related-files-recipe--apply-filename-jumper'. For example, ADD-SUFFIX
should already be present in PLACE and will be removed from it."
(when-let* (((related-files-recipe--suffix-can-be-changed-p place remove-suffix add-suffix))
(path-without-suffix (substring place 0 (- (length add-suffix))))
(path-with-suffix (concat path-without-suffix remove-suffix))
(path-with-changed-case (related-files-recipe--apply-to-filename
path-with-suffix
(apply-partially #'related-files-recipe--unapply-case-transformer case-transformer))))
(if add-directory
(related-files-recipe--remove-directory-from-path path-with-changed-case add-directory)
(list path-with-changed-case))))
(defun related-files-recipe--add-directory-to-path (file add-directory)
"Return the paths to files looking like FILE but with ADD-DIRECTORY inside it.
The file-system is searched for existing directories but the
returned paths don't have to exist."
(cl-labels
((parent-directory (directory) (file-name-directory (directory-file-name directory)))
(root-p (directory) (string= directory (parent-directory directory))))
(cl-loop
for current-directory = (file-name-directory file) then (parent-directory current-directory)
for candidate = (expand-file-name
(substring file (length (expand-file-name current-directory)))
(expand-file-name add-directory current-directory))
if (file-exists-p (file-name-directory candidate)) collect candidate into result
if (root-p current-directory) return result)))
(defun related-files-recipe--remove-directory-from-path (file remove-directory)
"Return the paths to files looking like FILE but with REMOVE-DIRECTORY removed.
The file-system is searched for existing directories but the
returned paths don't have to exist."
(when-let* ((path-segments (split-string file "/"))
(positions (related-files-recipe--seq-positions path-segments remove-directory)))
(cl-loop
for position in positions
for candidate = (string-join (related-files-recipe--seq-remove-at-position path-segments position) "/")
if (file-exists-p (file-name-directory candidate)) collect candidate)))
(defun related-files-recipe--apply-to-filename (path fn)
"Apply FN to the filename part of PATH."
(let* ((filename (file-name-nondirectory path))
(directory (file-name-directory path)))
(expand-file-name (funcall fn filename) directory)))
(defun related-files-recipe--apply-case-transformer (transformer string)
"Return the result of applying TRANFORMER to STRING.
TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
(cl-case transformer
(capitalize (concat (upcase (substring string 0 1)) (substring string 1)))
(uncapitalize (concat (downcase (substring string 0 1)) (substring string 1)))
(t (if transformer
(user-error "Unknown transformer %s" transformer)
string))))
(defun related-files-recipe--unapply-case-transformer (transformer string)
"Return the result of un-applying TRANFORMER to STRING.
TRANSFORMER should be either nil, 'capitalize or 'uncapitalize.
If nil, this function just returns STRING."
(let ((untransformer (cl-case transformer
(capitalize 'uncapitalize)
(uncapitalize 'capitalize)
(t transformer))))
(related-files-recipe--apply-case-transformer untransformer string)))
(defun related-files-recipe--suffix-can-be-changed-p (path add-suffix remove-suffix)
"Return nil if REMOVE-SUFFIX cannot be replaced with ADD-SUFFIX in PATH.
The function also returns nil if ADD-SUFFIX is already present in
PATH. This avoids adding the same suffix again. For example,
the function returns nil if -tests.el is added to
/project/foo-tests.el to avoid getting
/project/foo-tests-tests.el as candidate."
(and
(string-suffix-p remove-suffix path)
(or (not (string-suffix-p add-suffix path))
(string-suffix-p add-suffix remove-suffix))))
;; NOTE: This is in Emacs 29 already under the name `seq-positions'
(defun related-files-recipe--seq-positions (seq elt &optional testfn)
"Return the positions of ELT in SEQ.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(cl-loop for i from 0 below (length seq)
if (funcall (or testfn #'equal) (nth i seq) elt) collect i))
;; NOTE: This is in Emacs 29 already under the name `seq-remove-at-position'
(defun related-files-recipe--seq-remove-at-position (seq position)
"Return a copy of SEQ where the element at POSITION got removed."
(append
(cl-subseq seq 0 position)
(cl-subseq seq (1+ position))))
(related-files-add-jumper-type
'(cons
:tag "Transformation recipe"
(const :tag "" recipe)
(set
:tag "Transformations"
(list :inline t
:format "%t: %v\n%d"
:tag "Remove a string from the end of the filename, e.g., \".el\""
(const :remove-suffix :tag "")
(string :tag "Suffix to remove" :value ".c"))
(list :inline t
:format "%t: %v\n%d"
:tag "Add a string at the end of the filename, e.g., \"-tests.el\""
(const :add-suffix :tag "")
(string :tag "Suffix to add" :value ".h"))
(list :inline t
:tag "Case transformer"
:format "%t: %v%h\n"
:doc "Useful when a file and its related files have names with different case"
(const :case-transformer :tag "")
(choice
:value capitalize
(const :tag "Capitalize the filename" capitalize)
(const :tag "Uncapitalize the filename" uncapitalize)))
(list :inline t
:tag "String that is added next to directory names in PLACE"
:format "%t: %v\n%h\n"
:doc "Useful when a related file is in a parallel file hierarchy.\nFor example, with a value of \"test\", the user could jump from\n\"/project/src/lisp/calendar/parse-time.el\" to\n\"/project/src/test/lisp/calendar/parse-time.el\" and back.\nThe directory must already exist."
(const :add-directory :tag "")
(string :tag "Directory name to add" :value "test"))
(list :inline t
:tag "Filler"
:format "%t: %v\n"
(const :filler :tag "")
related-files-filler))))
;;;###autoload
(add-hook 'related-files-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'recipe) 'safe)))
(provide 'related-files-recipe)
;;; related-files-recipe.el ends here
;; LocalWords: tranformers el
[-- Attachment #4: related-files-regexp.el --]
[-- Type: text/plain, Size: 8381 bytes --]
;;; related-files-recipe.el --- Provide a recipe DSL to define related-files jumpers -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; NOTE The code and documentation below is heavily copy/pasted from
;; `find-sibling-rules' and `find-sibling-file' by Lars Ingebrigtsen
;; <larsi@gnus.org>. TODO: This NOTE should probably be deleted if we
;; decide to replace `find-sibling-file' with related-files.
;; The code below makes it possible to create related-files jumpers from
;; regular expressions. Such a jumper should be defined as a list
;; starting with the symbol 'regexp followed by two strings MATCH and
;; EXPANSION. MATCH is a regular expression that should match a file
;; name that has a sibling. It can contain sub-expressions that will
;; be used in EXPANSION.
;; EXPANSION is a string that matches file names. For instance, to
;; define ".h" files as siblings of any ".c", you could say:
;;
;; (regexp "\\([^/]+\\)\\.c\\'" "\\1.h")
;; MATCH and EXPANSION can also be fuller paths. For instance, if
;; you want to define other versions of a project as being sibling
;; files, you could say something like:
;;
;; (regexp "src/emacs/[^/]+/\\(.*\\)\\'" "src/emacs/.*/\\1\\'")
;; In this example, if you’re in src/emacs/emacs-27/lisp/abbrev.el,
;; and an src/emacs/emacs-28/lisp/abbrev.el file exists, it’s now
;; defined as a sibling.
;; Regexp-based jumpers as defined here do not support fillers.
;;; Code:
(require 'related-files)
(require 'map)
\f
;;; Overrides of Public Methods
(cl-defmethod related-files-apply ((jumper (head regexp)) place)
"Return a list of new places built by applying regexp JUMPER to PLACE."
(related-files-recipe--find-sibling-file-search
place
(list (cons (nth 1 jumper) (nth 2 jumper)))))
(cl-defmethod related-files-get-filler ((_jumper (head regexp)))
"Return nil as no filler can be associated with regexp-based jumpers."
nil)
\f
;;; Emacs 29 functions adapted
(defun related-files-recipe--find-sibling-file-search (file rules)
;; Same as `find-sibling-file-search' in Emacs 29 except that
;;
;; - `rules' is a mandatory parameter;
;;
;; - it calls `related-files-recipe--file-expand-wildcards' instead of `file-expand-wildcards'.
"Return a list of FILE's \"siblings\"
RULES should be a list on the form defined by `find-sibling-rules' (which
see), and if nil, defaults to `find-sibling-rules'."
(let ((results nil))
(pcase-dolist (`(,match . ,expansions) rules)
;; Go through the list and find matches.
(when (string-match match file)
(let ((match-data (match-data)))
(dolist (expansion expansions)
(let ((start 0))
;; Expand \\1 forms in the expansions.
(while (string-match "\\\\\\([&0-9]+\\)" expansion start)
(let ((index (string-to-number (match-string 1 expansion))))
(setq start (match-end 0)
expansion
(replace-match
(substring file
(elt match-data (* index 2))
(elt match-data (1+ (* index 2))))
t t expansion)))))
;; Then see which files we have that are matching. (And
;; expand from the end of the file's match, since we might
;; be doing a relative match.)
(let ((default-directory (substring file 0 (car match-data))))
;; Keep the first matches first.
(setq results
(nconc
results
(mapcar #'expand-file-name
(related-files-recipe--file-expand-wildcards expansion nil t)))))))))
;; Delete the file itself (in case it matched), and remove
;; duplicates, in case we have several expansions and some match
;; the same subsets of files.
(delete file (delete-dups results))))
(defun related-files-recipe--file-expand-wildcards (pattern &optional full regexp)
;; Same as `file-expand-wildcards' in Emacs 29
"Expand (a.k.a. \"glob\") file-name wildcard pattern PATTERN.
This returns a list of file names that match PATTERN.
The returned list of file names is sorted in the `string<' order.
PATTERN is, by default, a \"glob\"/wildcard string, e.g.,
\"/tmp/*.png\" or \"/*/*/foo.png\", but can also be a regular
expression if the optional REGEXP parameter is non-nil. In any
case, the matches are applied per sub-directory, so a match can't
span a parent/sub directory, which means that a regexp bit can't
contain the \"/\" character.
The returned list of file names is sorted in the `string<' order.
If PATTERN is written as an absolute file name, the expansions in
the returned list are also absolute.
If PATTERN is written as a relative file name, it is interpreted
relative to the current `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
(save-match-data
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
;; A list of all dirs that DIRPART specifies.
;; This can be more than one dir
;; if DIRPART contains wildcards.
(dirs (if (and dirpart
(string-match "[[*?]" (file-local-name dirpart)))
(mapcar 'file-name-as-directory
(related-files-recipe--file-expand-wildcards
(directory-file-name dirpart) nil regexp))
(list dirpart)))
contents)
(dolist (dir dirs)
(when (or (null dir) ; Possible if DIRPART is not wild.
(file-accessible-directory-p dir))
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
(mapcar (lambda (name)
(unless (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory name))
name))
(directory-files
(or dir ".") full
(if regexp
;; We're matching each file name
;; element separately.
(concat "\\`" nondir "\\'")
(wildcard-to-regexp nondir)))))))
(setq contents
(nconc
(if (and dir (not full))
(mapcar (lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
contents)))))
contents)))
(related-files-add-jumper-type
'(list
:tag "Regexp"
(const :tag "" regexp)
(regexp
:format "%t: %v%h"
:value "\\([^/]+\\)\\.c\\'"
:tag "Match"
:doc "MATCH is a regular expression that should match a file name that has a sibling.\nIt can contain sub-expressions that will be used in EXPANSIONS.")
(repeat
:tag "Expansions"
(string
:format "%t: %v%h"
:value "\\1.h"
:tag "Expansion"
:doc "EXPANSION is a string that matches file names.\nIt can refer to sub-expressions of Match using \\DIGIT."))))
;;;###autoload
(add-hook 'related-files-jumper-safety-functions (lambda (jumper) (when (eq (car jumper) 'regexp) 'safe)))
(provide 'related-files-regexp)
;;; related-files-regexp.el ends here
;; LocalWords: tranformers el
[-- Attachment #5: related-files-recipe-test.el --]
[-- Type: text/plain, Size: 6998 bytes --]
;;; related-files-recipe-test.el --- Tests for related-files-recipe -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for related-files-recipe.el.
;;; Code:
(require 'related-files-recipe)
\f
;;; Customization Options
(ert-deftest related-files-recipe-test-jumpers-safe-values ()
(should (safe-local-variable-p 'related-files-jumpers '((recipe :remove-suffix ".el" add-suffix "-tests.el")))))
\f
;;; Utility Functions
(ert-deftest related-files-recipe-test-apply-filename-jumper ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let* ((place "/emacs-src/lisp/Abbrev.el")
(places (related-files-recipe--apply-filename-jumper
place
:remove-suffix ".el"
:add-suffix "-tests.el"
:case-transformer 'uncapitalize
:add-directory "test"
:filler 'foo)))
(should (seq-set-equal-p
places
'("/test/emacs-src/lisp/abbrev-tests.el"
"/emacs-src/test/lisp/abbrev-tests.el"
"/emacs-src/lisp/test/abbrev-tests.el"))))))
(ert-deftest related-files-recipe-test-unapply-filename-jumper ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let* ((place "/emacs-src/test/lisp/abbrev-tests.el")
(places (related-files-recipe--unapply-filename-jumper
place
:remove-suffix ".el"
:add-suffix "-tests.el"
:case-transformer 'uncapitalize
:add-directory "test"
:filler 'foo)))
(should (seq-set-equal-p places '("/emacs-src/lisp/Abbrev.el"))))))
(ert-deftest related-files-recipe-test-add-directory-to-path ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let ((result (related-files-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
(should (seq-set-equal-p
result
'("/test/emacs-src/lisp/abbrev.el"
"/emacs-src/test/lisp/abbrev.el"
"/emacs-src/lisp/test/abbrev.el"))))))
(ert-deftest related-files-recipe-test-add-directory-to-path-filter-non-existing-directories ()
"To reduce the number of candidates, the directories must already exist."
(let ((existing-directory "/emacs-src/test/lisp/"))
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'string= existing-directory)))
(let ((result (related-files-recipe--add-directory-to-path "/emacs-src/lisp/abbrev.el" "test")))
(should (equal
result
(list (concat existing-directory "abbrev.el"))))))))
(ert-deftest related-files-recipe-test-remove-directory-from-path ()
(cl-letf (((symbol-function 'file-exists-p)
(lambda (_) t)))
(let ((result (related-files-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
(should (seq-set-equal-p
result
'("/emacs-src/test/lisp/test/abbrev-tests.el"
"/test/emacs-src/lisp/test/abbrev-tests.el"
"/test/emacs-src/test/lisp/abbrev-tests.el"))))))
(ert-deftest related-files-recipe-test-remove-directory-from-path-filter-non-existing-directories ()
"To reduce the number of candidates, the directories must already exist."
(let ((existing-directory "/test/emacs-src/lisp/test/"))
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'string= existing-directory)))
(let ((result (related-files-recipe--remove-directory-from-path "/test/emacs-src/test/lisp/test/abbrev-tests.el" "test")))
(should (equal
result
(list (concat existing-directory "abbrev-tests.el"))))))))
(ert-deftest related-files-recipe-test-apply-to-filename ()
(should (equal (related-files-recipe--apply-to-filename "/foo/bar" #'upcase) "/foo/BAR"))
(should (equal (related-files-recipe--apply-to-filename "/foo/bar/BAZ.EL" #'downcase) "/foo/bar/baz.el")))
(ert-deftest related-files-recipe-test-apply-case-transformer ()
(should (equal (related-files-recipe--apply-case-transformer 'capitalize "foo") "Foo"))
(should (equal (related-files-recipe--apply-case-transformer 'uncapitalize "Foo") "foo"))
(should (equal (related-files-recipe--apply-case-transformer nil "foo") "foo"))
(should-error (related-files-recipe--apply-case-transformer 'unknown "foo")))
(ert-deftest related-files-recipe-test-unapply-case-transformer ()
(should (equal (related-files-recipe--unapply-case-transformer 'capitalize "Foo") "foo"))
(should (equal (related-files-recipe--unapply-case-transformer 'uncapitalize "foo") "Foo"))
(should (equal (related-files-recipe--unapply-case-transformer nil "foo") "foo"))
(should-error (related-files-recipe--unapply-case-transformer 'unknown "foo")))
(ert-deftest related-files-recipe-test-suffix-can-be-changed-p ()
(should-not (related-files-recipe--suffix-can-be-changed-p "/a/b.el" ".el" "-tests.el"))
(should-not (related-files-recipe--suffix-can-be-changed-p "/a/b-tests.el" "-tests.el" ".el"))
(should (related-files-recipe--suffix-can-be-changed-p "/a/b-tests.el" ".el" "-tests.el"))
(should (related-files-recipe--suffix-can-be-changed-p "/a/b.el" "-tests.el" ".el"))
(should (related-files-recipe--suffix-can-be-changed-p "/a/b.less" ".js" ".less")))
(ert-deftest related-files-recipe-test-seq-positions ()
(should (equal '(0 3) (related-files-recipe--seq-positions '("a" "b" "c" "a" "d") "a")))
(should (equal '() (related-files-recipe--seq-positions '("a" "b" "c" "a" "d") "Z"))))
(ert-deftest related-files-recipe-test-seq-remove-at-position ()
(let ((letters '(a b c d)))
(should (equal '(a b d) (related-files-recipe--seq-remove-at-position letters 2)))
(should (equal '(b c d) (related-files-recipe--seq-remove-at-position letters 0)))
(should (equal '(a b c) (related-files-recipe--seq-remove-at-position letters 3)))))
(provide 'related-files-recipe-test)
;;; related-files-recipe-test.el ends here
[-- Attachment #6: related-files-test.el --]
[-- Type: text/plain, Size: 5198 bytes --]
;;; related-files-test.el --- Tests for related-files -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Damien Cassou
;; Author: Damien Cassou <damien@cassou.me>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.2"))
;; Created: 25 Sep 2022
;; URL: https://www.gnu.org/software/emacs/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for related-files.el.
;;; Code:
(require 'related-files)
(require 'ert)
(require 'cl-lib)
(require 'seq)
\f
;;; Customization Options
(ert-deftest related-files-test-jumpers-safe-values ()
(should (safe-local-variable-p 'related-files-jumpers nil))
(should-not (safe-local-variable-p 'related-files-jumpers (list (lambda (place) place)))))
\f
;;; Jumpers Public API
(ert-deftest related-files-test-apply-function-jumper ()
(let* ((place 'place)
(jumperIdentity #'identity)
(jumperConst (lambda (_) place)))
(should (equal (related-files-apply jumperIdentity "/foo/bar") "/foo/bar"))
(should (equal (related-files-apply jumperConst "/foo/bar") place))))
\f
;;; Functions Manipulating Places
(ert-deftest related-files-test-format-place ()
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'equal "/project/foo/exists.el")))
(should (equal (related-files--format-place "/project/foo/" "/project/foo/exists.el") "exists.el"))
(should (equal (related-files--format-place "/project/bar/" "/project/foo/exists.el") "../foo/exists.el"))
(should (equal (related-files--format-place "/project/foo/" "/project/foo/non-existing.el") "non-existing.el (create it!)"))))
\f
;;; Utility Functions
(ert-deftest related-files-test-collect-existing-places-does-not-return-current-place ()
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'seq-contains-p '("/bar" "/foo"))))
(let* ((current-place "/bar")
(new-place "/foo")
(jumper1 (lambda (_) new-place)))
(should (equal
(related-files--collect-existing-places (list jumper1) current-place)
(list new-place))))))
(ert-deftest related-files-test-collect-existing-places-returns-uniq-results ()
"If 2 jumpers produce the same place, the place should only appear once."
(cl-letf (((symbol-function 'file-exists-p)
(apply-partially #'seq-contains-p '("/bar" "/foo"))))
(let* ((current-place "/bar")
(new-place "/foo")
(jumper1 (lambda (_) new-place))
(jumper2 (lambda (_) new-place)))
(should (seq-set-equal-p
(related-files--collect-existing-places (list jumper1 jumper2) current-place)
(list new-place))))))
(ert-deftest related-files-test-collect-existing-places-returns-no-place-when-no-current-place ()
"If there is no current place, there shouldn't be any destination place."
(should-not (related-files--collect-existing-places '(jumper) nil)))
(ert-deftest related-files-test-call-jumpers ()
(let* ((jumperAtom (lambda (_) "/foo"))
(jumperList (lambda (_) (list "/bar1" "/bar2")))
(jumperSingleton (lambda (_) (list "/baz")))
(jumperNil (lambda (_)))
(jumperIdentity #'identity))
(should (seq-set-equal-p (related-files--call-jumpers
(list jumperAtom jumperList)
"/")
'("/foo" "/bar1" "/bar2")))
(should (seq-set-equal-p (related-files--call-jumpers
(list jumperAtom jumperSingleton)
"/")
'("/foo" "/baz")))
(should (seq-set-equal-p (related-files--call-jumpers
(list jumperAtom jumperNil)
"/")
'("/foo")))
(should (seq-set-equal-p (related-files--call-jumpers
(list jumperAtom jumperIdentity)
'"/")
'("/foo" "/")))
(should (seq-set-equal-p (related-files--call-jumpers
(list jumperAtom jumperList jumperSingleton jumperNil jumperIdentity)
'"/")
'("/foo" "/bar1" "/bar2" "/baz" "/")))))
(ert-deftest related-files-test-test--call-jumpers-attach-jumper-to-all-places ()
(let* ((jumper (lambda (_) "/foo"))
(place (car (related-files--call-jumpers (list jumper) "/"))))
(should (eq (get-text-property 0 :related-files-jumper place) jumper))))
(provide 'related-files-test)
;;; related-files-test.el ends here
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files
2022-09-25 11:20 bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files Damien Cassou
2022-09-26 7:42 ` Eli Zaretskii
2022-09-26 11:05 ` Lars Ingebrigtsen
@ 2022-10-28 22:08 ` hugo
2 siblings, 0 replies; 13+ messages in thread
From: hugo @ 2022-10-28 22:08 UTC (permalink / raw)
To: 58071
Hi Damien,
I've been looking for a package just like this for a while now. I was
close to getting round to writing one, but now you have, so thank you!
I've had a look through it, and so far I really like it. I think its
probably a pretty common problem for lots of Emacs users (jumping to
related files easily), so I think including it in the core would make
sense, but I can also see the points others have made and wouldn't
mind downloading from somewhere else either.
Some comments:
- The package doesn't work for non-file based buffers, which in
particular means it doesn't work in org (roam) capture buffers (for
jumping to the pdf I'm making notes on). I appreciate that you need
some sort of reference to get off the ground, and that /normally/
that will be a file name, but for my use case it would be great to
be able to use other things as well (org roam node id, or a citation
ref). This would make a big difference to me. Of course, the package
doesn't have to do all the work of handling these different cases,
so long as the user can write their own functions for everything
(and it is well documented how these interact/what types of inputs
and outputs everything needs).
- Conversely, the package hard-codes /how/ to jump to a file---with
`find-file'. This means I can't go the other way, from a pdf file to
an org-roam-capture buffer on its notes (which is what I would like
to do). Another way of saying this is the package assumes all places
will be files, and that the best way to get to them is `find-file'.
It would be nice to be able to specify (perhaps customisable,
arbitrary?) types of places and functions actually used to /do/ the
jumping. (though I agree that `find-file' is a very sensible
default).
- At the moment, the presented list of places (files) to jump to is
just a list of strings (as in, there is no file metadata, so things
like Marginalia don't work properly). I think this should be fixed.
This might also make it easier to implement different kinds of
jumpers; have an alist of ~(CATEGORY . JUMP-FUNCTION)~ function
pairs. Whenever the user selects something from the jump list, get
its category, look that up, and then ~(funcall JUMP-FUNCTION
SELECTION)~. Ideally, any such system should also support
pretty-printing functions for non-string (e.g. org-roam nodes)
places. Just a thought, I don't know how easy this would be to
implement.
- Documentation could be improved, but you knew that already, and
there isn't much point until the package reaches a more stable
state. Once it is, I would be happy to write some if you want help.
- I can see myself using something like `:filler' a lot, but not
necessarily for altering the buffer, and which runs every time I
jump (or maybe every time I jump, /and/ the buffer I end up is newly
created---even if the file already existed). I'm thinking about
things like setting local variables which I might use later for
establishing targets to jump /back/ to from that buffer. Perhaps
something like this could be included in a a separate `:hook' or
`:final' keyword, which would be run /last/ in the jumping process.
Hope some of that is useful, or finds its way into some code. I'd be
happy to make patch contributions, but at this stage I'd like to hear
what you think about how I want to use the package and what you want
to include before I start hacking.
Hugo
^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2022-10-28 22:08 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-09-25 11:20 bug#58071: 28.2; [PATCH] jumprel: A tool to find/create related files Damien Cassou
2022-09-26 7:42 ` Eli Zaretskii
2022-09-28 19:26 ` Damien Cassou
2022-09-29 8:54 ` Eli Zaretskii
2022-09-30 8:43 ` Damien Cassou
2022-09-30 10:38 ` Eli Zaretskii
2022-09-29 10:46 ` Lars Ingebrigtsen
2022-09-30 8:44 ` Damien Cassou
2022-10-06 6:09 ` Damien Cassou
2022-09-26 11:05 ` Lars Ingebrigtsen
2022-09-26 13:37 ` Stefan Kangas
2022-09-27 11:34 ` Lars Ingebrigtsen
2022-10-28 22:08 ` hugo
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).