picnoir
/
my-repo-pins
mirror of https://github.com/NinjaTrappeur/my-repo-pins.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Rename the project 

Hinted by the Melpa maintainers here:
https://github.com/melpa/melpa/pull/8093

Using a single letter name was a mistake. Renaming the project to
something a bit more sensible. Maybe not too sensible that being said:
we had to adopt a pun.

Kudos to Wiwi for the pun: it's perfect.
This commit is contained in:
Félix Baylac-Jacqué 2022-06-27 14:44:51 +02:00
parent 1030d83f26
commit c058603766
No known key found for this signature in database
GPG Key ID: EFD315F31848DBA4
10 changed files with 769 additions and 524 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile
View File

@ -21,15 +21,15 @@ INIT_PACKAGES="(progn \
all: compile test package-lint clean-elc
test:
${EMACS} -Q --eval ${INIT_PACKAGES} --batch -l h.el -l h-tests.el -f ert-run-tests-batch-and-exit
${EMACS} -Q --eval ${INIT_PACKAGES} --batch -l my-repo-pins.el -l my-repo-pins-tests.el -f ert-run-tests-batch-and-exit
package-lint:
${EMACS} -Q --eval ${INIT_PACKAGES} --batch -f package-lint-batch-and-exit h.el
${EMACS} -Q --eval ${INIT_PACKAGES} --batch -f package-lint-batch-and-exit my-repo-pins.el
compile: clean-elc
${EMACS} -Q --eval ${INIT_PACKAGES} -L . --batch -f batch-byte-compile *.el
clean-elc:
clean:
rm -f f.elc
.PHONY: all compile clean-elc package-lint test

68
README.md
View File

@ -1,4 +1,9 @@
# H.el [![CI](https://github.com/NinjaTrappeur/h.el/actions/workflows/test.yml/badge.svg)](https://github.com/NinjaTrappeur/h.el/actions/workflows/test.yml)
# My Repo Pins [![CI](https://github.com/NinjaTrappeur/my-repo-pins/actions/workflows/test.yml/badge.svg)](https://github.com/NinjaTrappeur/my-repo-pins/actions/workflows/test.yml)
![Project logo](./doc/assets/logo-white.svg#gh-dark-mode-only)
![Project logo](./doc/assets/logo-black.svg#gh-light-mode-only)
This Emacs plugin is all about helping you to keep your git repositories organized in a single unified tree.
@ -18,7 +23,7 @@ IE., having a directory structure like that:
    │   └── mpv
    └── NinjaTrappeur
        ├── cinny
        └── h.el
        └── my-repo-pins.el
```
This Emacs plugin aims to help you navigate this repository tree **and** clone new repositories at the right place in the tree.
@ -29,89 +34,87 @@ As always, a small demo is worth a thousand words!
**Jump to a local repository you already cloned:**
![Screen capture showcasing h.el jumping to a already checked out repository](./doc/assets/jump-local.webp)
![Screen capture showcasing my-repo-pins.el jumping to a already checked out repository](./doc/assets/jump-local.webp)
**Find a repository in a remote forge, clone it, and jump to it:**
![Screen capture showcasing h.el cloning a git repository from a remote forge before jumping to it](./doc/assets/clone-project.webp)
![Screen capture showcasing my-repo-pins.el cloning a git repository from a remote forge before jumping to it](./doc/assets/clone-project.webp)
**Alternatively, you can also specify a absolute git URL you want to clone:**
![Screen capture showcasing h.el cloning a git repository using a absolute git url before jumping to it](./doc/assets/clone-absolute-url.webp)
This plugin is heavily inspired by [**Zimbatm's h**](https://github.com/zimbatm/h).
![Screen capture showcasing my-repo-pins.el cloning a git repository using a absolute git url before jumping to it](./doc/assets/clone-absolute-url.webp)
## Quick Start
The minimal configuration consists in setting the directory in which you want to clone all your git repositories via the `h-code-root` variable.
The minimal configuration consists in setting the directory in which you want to clone all your git repositories via the `my-repo-pins-code-root` variable.
Let's say you'd like to store all your git repositories in the `~/code-root` directory. You'll want to add the following snippet in your Emacs configuration file:
```elisp
(require 'h)
(setq h-code-root "~/code-root")
(setq my-repo-pins-code-root "~/code-root")
```
You can then call the `M-x h-jump-to-project` command to open a project living in your `~/code-root` directory **or** clone a new project in your code root.
You can then call the `M-x my-repo-pins` command to open a project living in your `~/code-root` directory **or** clone a new project in your code root.
Binding this command to a global key binding might make things a bit more convenient. I personally like to bind it to `M-h`. You can add the following snippet to your Emacs configuration to set up this key binding:
```elisp
(global-set-key (kbd "M-h") 'h-jump-to-project)
(global-set-key (kbd "M-h") 'my-repo-pins)
```
## Customization
### h-code-root - REQUIRED
### my-repo-pins-code-root - REQUIRED
Path to the directory containing all your projects. `h.el` organize the git repos you'll clone in a tree fashion.
Path to the directory containing all your projects. `my-repo-pins.el` organize the git repos you'll clone in a tree fashion.
All the code fetched using `h.el` will end up in this root directory. A tree of subdirectories will be created mirroring the remote clone URL.
All the code fetched using `my-repo-pins.el` will end up in this root directory. A tree of subdirectories will be created mirroring the remote clone URL.
For instance, after checking out https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code will live in the h-code-root/git.savannah.gnu.org/git/emacs/org-mode/ local directory
For instance, after checking out https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code will live in the my-repo-pins-code-root/git.savannah.gnu.org/git/emacs/org-mode/ local directory
### h-git-bin
### my-repo-pins-git-bin
Path pointing to the git binary. By default, it'll look for git in the current `$PATH`.
### h-forge-fetchers
### my-repo-pins-forge-fetchers
Alist in the form of `("FORGE NAME" . FETCH-FUNCTION)` where `FETCH-FUNCTION` is a function in charge of retrieving a potential remote clone URL. More about this function in the [Fetchers](#fetchers) section.
## Fetchers
When a repository cannot be found in the code root directory, `h.el` will try to download it from different forges. By default, it'll try to find it on github.com, gitlab.com, git.sr.ht, and codeberg.org.
When a repository cannot be found in the code root directory, `my-repo-pins.el` will try to download it from different forges. By default, it'll try to find it on github.com, gitlab.com, git.sr.ht, and codeberg.org.
### Re-Using the Default Fetchers for your own Forge Instance
H.el provides some generic fetchers for Gitlab, Sourcehut, and Gitea.
My-repo-pins.el provides some generic fetchers for Gitlab, Sourcehut, and Gitea.
You can re-use these generic fetchers for your own forge instance using the following functions:
- GitLab: `h--query-gitlab-owner-repo`
- SourceHut: `h--query-sourcehut-owner-repo`
- Gitea: `h--query-gitea-owner-repo`
- GitLab: `my-repo-pins--query-gitlab-owner-repo`
- SourceHut: `my-repo-pins--query-sourcehut-owner-repo`
- Gitea: `my-repo-pins--query-gitea-owner-repo`
These functions share the same 4 input arguments:
- `instance-url`: your instance [FQDN](https://fr.wikipedia.org/wiki/Fully_qualified_domain_name). For instance: `gitlab.gnome.org`, `git.alternativebit.fr`, …
- `user-name`: the user name for which we want to clone the repository.
- `repo-name`: name of the repository we want to clone.
- `callback`: function `h.el` will use to clone the repository once we retrieved the various clone URLs. The callback takes an alist as parameter. The alist being of the form of : `((ssh . SSH-CHECKOUT-URL) (https . HTTPS-CHECKOUT-URL))`.
- `callback`: function `My-repo-pins.el` will use to clone the repository once we retrieved the various clone URLs. The callback takes an alist as parameter. The alist being of the form of : `((ssh . SSH-CHECKOUT-URL) (https . HTTPS-CHECKOUT-URL))`.
You can re-use these functions by instantiating them for a specific forge, then by appending this instantiation to the `h-forge-fetchers` variable in your Emacs configuration.
You can re-use these functions by instantiating them for a specific forge, then by appending this instantiation to the `my-repo-pins-forge-fetchers` variable in your Emacs configuration.
Let's say you want to retrieve repositories from the Gnome Gitlab instance living at `gitlab.gnome.org`. You'll have to add the following snippet to your Emacs configuration:
```elisp
(setq h-forge-fetchers
`(("gitlab.gnome.org" (lambda (owner repo cb)(h--query-gitlab-owner-repo "gitlab.gnome.org" owner repo cb)))
,h-forge-fetchers))
(setq my-repo-pins-forge-fetchers
`(("gitlab.gnome.org" (lambda (owner repo cb)(my-repo-pins--query-gitlab-owner-repo "gitlab.gnome.org" owner repo cb)))
,my-repo-pins-forge-fetchers))
```
### Writing your Forge Fetcher from Scratch
You may also want to support a forge for which `h.el` currently does not provide any generic fetcher. In that case, you'll have to write a function in the form of:
You may also want to support a forge for which `my-repo-pins.el` currently does not provide any generic fetcher. In that case, you'll have to write a function in the form of:
```elisp
(defun your-custom-fetcher (owner repo)
@ -121,8 +124,8 @@ You may also want to support a forge for which `h.el` currently does not provide
The function needs to accept two input parameters:
- `owner`: string containing the name of the owner of the query repository. IE. `ninjatrappeur` for the `ninjatrappeur/h.el` query.
- `repository`: string containing the name of the query repository. IE. `h.el` for the `ninjatrappeur/h.el` query.
- `owner`: string containing the name of the owner of the query repository. IE. `ninjatrappeur` for the `ninjatrappeur/my-repo-pins.el` query.
- `repository`: string containing the name of the query repository. IE. `my-repo-pins.el` for the `ninjatrappeur/my-repo-pins.el` query.
This function will return either `nil` in case the query couldn't be found on the remote forge. An alist containing the SSH and HTTPS clone URLs in the form of:
@ -130,3 +133,8 @@ This function will return either `nil` in case the query couldn't be found on th
'((ssh . SSH-CHECKOUT-URL)
(https . HTTPS-CHECKOUT-URL))
```
## Aknowledgements
- This plugin is heavily inspired by [**Zimbatm's h**](https://github.com/zimbatm/h). Thanks a lot for this amazing tool, it made my life easier for years!
- Thanks a lot to Wiwi who found the **terrible** pun we used to name this project.

71
doc/assets/logo-black.svg Normal file
View File

@ -0,0 +1,71 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
width="400mm"
height="200mm"
viewBox="0 0 400 199.99999"
version="1.1"
id="svg5"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<defs
id="defs2" />
<g
id="layer1">
<g
aria-label="My"
id="text11"
style="font-size:128.862px;line-height:1.25;font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';letter-spacing:0px;word-spacing:0px;fill:#000000;stroke-width:3.22156">
<path
d="M 248.93135,36.371491 V 99.292389 H 223.76299 V 17.495221 H 324.43643 V 99.292389 H 299.26807 V 36.371491 H 286.68389 V 99.292389 H 261.51553 V 36.371491 Z"
id="path3197"
style="fill:#000000" />
<path
d="M 349.60479,67.83194 H 330.72852 V 17.495221 h 25.16836 V 48.95567 h 12.58418 V 17.495221 h 25.16836 V 67.83194 h -18.87627 v 31.460449 h -25.16836 z"
id="path3199"
style="fill:#000000" />
</g>
<g
aria-label="repo pins"
id="text19"
style="font-size:67.5452px;line-height:1.25;font-family:Helvetica;-inkscape-font-specification:Helvetica;letter-spacing:0px;word-spacing:0px;fill:#000000;stroke-width:1.68863">
<path
d="m 122.94092,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 6.59621,16.49053 h -6.59621 v 16.49052 H 109.7485 v -42.87537 h 32.98105 v 16.49053 l -4.94715,4.94716 4.94715,4.94716 v 16.49052 h -13.19242 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3202" />
<path
d="m 159.22008,151.79952 h 19.78863 v 9.89431 h -32.98105 v -42.87537 h 32.98105 v 9.89432 h -19.78863 v 6.59621 h 19.78863 v 9.89432 h -19.78863 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3204" />
<path
d="m 195.49924,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3206" />
<path
d="m 231.7784,151.79952 h 6.59621 v -23.08674 h -6.59621 z m -13.19242,9.89431 v -42.87537 h 32.98105 v 42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3208" />
<path
d="m 284.81194,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3210" />
<path
d="m 321.0911,118.81846 v 42.87537 h -13.19242 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3212" />
<path
d="m 357.37026,118.81846 v 42.87537 h -13.19243 v -32.98105 h -6.59621 v 32.98105 H 324.3892 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3214" />
<path
d="m 380.45699,128.71278 h -6.59621 v 6.59621 h 19.78864 v 26.38484 h -32.98106 v -13.19242 h 13.19242 v 3.29811 h 6.59621 v -6.59621 h -19.78863 v -26.38485 h 32.98106 v 13.19242 h -13.19243 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#000000"
id="path3216" />
</g>
<path
id="path3000"
style="fill:#000000;stroke-width:4.19701;stroke-linecap:square;stroke-linejoin:bevel"
d="M 91.05284,5.9650105 C 41.866279,6.1312243 2.5722989,50.262466 2.0029785,83.050227 a 16.307598,8.1574354 0 0 1 16.1152955,-7.525639 16.307598,8.1574354 0 0 1 16.213481,7.172689 16.307598,8.1574354 0 0 1 16.101342,-7.172689 16.307598,8.1574354 0 0 1 16.388664,8.102348 l 5.17e-4,0.05478 a 16.307598,8.1574354 0 0 1 -0.0098,0.142627 h 0.268201 a 16.442225,8.1574354 0 0 1 -0.0062,-0.08733 l -5.17e-4,-0.05478 a 16.442225,8.1574354 0 0 1 16.061035,-8.15144 V 91.83264 a 16.442225,8.1574354 0 0 1 -0.0057,0 v 106.60795 h 17.792713 1.81642 8.46667 14.62598 v -13.2333 -10.19731 h -9.74153 v 10.19731 h -4.88445 -8.46667 -1.81642 V 91.83212 a 16.94002,8.1574354 0 0 1 -0.0413,10e-4 V 75.531306 a 16.94002,8.1574354 0 0 1 16.42226,7.454842 16.307598,8.1574354 0 0 1 16.15818,-7.46156 16.307598,8.1574354 0 0 1 16.19643,7.078638 16.307598,8.1574354 0 0 1 16.08274,-7.078638 16.307598,8.1574354 0 0 1 16.2972,7.333403 C 181.28843,49.988222 140.45916,5.8009387 91.05284,5.9650105 Z" />
</g>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 4.6 KiB

95
doc/assets/logo-inkscape.svg Normal file
View File

@ -0,0 +1,95 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
width="400mm"
height="200mm"
viewBox="0 0 400 199.99999"
version="1.1"
id="svg5"
inkscape:version="1.2 (dc2aedaf03, 2022-05-15)"
sodipodi:docname="logo-inkscape.svg"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<sodipodi:namedview
id="namedview7"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:showpageshadow="2"
inkscape:pageopacity="0.0"
inkscape:pagecheckerboard="0"
inkscape:deskcolor="#d1d1d1"
inkscape:document-units="mm"
showgrid="false"
inkscape:zoom="0.457453"
inkscape:cx="-243.74089"
inkscape:cy="-86.347668"
inkscape:window-width="2558"
inkscape:window-height="1419"
inkscape:window-x="0"
inkscape:window-y="0"
inkscape:window-maximized="1"
inkscape:current-layer="layer1" />
<defs
id="defs2" />
<g
inkscape:label="Calque 1"
inkscape:groupmode="layer"
id="layer1">
<g
aria-label="My"
id="text11"
style="font-size:128.862px;line-height:1.25;font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';letter-spacing:0px;word-spacing:0px;stroke-width:3.22156">
<path
d="M 248.93135,36.371491 V 99.292389 H 223.76299 V 17.495221 H 324.43643 V 99.292389 H 299.26807 V 36.371491 H 286.68389 V 99.292389 H 261.51553 V 36.371491 Z"
id="path3197" />
<path
d="M 349.60479,67.83194 H 330.72852 V 17.495221 h 25.16836 V 48.95567 h 12.58418 V 17.495221 h 25.16836 V 67.83194 h -18.87627 v 31.460449 h -25.16836 z"
id="path3199" />
</g>
<g
aria-label="repo pins"
id="text19"
style="font-size:67.5452px;line-height:1.25;font-family:Helvetica;-inkscape-font-specification:Helvetica;letter-spacing:0px;word-spacing:0px;stroke-width:1.68863">
<path
d="m 122.94092,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 6.59621,16.49053 h -6.59621 v 16.49052 H 109.7485 v -42.87537 h 32.98105 v 16.49053 l -4.94715,4.94716 4.94715,4.94716 v 16.49052 h -13.19242 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3202" />
<path
d="m 159.22008,151.79952 h 19.78863 v 9.89431 h -32.98105 v -42.87537 h 32.98105 v 9.89432 h -19.78863 v 6.59621 h 19.78863 v 9.89432 h -19.78863 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3204" />
<path
d="m 195.49924,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3206" />
<path
d="m 231.7784,151.79952 h 6.59621 v -23.08674 h -6.59621 z m -13.19242,9.89431 v -42.87537 h 32.98105 v 42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3208" />
<path
d="m 284.81194,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3210" />
<path
d="m 321.0911,118.81846 v 42.87537 h -13.19242 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3212" />
<path
d="m 357.37026,118.81846 v 42.87537 h -13.19243 v -32.98105 h -6.59621 v 32.98105 H 324.3892 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3214" />
<path
d="m 380.45699,128.71278 h -6.59621 v 6.59621 h 19.78864 v 26.38484 h -32.98106 v -13.19242 h 13.19242 v 3.29811 h 6.59621 v -6.59621 h -19.78863 v -26.38485 h 32.98106 v 13.19242 h -13.19243 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush'"
id="path3216" />
</g>
<path
id="path3000"
style="fill:#000000;stroke-width:4.19701;stroke-linecap:square;stroke-linejoin:bevel"
d="M 91.05284,5.9650105 C 41.866279,6.1312243 2.5722989,50.262466 2.0029785,83.050227 a 16.307598,8.1574354 0 0 1 16.1152955,-7.525639 16.307598,8.1574354 0 0 1 16.213481,7.172689 16.307598,8.1574354 0 0 1 16.101342,-7.172689 16.307598,8.1574354 0 0 1 16.388664,8.102348 l 5.17e-4,0.05478 a 16.307598,8.1574354 0 0 1 -0.0098,0.142627 h 0.268201 a 16.442225,8.1574354 0 0 1 -0.0062,-0.08733 l -5.17e-4,-0.05478 a 16.442225,8.1574354 0 0 1 16.061035,-8.15144 V 91.83264 a 16.442225,8.1574354 0 0 1 -0.0057,0 v 106.60795 h 17.792713 1.81642 8.46667 14.62598 v -13.2333 -10.19731 h -9.74153 v 10.19731 h -4.88445 -8.46667 -1.81642 V 91.83212 a 16.94002,8.1574354 0 0 1 -0.0413,10e-4 V 75.531306 a 16.94002,8.1574354 0 0 1 16.42226,7.454842 16.307598,8.1574354 0 0 1 16.15818,-7.46156 16.307598,8.1574354 0 0 1 16.19643,7.078638 16.307598,8.1574354 0 0 1 16.08274,-7.078638 16.307598,8.1574354 0 0 1 16.2972,7.333403 C 181.28843,49.988222 140.45916,5.8009387 91.05284,5.9650105 Z" />
</g>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 5.3 KiB

71
doc/assets/logo-white.svg Normal file
View File

@ -0,0 +1,71 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
width="400mm"
height="200mm"
viewBox="0 0 400 199.99999"
version="1.1"
id="svg5"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<defs
id="defs2" />
<g
id="layer1">
<g
aria-label="My"
id="text11"
style="font-size:128.862px;line-height:1.25;font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';letter-spacing:0px;word-spacing:0px;fill:#ffffff;stroke-width:3.22156">
<path
d="M 248.93135,36.371491 V 99.292389 H 223.76299 V 17.495221 H 324.43643 V 99.292389 H 299.26807 V 36.371491 H 286.68389 V 99.292389 H 261.51553 V 36.371491 Z"
id="path3197"
style="fill:#ffffff" />
<path
d="M 349.60479,67.83194 H 330.72852 V 17.495221 h 25.16836 V 48.95567 h 12.58418 V 17.495221 h 25.16836 V 67.83194 h -18.87627 v 31.460449 h -25.16836 z"
id="path3199"
style="fill:#ffffff" />
</g>
<g
aria-label="repo pins"
id="text19"
style="font-size:67.5452px;line-height:1.25;font-family:Helvetica;-inkscape-font-specification:Helvetica;letter-spacing:0px;word-spacing:0px;fill:#ffffff;stroke-width:1.68863">
<path
d="m 122.94092,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 6.59621,16.49053 h -6.59621 v 16.49052 H 109.7485 v -42.87537 h 32.98105 v 16.49053 l -4.94715,4.94716 4.94715,4.94716 v 16.49052 h -13.19242 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3202" />
<path
d="m 159.22008,151.79952 h 19.78863 v 9.89431 h -32.98105 v -42.87537 h 32.98105 v 9.89432 h -19.78863 v 6.59621 h 19.78863 v 9.89432 h -19.78863 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3204" />
<path
d="m 195.49924,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3206" />
<path
d="m 231.7784,151.79952 h 6.59621 v -23.08674 h -6.59621 z m -13.19242,9.89431 v -42.87537 h 32.98105 v 42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3208" />
<path
d="m 284.81194,128.71278 v 6.59621 h 6.59621 v -6.59621 z m 0,16.49053 v 16.49052 h -13.19242 v -42.87537 h 32.98105 v 26.38485 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3210" />
<path
d="m 321.0911,118.81846 v 42.87537 h -13.19242 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3212" />
<path
d="m 357.37026,118.81846 v 42.87537 h -13.19243 v -32.98105 h -6.59621 v 32.98105 H 324.3892 v -42.87537 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3214" />
<path
d="m 380.45699,128.71278 h -6.59621 v 6.59621 h 19.78864 v 26.38484 h -32.98106 v -13.19242 h 13.19242 v 3.29811 h 6.59621 v -6.59621 h -19.78863 v -26.38485 h 32.98106 v 13.19242 h -13.19243 z"
style="font-family:'Robot Crush';-inkscape-font-specification:'Robot Crush';fill:#ffffff"
id="path3216" />
</g>
<path
id="path3000"
style="fill:#ffffff;stroke-width:4.19701;stroke-linecap:square;stroke-linejoin:bevel"
d="M 91.05284,5.9650105 C 41.866279,6.1312243 2.5722989,50.262466 2.0029785,83.050227 a 16.307598,8.1574354 0 0 1 16.1152955,-7.525639 16.307598,8.1574354 0 0 1 16.213481,7.172689 16.307598,8.1574354 0 0 1 16.101342,-7.172689 16.307598,8.1574354 0 0 1 16.388664,8.102348 l 5.17e-4,0.05478 a 16.307598,8.1574354 0 0 1 -0.0098,0.142627 h 0.268201 a 16.442225,8.1574354 0 0 1 -0.0062,-0.08733 l -5.17e-4,-0.05478 a 16.442225,8.1574354 0 0 1 16.061035,-8.15144 V 91.83264 a 16.442225,8.1574354 0 0 1 -0.0057,0 v 106.60795 h 17.792713 1.81642 8.46667 14.62598 v -13.2333 -10.19731 h -9.74153 v 10.19731 h -4.88445 -8.46667 -1.81642 V 91.83212 a 16.94002,8.1574354 0 0 1 -0.0413,10e-4 V 75.531306 a 16.94002,8.1574354 0 0 1 16.42226,7.454842 16.307598,8.1574354 0 0 1 16.15818,-7.46156 16.307598,8.1574354 0 0 1 16.19643,7.078638 16.307598,8.1574354 0 0 1 16.08274,-7.078638 16.307598,8.1574354 0 0 1 16.2972,7.333403 C 181.28843,49.988222 140.45916,5.8009387 91.05284,5.9650105 Z" />
</g>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 4.6 KiB

356
h-tests.el
View File

@ -1,356 +0,0 @@
;;; h-tests.el --- Project navigation and remote checkout -*- lexical-binding: t; -*-
;;; Copyright (C) 2022 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 1.14.0
;;; License:
;;; 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:
;;; TODO before publish
;;; Code:
(require 'ert)
(require 'h)
;; Test Helpers
;;;;;;;;;;;;;;
(defun h--tests-with-temp-dir (func)
"Run the FUNC function in a temporary directory.
FUNC gets called with the temp dir as parameter.
The directory gets deleted once we exit FUNC."
(let ((temp-dir (make-temp-file "h-test-" t)))
(unwind-protect
(funcall func (file-name-as-directory temp-dir))
(delete-directory temp-dir t))))
(defun h--tests-init-fake-git-repo (dir)
"Create a dummy git repo at DIR.
If DIR doesn't exists, we create it first."
(let* ((d (file-name-as-directory dir))
(git-process
(progn
(make-directory d t)
(h--call-git-in-dir d
nil
"init"))))
(progn
(unless (file-directory-p d) (make-directory d t))
;; ERT does not handle async processes gracefully for the time
;; being. Blocking and waiting for the git process to exit
;; before moving on.
(while (accept-process-output git-process)))))
;; Test Dirs Setup
;;;;;;;;;;;;;;;;;
(defun h--tests-run-on-testroot-1 (func)
"Run the FUNC function on testroot1.
FUNC is called with the directory cotaining test root 1 as parameter.
For reference: test-root-1 looks like this:
test-root-1
├── example1.tld
│ ├── user1
│ │ ├── proj1
│ │ └── proj2
│ └── user2
│ └── proj1
└── example2.tld
└── user1
└── proj1"
(h--tests-with-temp-dir
(lambda (temp-dir)
(progn
(h--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1"))
(h--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj2"))
(h--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1"))
(h--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)
))))
(defun h--tests-run-on-testroot-2 (func)
"Run the FUNC function on testroot2.
FUNC is called with the directory cotaining test root 2 as parameter.
For reference: test-root-2 looks like this:
test-root-2
├── example1.tld
│ ├── user1
│ │ ├── proj1
│ │ └── proj2 (NOT A GIT REPO)
│ └── user2
│ └── proj1
└── example2.tld
└── user1
└── proj1"
(h--tests-with-temp-dir
(lambda (temp-dir)
(progn
(h--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1"))
(make-directory (concat (file-name-as-directory temp-dir) "example1.tld/user1/proj2"))
(h--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1"))
(h--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)))))
(defun h--tests-run-on-empty-testroot (func)
"Run the FUNC function on testroot1.
FUNC is called with a empty test root.
For reference: a empty test root looks like this:
test-root"
(h--tests-with-temp-dir
(lambda (temp-dir)
(progn
(funcall func temp-dir)))))
;; Tests
;;;;;;;
(ert-deftest h--tests-get-code-root-projects-coderoot-1 ()
"Test the `h--get-code-root-projects with test-root-1 setup."
(let
((results
(h--tests-run-on-testroot-1 (lambda (root) (h--get-code-root-projects root))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user1/proj2" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 4))))
(ert-deftest h--tests-find-git-dirs-recursively-coderoot-1 ()
"Test the `h--get-code-root-projects with test-root-1 setup."
(let*
((r nil)
(results
(h--tests-run-on-testroot-1
(lambda (root)
(progn (setq r root)
(h--find-git-dirs-recursively root))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user1/proj2/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
(should (member (concat r "example2.tld/user1/proj1/") results))
(should (eq (length results) 4))))
(ert-deftest h--tests-get-code-root-projects-coderoot-2 ()
"Test the `h--get-code-root-projects with test-root-2 setup."
(let
((results
(h--tests-run-on-testroot-2 (lambda (root) (h--get-code-root-projects root))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 3))))
(ert-deftest h--tests-find-git-dirs-recursively-coderoot-2 ()
"Test the `h--get-code-root-projects with test-root-2 setup."
(let*
((r nil)
(results
(h--tests-run-on-testroot-2
(lambda (root)
(progn (setq r root)
(h--find-git-dirs-recursively root))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
(should (member (concat r "example2.tld/user1/proj1/") results))
(should (eq (length results) 3))))
(ert-deftest h--tests-get-code-root-projects-empty-coderoot ()
"Test the `h--get-code-root-projects with a empty coderoot."
(let
((results
(h--tests-run-on-empty-testroot (lambda (root) (h--get-code-root-projects root))))
)
(should (seq-empty-p results))))
(ert-deftest h--tests-find-git-dirs-recursively-empty-coderoot ()
"Test the `h--get-code-root-projects with a empty coderoot."
(let
((results
(h--tests-run-on-empty-testroot (lambda (root) (h--find-git-dirs-recursively root))))
)
(should (seq-empty-p results))))
(ert-deftest h--tests-get-code-root-projects-no-coderoot ()
"Test the `h--get-code-root-projects with a non-existing coderoot."
(let
((results (h--get-code-root-projects "/does/not/exist")))
(should (seq-empty-p results))))
;; Test Fetchers
;;;;;;;;;;;;;;;;;
;; Github
(ert-deftest h--tests-fetch-github-parse-response-ok ()
"Test h--tests-fetch-github-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/github-get-request-ok.txt")
(should (equal (h--fetch-github-parse-response (current-buffer))
'((ssh . "git@github.com:NinjaTrappeur/h.el.git")
(https . "https://github.com/NinjaTrappeur/h.el.git"))))))
(ert-deftest h--tests-fetch-github-parse-response-ko ()
"Test h--tests-fetch-github-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/github-get-request-ko.txt")
(should (equal (h--fetch-github-parse-response (current-buffer)) nil))))
;; Gitea
(ert-deftest h--tests-fetch-gitea-parse-response-ok ()
"Test h--tests-fetch-gitea-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/gitea-get-request-ok.txt")
(should (equal (h--fetch-gitea-parse-response (current-buffer))
'((ssh . "gitea@git.alternativebit.fr:NinjaTrappeur/h.el.git")
(https . "https://git.alternativebit.fr/NinjaTrappeur/h.el.git"))))))
(ert-deftest h--tests-fetch-gitea-parse-response-ko ()
"Test h--tests-fetch-gitea-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/gitea-get-request-ko.txt")
(should (equal (h--fetch-gitea-parse-response (current-buffer)) nil))))
;; Test repo URI parser
;;;;;;;;;;;;;;;;;
(ert-deftest h--test-parse-repo-identifier ()
"Test h--parse-repo-identifier."
(should (equal
(h--parse-repo-identifier "https://github.com/Ninjatrappeur/h.el")
'((tag . full-url) (full-url . "https://github.com/Ninjatrappeur/h.el"))))
(should (equal
(h--parse-repo-identifier "github.com/Ninjatrappeur/h.el")
'((tag . full-url) (full-url . "github.com/Ninjatrappeur/h.el"))))
(should (equal
(h--parse-repo-identifier "Ninjatrappeur/h.el")
'((tag . owner-repo) (owner . "Ninjatrappeur") (repo . "h.el"))))
(should (equal
(h--parse-repo-identifier "h.el")
'((tag . repo) (repo . "h.el")))))
(ert-deftest h--test-filepath-from-clone-url ()
"Test h--filepath-from-clone-url."
;; HTTP/HTTPS
(should (equal (h--filepath-from-clone-url "http://github.com/NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "http://github.com/NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "https://github.com/NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "https://github.com/NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "http://git.savannah.gnu.org/cgit/emacs/elpa.git") "git.savannah.gnu.org/cgit/emacs/elpa"))
(should (equal (h--filepath-from-clone-url "https://git.savannah.gnu.org/git/emacs.git") "git.savannah.gnu.org/git/emacs"))
;; SSH
(should (equal (h--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "git@github.com:NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "git@github.com:NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el")))
(ert-deftest h--test-git-clone-in-dir ()
"Test the h--git-clone-in-dir function."
(h--tests-run-on-testroot-1
(lambda (dir)
(let*
((tmpdir (make-temp-file "h-test-" t))
(git-process (h--git-clone-in-dir
(format "file://%s" (concat dir "example1.tld/user1/proj1/"))
tmpdir)))
(progn
(while (accept-process-output git-process))
(should (file-exists-p (format "%s/.git" tmpdir)))
(delete-directory tmpdir t))))))
;;; State Management tests
(ert-deftest h--test-init-forges-state ()
"Test the h--init-forges-state function."
(let* ((forge-fetchers
'(("GitHub.com" .
((query-user-repo . h--query-github-owner-repo)))
("GitLab.com" .
((query-user-repo . (lambda (owner repo cb) (h--query-gitlab-owner-repo "gitlab.com" owner repo cb)))))
("git.sr.ht" .
((query-user-repo . (lambda (owner repo cb) (h--query-sourcehut-owner-repo "git.sr.ht" owner repo cb)))))
("Codeberg.org" .
((query-user-repo . (lambda (owner repo cb) (h--query-gitea-owner-repo "codeberg.org" owner repo cb)))))))
(result (h--init-forges-state forge-fetchers)))
(should (equal (alist-get "GitHub.com" result nil nil 'equal) 'loading))
(should (equal (alist-get "GitLab.com" result nil nil 'equal) 'loading))
(should (equal (alist-get "git.sr.ht" result nil nil 'equal) 'loading))
(should (equal (alist-get "Codeberg.org" result nil nil 'equal) 'loading))))
;;; UI-related tests
(ert-deftest h--test-add-keys-to-forge-status ()
"Test the h--add-keys-to-forge-status function."
(let
((dummy-forge-query-status-one-result
'(("GitHub"
(ssh . "git@github.com:NinjaTrappeur/h.el.git")
(https . "https://github.com/NinjaTrappeur/h.el.git"))
("GitLab" . not-found)))
(expected-forge-query-status-with-keys-one-result
`(("GitHub"
(status
(ssh . "git@github.com:NinjaTrappeur/h.el.git")
(https . "https://github.com/NinjaTrappeur/h.el.git"))
(key . ,?1))
("GitLab" (status . not-found))))
(dummy-forge-query-status-two-results
'(("GitHub"
(ssh . "git@github.com:NinjaTrappeur/h.el.git")
(https . "https://github.com/NinjaTrappeur/h.el.git"))
("Codeberg" . not-found)
("GitLab"
(ssh . "git@gitlab.com:NinjaTrappeur/h.el.git")
(https . "https://gitlab.com/NinjaTrappeur/h.el.git"))))
(expected-forge-query-status-with-keys-two-results
`(("GitHub"
(status
(ssh . "git@github.com:NinjaTrappeur/h.el.git")
(https . "https://github.com/NinjaTrappeur/h.el.git"))
(key . ,'?1))
("Codeberg" (status . not-found))
("GitLab"
(status
(ssh . "git@gitlab.com:NinjaTrappeur/h.el.git")
(https . "https://gitlab.com/NinjaTrappeur/h.el.git"))
(key . ,'?2)))))
(should (equal
expected-forge-query-status-with-keys-one-result
(h--add-keys-to-forge-status dummy-forge-query-status-one-result)))
(should (equal
expected-forge-query-status-with-keys-two-results
(h--add-keys-to-forge-status dummy-forge-query-status-two-results)))))
(provide 'h-tests)
;;; h-tests.el ends here

356
my-repo-pins-tests.el Normal file
View File

@ -0,0 +1,356 @@
;;; my-repo-pins-tests.el --- Project navigation and remote checkout -*- lexical-binding: t; -*-
;;; Copyright (C) 2022 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 1.14.0
;;; License:
;;; 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:
;;; TODO before publish
;;; Code:
(require 'ert)
(require 'my-repo-pins)
;; Test Helpers
;;;;;;;;;;;;;;
(defun my-repo-pins--tests-with-temp-dir (func)
"Run the FUNC function in a temporary directory.
FUNC gets called with the temp dir as parameter.
The directory gets deleted once we exit FUNC."
(let ((temp-dir (make-temp-file "my-repo-pins-test-" t)))
(unwind-protect
(funcall func (file-name-as-directory temp-dir))
(delete-directory temp-dir t))))
(defun my-repo-pins--tests-init-fake-git-repo (dir)
"Create a dummy git repo at DIR.
If DIR doesn't exists, we create it first."
(let* ((d (file-name-as-directory dir))
(git-process
(progn
(make-directory d t)
(my-repo-pins--call-git-in-dir d
nil
"init"))))
(progn
(unless (file-directory-p d) (make-directory d t))
;; ERT does not handle async processes gracefully for the time
;; being. Blocking and waiting for the git process to exit
;; before moving on.
(while (accept-process-output git-process)))))
;; Test Dirs Setup
;;;;;;;;;;;;;;;;;
(defun my-repo-pins--tests-run-on-testroot-1 (func)
"Run the FUNC function on testroot1.
FUNC is called with the directory cotaining test root 1 as parameter.
For reference: test-root-1 looks like this:
test-root-1
├── example1.tld
│ ├── user1
│ │ ├── proj1
│ │ └── proj2
│ └── user2
│ └── proj1
└── example2.tld
└── user1
└── proj1"
(my-repo-pins--tests-with-temp-dir
(lambda (temp-dir)
(progn
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj2"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)
))))
(defun my-repo-pins--tests-run-on-testroot-2 (func)
"Run the FUNC function on testroot2.
FUNC is called with the directory cotaining test root 2 as parameter.
For reference: test-root-2 looks like this:
test-root-2
├── example1.tld
│ ├── user1
│ │ ├── proj1
│ │ └── proj2 (NOT A GIT REPO)
│ └── user2
│ └── proj1
└── example2.tld
└── user1
└── proj1"
(my-repo-pins--tests-with-temp-dir
(lambda (temp-dir)
(progn
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1"))
(make-directory (concat (file-name-as-directory temp-dir) "example1.tld/user1/proj2"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)))))
(defun my-repo-pins--tests-run-on-empty-testroot (func)
"Run the FUNC function on testroot1.
FUNC is called with a empty test root.
For reference: a empty test root looks like this:
test-root"
(my-repo-pins--tests-with-temp-dir
(lambda (temp-dir)
(progn
(funcall func temp-dir)))))
;; Tests
;;;;;;;
(ert-deftest my-repo-pins--tests-get-code-root-projects-coderoot-1 ()
"Test the `my-repo-pins--get-code-root-projects with test-root-1 setup."
(let
((results
(my-repo-pins--tests-run-on-testroot-1 (lambda (root) (my-repo-pins--get-code-root-projects root))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user1/proj2" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 4))))
(ert-deftest my-repo-pins--tests-find-git-dirs-recursively-coderoot-1 ()
"Test the `my-repo-pins--get-code-root-projects with test-root-1 setup."
(let*
((r nil)
(results
(my-repo-pins--tests-run-on-testroot-1
(lambda (root)
(progn (setq r root)
(my-repo-pins--find-git-dirs-recursively root))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user1/proj2/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
(should (member (concat r "example2.tld/user1/proj1/") results))
(should (eq (length results) 4))))
(ert-deftest my-repo-pins--tests-get-code-root-projects-coderoot-2 ()
"Test the `my-repo-pins--get-code-root-projects with test-root-2 setup."
(let
((results
(my-repo-pins--tests-run-on-testroot-2 (lambda (root) (my-repo-pins--get-code-root-projects root))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 3))))
(ert-deftest my-repo-pins--tests-find-git-dirs-recursively-coderoot-2 ()
"Test the `my-repo-pins--get-code-root-projects with test-root-2 setup."
(let*
((r nil)
(results
(my-repo-pins--tests-run-on-testroot-2
(lambda (root)
(progn (setq r root)
(my-repo-pins--find-git-dirs-recursively root))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
(should (member (concat r "example2.tld/user1/proj1/") results))
(should (eq (length results) 3))))
(ert-deftest my-repo-pins--tests-get-code-root-projects-empty-coderoot ()
"Test the `my-repo-pins--get-code-root-projects with a empty coderoot."
(let
((results
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--get-code-root-projects root))))
)
(should (seq-empty-p results))))
(ert-deftest my-repo-pins--tests-find-git-dirs-recursively-empty-coderoot ()
"Test the `my-repo-pins--get-code-root-projects with a empty coderoot."
(let
((results
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--find-git-dirs-recursively root))))
)
(should (seq-empty-p results))))
(ert-deftest my-repo-pins--tests-get-code-root-projects-no-coderoot ()
"Test the `my-repo-pins--get-code-root-projects with a non-existing coderoot."
(let
((results (my-repo-pins--get-code-root-projects "/does/not/exist")))
(should (seq-empty-p results))))
;; Test Fetchers
;;;;;;;;;;;;;;;;;
;; Github
(ert-deftest my-repo-pins--tests-fetch-github-parse-response-ok ()
"Test my-repo-pins--tests-fetch-github-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/github-get-request-ok.txt")
(should (equal (my-repo-pins--fetch-github-parse-response (current-buffer))
'((ssh . "git@github.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://github.com/NinjaTrappeur/my-repo-pins.el.git"))))))
(ert-deftest my-repo-pins--tests-fetch-github-parse-response-ko ()
"Test my-repo-pins--tests-fetch-github-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/github-get-request-ko.txt")
(should (equal (my-repo-pins--fetch-github-parse-response (current-buffer)) nil))))
;; Gitea
(ert-deftest my-repo-pins--tests-fetch-gitea-parse-response-ok ()
"Test my-repo-pins--tests-fetch-gitea-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/gitea-get-request-ok.txt")
(should (equal (my-repo-pins--fetch-gitea-parse-response (current-buffer))
'((ssh . "gitea@git.alternativebit.fr:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://git.alternativebit.fr/NinjaTrappeur/my-repo-pins.el.git"))))))
(ert-deftest my-repo-pins--tests-fetch-gitea-parse-response-ko ()
"Test my-repo-pins--tests-fetch-gitea-parse-response with a fixture."
(with-temp-buffer
(insert-file-contents "./tests/fixtures/gitea-get-request-ko.txt")
(should (equal (my-repo-pins--fetch-gitea-parse-response (current-buffer)) nil))))
;; Test repo URI parser
;;;;;;;;;;;;;;;;;
(ert-deftest my-repo-pins--test-parse-repo-identifier ()
"Test my-repo-pins--parse-repo-identifier."
(should (equal
(my-repo-pins--parse-repo-identifier "https://github.com/Ninjatrappeur/my-repo-pins.el")
'((tag . full-url) (full-url . "https://github.com/Ninjatrappeur/my-repo-pins.el"))))
(should (equal
(my-repo-pins--parse-repo-identifier "github.com/Ninjatrappeur/my-repo-pins.el")
'((tag . full-url) (full-url . "github.com/Ninjatrappeur/my-repo-pins.el"))))
(should (equal
(my-repo-pins--parse-repo-identifier "Ninjatrappeur/my-repo-pins.el")
'((tag . owner-repo) (owner . "Ninjatrappeur") (repo . "my-repo-pins.el"))))
(should (equal
(my-repo-pins--parse-repo-identifier "my-repo-pins.el")
'((tag . repo) (repo . "my-repo-pins.el")))))
(ert-deftest my-repo-pins--test-filepath-from-clone-url ()
"Test my-repo-pins--filepath-from-clone-url."
;; HTTP/HTTPS
(should (equal (my-repo-pins--filepath-from-clone-url "http://github.com/NinjaTrappeur/my-repo-pins.el.git") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "http://github.com/NinjaTrappeur/my-repo-pins.el") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "https://github.com/NinjaTrappeur/my-repo-pins.el.git") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "https://github.com/NinjaTrappeur/my-repo-pins.el") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "http://git.savannah.gnu.org/cgit/emacs/elpa.git") "git.savannah.gnu.org/cgit/emacs/elpa"))
(should (equal (my-repo-pins--filepath-from-clone-url "https://git.savannah.gnu.org/git/emacs.git") "git.savannah.gnu.org/git/emacs"))
;; SSH
(should (equal (my-repo-pins--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/my-repo-pins.el.git") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/my-repo-pins.el") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "git@github.com:NinjaTrappeur/my-repo-pins.el.git") "github.com/NinjaTrappeur/my-repo-pins.el"))
(should (equal (my-repo-pins--filepath-from-clone-url "git@github.com:NinjaTrappeur/my-repo-pins.el") "github.com/NinjaTrappeur/my-repo-pins.el")))
(ert-deftest my-repo-pins--test-git-clone-in-dir ()
"Test the my-repo-pins--git-clone-in-dir function."
(my-repo-pins--tests-run-on-testroot-1
(lambda (dir)
(let*
((tmpdir (make-temp-file "my-repo-pins-test-" t))
(git-process (my-repo-pins--git-clone-in-dir
(format "file://%s" (concat dir "example1.tld/user1/proj1/"))
tmpdir)))
(progn
(while (accept-process-output git-process))
(should (file-exists-p (format "%s/.git" tmpdir)))
(delete-directory tmpdir t))))))
;;; State Management tests
(ert-deftest my-repo-pins--test-init-forges-state ()
"Test the my-repo-pins--init-forges-state function."
(let* ((forge-fetchers
'(("GitHub.com" .
((query-user-repo . my-repo-pins--query-github-owner-repo)))
("GitLab.com" .
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-gitlab-owner-repo "gitlab.com" owner repo cb)))))
("git.sr.ht" .
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-sourcehut-owner-repo "git.sr.ht" owner repo cb)))))
("Codeberg.org" .
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-gitea-owner-repo "codeberg.org" owner repo cb)))))))
(result (my-repo-pins--init-forges-state forge-fetchers)))
(should (equal (alist-get "GitHub.com" result nil nil 'equal) 'loading))
(should (equal (alist-get "GitLab.com" result nil nil 'equal) 'loading))
(should (equal (alist-get "git.sr.ht" result nil nil 'equal) 'loading))
(should (equal (alist-get "Codeberg.org" result nil nil 'equal) 'loading))))
;;; UI-related tests
(ert-deftest my-repo-pins--test-add-keys-to-forge-status ()
"Test the my-repo-pins--add-keys-to-forge-status function."
(let
((dummy-forge-query-status-one-result
'(("GitHub"
(ssh . "git@github.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://github.com/NinjaTrappeur/my-repo-pins.el.git"))
("GitLab" . not-found)))
(expected-forge-query-status-with-keys-one-result
`(("GitHub"
(status
(ssh . "git@github.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://github.com/NinjaTrappeur/my-repo-pins.el.git"))
(key . ,?1))
("GitLab" (status . not-found))))
(dummy-forge-query-status-two-results
'(("GitHub"
(ssh . "git@github.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://github.com/NinjaTrappeur/my-repo-pins.el.git"))
("Codeberg" . not-found)
("GitLab"
(ssh . "git@gitlab.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://gitlab.com/NinjaTrappeur/my-repo-pins.el.git"))))
(expected-forge-query-status-with-keys-two-results
`(("GitHub"
(status
(ssh . "git@github.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://github.com/NinjaTrappeur/my-repo-pins.el.git"))
(key . ,'?1))
("Codeberg" (status . not-found))
("GitLab"
(status
(ssh . "git@gitlab.com:NinjaTrappeur/my-repo-pins.el.git")
(https . "https://gitlab.com/NinjaTrappeur/my-repo-pins.el.git"))
(key . ,'?2)))))
(should (equal
expected-forge-query-status-with-keys-one-result
(my-repo-pins--add-keys-to-forge-status dummy-forge-query-status-one-result)))
(should (equal
expected-forge-query-status-with-keys-two-results
(my-repo-pins--add-keys-to-forge-status dummy-forge-query-status-two-results)))))
(provide 'my-repo-pins-tests)
;;; my-repo-pins-tests.el ends here

266
h.el → my-repo-pins.el
View File

@ -1,10 +1,10 @@
;;; h.el --- Helps you keep your git repositories organized -*- lexical-binding: t -*-
;;; my-repo-pins.el --- Helps you keep your git repositories organized -*- lexical-binding: t -*-
;;; Copyright (C) 2022 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 0.1
;;; Homepage: https://github.com/NinjaTrappeur/h.el
;;; Homepage: https://github.com/NinjaTrappeur/my-repo-pins.el
;;; Package-Requires: ((emacs "26.1"))
;;; License:
;;;
@ -41,10 +41,10 @@
;;; │ └── mpv
;;; └── NinjaTrappeur
;;; ├── cinny
;;; └── h.el
;;; └── my-repo-pins.el
;;;
;;; The main entry point of this package is the h-jump-to-project
;;; command. Using it, you can either:
;;; The main entry point of this package is the my-repo-pins command.
;;; Using it, you can either:
;;;
;;; - Open dired in a local project you already cloned.
;;; - Query remote forges for a repository, clone it, and finally open
@ -53,16 +53,16 @@
;;;
;;; The minimal configuration consists in setting the directory in
;;; which you want to clone all your git repositories via the
;;; h-code-root variable.
;;; my-repo-pins-code-root variable.
;;;
;;; Let's say you'd like to store all your git repositories in the
;;; ~/code-root directory. You'll want to add the following snippet in
;;; your Emacs configuration file:
;;;
;;; (require 'h)
;;; (setq h-code-root "~/code-root")
;;; (require 'my-repo-pins)
;;; (setq my-repo-pins-code-root "~/code-root")
;;;
;;; You can then call the M-x h-jump-to-project command to open a
;;; You can then call the M-x my-repo-pins command to open a
;;; project living in your ~/code-root directory or clone a new
;;; project in your code root.
;;;
@ -71,7 +71,7 @@
;;; add the following snippet to your Emacs configuration to set up
;;; this key binding:
;;;
;;; (global-set-key (kbd "M-h") 'h-jump-to-project)
;;; (global-set-key (kbd "M-h") 'my-repo-pins)
;;; Code:
@ -82,40 +82,40 @@
;; loaded by default in interactive emacs, not in batch-mode emacs.
(eval-when-compile (require 'subr-x))
(defgroup h-group nil
"Variables used to setup the h.el project manager."
(defgroup my-repo-pins-group nil
"Variables used to setup the my-repo-pins.el project manager."
:group 'Communication)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal: git primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom h-git-bin "git"
(defcustom my-repo-pins-git-bin "git"
"Path pointing to the git binary.
By default, it'll look for git in the current $PATH."
:type 'file
:group 'h-group)
:group 'my-repo-pins-group)
(defun h--git-path ()
"Find the git binary path using ‘h-git-bin’.
(defun my-repo-pins--git-path ()
"Find the git binary path using ‘my-repo-pins-git-bin’.
Errors out if we can't find it."
(if (file-executable-p h-git-bin)
h-git-bin
(let ((git-from-bin-path (locate-file h-git-bin exec-path)))
(if (file-executable-p my-repo-pins-git-bin)
my-repo-pins-git-bin
(let ((git-from-bin-path (locate-file my-repo-pins-git-bin exec-path)))
(if (file-executable-p git-from-bin-path)
git-from-bin-path
(error "Can't find git. Is h-git-bin correctly set?")))))
(error "Can't find git. Is my-repo-pins-git-bin correctly set?")))))
(defun h--call-git-in-dir (dir &optional callback &rest args)
"Call the git binary as pointed by ‘h-git-bin’ in DIR with ARGS.
(defun my-repo-pins--call-git-in-dir (dir &optional callback &rest args)
"Call the git binary as pointed by ‘my-repo-pins-git-bin’ in DIR with ARGS.
Once the git subprocess exists, call CALLBACK with a the process exit
code as single argument. If CALLBACK is set to nil, don't call any
callback.
Returns the git PROCESS object."
(let* ((git-buffer (get-buffer-create "*h git log*"))
(let* ((git-buffer (get-buffer-create "*my repo pins git log*"))
(git-window nil)
(current-buffer (current-buffer))
(git-sentinel (lambda
@ -133,49 +133,49 @@ Returns the git PROCESS object."
(setq git-window (display-buffer git-buffer))
(prog1
(make-process
:name "h-git-subprocess"
:name "my-repo-pins-git-subprocess"
:buffer git-buffer
:command (seq-concatenate 'list `(,(h--git-path)) args)
:command (seq-concatenate 'list `(,(my-repo-pins--git-path)) args)
:sentinel git-sentinel)
(set-buffer current-buffer)))))
(defun h--git-clone-in-dir (clone-url checkout-filepath &optional callback)
(defun my-repo-pins--git-clone-in-dir (clone-url checkout-filepath &optional callback)
"Clone the CLONE-URL repo at CHECKOUT-FILEPATH.
Call CALLBACK with no arguments once the git subprocess exists."
(h--call-git-in-dir "~/" callback "clone" clone-url checkout-filepath))
(my-repo-pins--call-git-in-dir "~/" callback "clone" clone-url checkout-filepath))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal: builtin fetchers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generic fetcher infrastructure
(defvar h--builtins-forge-fetchers
(defvar my-repo-pins--builtins-forge-fetchers
'(("GitHub.com" .
((query-user-repo . h--query-github-owner-repo)))
((query-user-repo . my-repo-pins--query-github-owner-repo)))
("GitLab.com" .
((query-user-repo . (lambda (owner repo cb) (h--query-gitlab-owner-repo "gitlab.com" owner repo cb)))))
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-gitlab-owner-repo "gitlab.com" owner repo cb)))))
("git.sr.ht" .
((query-user-repo . (lambda (owner repo cb) (h--query-sourcehut-owner-repo "git.sr.ht" owner repo cb)))))
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-sourcehut-owner-repo "git.sr.ht" owner repo cb)))))
("Codeberg.org" .
((query-user-repo . (lambda (owner repo cb) (h--query-gitea-owner-repo "codeberg.org" owner repo cb))))))
((query-user-repo . (lambda (owner repo cb) (my-repo-pins--query-gitea-owner-repo "codeberg.org" owner repo cb))))))
"Fetchers meant to be used in conjunction with ‘h-forge-fetchers’.
"Fetchers meant to be used in conjunction with ‘my-repo-pins-forge-fetchers’.
This variable contains fetchers for:
- github.com")
(defcustom h-forge-fetchers
h--builtins-forge-fetchers
(defcustom my-repo-pins-forge-fetchers
my-repo-pins--builtins-forge-fetchers
"List of forges for which we want to remote fetch projects."
:type '(alist
:key-type symbol
:value-type (alist
:key-type symbol
:value-type (choice function string)))
:group 'h-group)
:group 'my-repo-pins-group)
(defvar h--forge-fetchers-state '()
(defvar my-repo-pins--forge-fetchers-state '()
"Internal state where we keep a forge request status.
@ -192,12 +192,12 @@ A ongoing/failed lookup will also be represented by an entry in this alist:
\(\"FORGE-NAME1\" . 'loading)
\(\"FORGE-NAME1\" . 'not-found)")
(defvar h--forge-fetchers-state-mutex
(make-mutex "h-ui-mutex")
(defvar my-repo-pins--forge-fetchers-state-mutex
(make-mutex "my-repo-pins-ui-mutex")
"Mutex in charge of preventing several fetchers to update the state concurently.")
;;; Sourcehut Fetcher
(defun h--query-sourcehut-owner-repo (instance-url user-name repo-name callback)
(defun my-repo-pins--query-sourcehut-owner-repo (instance-url user-name repo-name callback)
"Query the INSTANCE-URL Sourcehut instance and retrieve some infos about a repo.
This function will try to determine whether or not the
@ -228,7 +228,7 @@ using a HEAD request and infer the clone links from there."
(setq url-request-method nil)))
;;; Gitlab Fetcher
(defun h--query-gitlab-owner-repo (instance-url user-name repo-name callback)
(defun my-repo-pins--query-gitlab-owner-repo (instance-url user-name repo-name callback)
"Queries the INSTANCE-URL Gitlab instance and retrieve some infos about a repo.
This function will try to determine whether or not the
@ -260,7 +260,7 @@ only option we have for now."
(setq url-request-method nil)))
;;; Github Fetcher
(defun h--query-github-owner-repo (user-name repo-name callback)
(defun my-repo-pins--query-github-owner-repo (user-name repo-name callback)
"Queries the GitHub API to retrieve some infos about a GitHub repo.
This function will first try to determine whether
github.com/USER-NAME/REPO-NAME exists.
@ -271,10 +271,10 @@ nil as parameter."
(progn
(url-retrieve
(format "https://api.github.com/repos/%s/%s" user-name repo-name)
(lambda (&rest _rest) (funcall callback (h--fetch-github-parse-response(current-buffer)))))))
(lambda (&rest _rest) (funcall callback (my-repo-pins--fetch-github-parse-response(current-buffer)))))))
(defun h--fetch-github-parse-response (response-buffer)
(defun my-repo-pins--fetch-github-parse-response (response-buffer)
"Parse the RESPONSE-BUFFER containing a GET response from the GitHub API.
Parsing a response from a GET https://api.github.com/repos/user/repo request.
@ -302,7 +302,7 @@ Returns nil if the repo does not exists."
nil)))
;;; Gitea Fetcher
(defun h--query-gitea-owner-repo (instance-url user-name repo-name callback)
(defun my-repo-pins--query-gitea-owner-repo (instance-url user-name repo-name callback)
"Queries the INSTANCE-URL gitea instance to retrieve a repo informations.
This function will first try to dertermine whether the
USER-NAME/REPO-NAME exists.
@ -312,9 +312,9 @@ https clone URLs. If the repo does not exists, calls the callback with
nil as parameter."
(url-retrieve
(format "https://%s/api/v1/repos/%s/%s" instance-url user-name repo-name)
(lambda (&rest _rest) (funcall callback (h--fetch-gitea-parse-response(current-buffer))))))
(lambda (&rest _rest) (funcall callback (my-repo-pins--fetch-gitea-parse-response(current-buffer))))))
(defun h--fetch-gitea-parse-response (response-buffer)
(defun my-repo-pins--fetch-gitea-parse-response (response-buffer)
"Parse the RESPONSE-BUFFER containing a GET response from the Gitea API.
Parsing a response from a GET https://instance/api/v1/repos/user/repo request.
@ -345,7 +345,7 @@ Returns nil if the repo does not exists."
;; Internal: repo URI parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun h--parse-repo-identifier (query-str)
(defun my-repo-pins--parse-repo-identifier (query-str)
"Do its best to figure out which repo the user meant by QUERY-STR.
A valid QUERY-STR is in one of the 4 following formats:
@ -368,9 +368,9 @@ each kind of format, it'll return something along the line of:
\"https://full-url.org/path/to/git/repo/checkout\"))
or
\(('tag . 'owner-repo) ('owner . \"NinjaTrappeur\") ('repo\
. \"h.el\"))
. \"my-repo-pins.el\"))
or
\(('tag . 'repo) ('repo . \"h.el\"))"
\(('tag . 'repo) ('repo . \"my-repo-pins.el\"))"
(cond
;; Full-url case
((or (string-match "^https?://.*/.*/.*$" query-str)
@ -386,7 +386,7 @@ or
;; repo case
(t `((tag . repo) (repo . ,query-str)))))
(defun h--filepath-from-clone-url (clone-url)
(defun my-repo-pins--filepath-from-clone-url (clone-url)
"Return the relative path relative to the coderoot for CLONE-URL.
CLONE-STR being the git clone URL we want to find the local path for."
@ -409,29 +409,30 @@ CLONE-STR being the git clone URL we want to find the local path for."
;; Internal: code-root management functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom h-code-root nil
(defcustom my-repo-pins-code-root nil
"Root directory containing all your projects.
h.el organise the git repos you'll checkout in a tree fashion.
my-repo-pins.el organise the git repos you'll checkout in a tree
fashion.
All the code fetched using h.el will end up in this root directory. A
All the code fetched using my-repo-pins.el will end up in this root directory. A
tree of subdirectories will be created mirroring the remote URI.
For instance, after checking out
https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code
will live in the h-code-root/git.savannah.gnu.org/git/emacs/org-mode/
will live in the my-repo-pins-code-root/git.savannah.gnu.org/git/emacs/org-mode/
local directory"
:type 'directory
:group 'h-group)
:group 'my-repo-pins-group)
(defun h--safe-get-code-root ()
"Ensure ‘h-code-root’ is correctly set, then canonalize the path.
Errors out if ‘h-code-root’ has not been set yet."
(progn (when (not h-code-root)
(error "h-code-root has not been set. Please point it to your code root"))
(expand-file-name (file-name-as-directory h-code-root))))
(defun my-repo-pins--safe-get-code-root ()
"Ensure ‘my-repo-pins-code-root’ is correctly set, then canonalize the path.
Errors out if ‘my-repo-pins-code-root’ has not been set yet."
(progn (when (not my-repo-pins-code-root)
(error "My-Repo-Pins-code-root has not been set. Please point it to your code root"))
(expand-file-name (file-name-as-directory my-repo-pins-code-root))))
(defun h--find-git-dirs-recursively (dir)
(defun my-repo-pins--find-git-dirs-recursively (dir)
"Vendored, slightly modified version of ‘directory-files-recursively’.
This library isn't available for Emacs > 25.1. Vendoring it for
@ -464,21 +465,22 @@ included."
;; It's not a git repo, let's recurse into it.
(setq recur-result
(nconc recur-result
(h--find-git-dirs-recursively full-file)))))))))
(my-repo-pins--find-git-dirs-recursively full-file)))))))))
(nconc recur-result (nreverse projects))))
(defun h--get-code-root-projects (code-root)
(defun my-repo-pins--get-code-root-projects (code-root)
"Retrieve the projects contained in the CODE-ROOT directory.
We're going to make some hard assumptions about how the ‘h-code-root’
directory should look like. First of all, if a directory seem to be a
git repository, it'll automatically be considered as a project root.
We're going to make some hard assumptions about how the
‘my-repo-pins-code-root’ directory should look like. First of all, if
a directory seem to be a git repository, it'll automatically be
considered as a project root.
It means that after encountering a git repository, we won't recurse
any further.
If the directory pointed by ‘h-code-root’ does not exists yet, returns
an empty list."
If the directory pointed by ‘my-repo-pins-code-root’ does not exists
yet, returns an empty list."
(if (not (file-directory-p code-root))
'()
(let*
@ -486,7 +488,7 @@ an empty list."
(lambda (path)
(let ((path-without-prefix (string-remove-prefix code-root path)))
(substring path-without-prefix 0 (1- (length path-without-prefix))))))
(projects-absolute-path (h--find-git-dirs-recursively code-root))
(projects-absolute-path (my-repo-pins--find-git-dirs-recursively code-root))
(projects-relative-to-code-root
(mapcar remove-code-root-prefix-and-trailing-slash projects-absolute-path)))
projects-relative-to-code-root)))
@ -495,7 +497,7 @@ an empty list."
;; Internal: UI
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun h--evil-safe-binding (kbd action)
(defun my-repo-pins--evil-safe-binding (kbd action)
"Bind ACTION to the KBD keyboard key.
This key binding will be bound to the current buffer. If ‘evil-mode’
@ -520,7 +522,7 @@ is used, the key binding will be bound to the normal mode as well."
(eval `(evil-local-set-key 'normal ,kbd ',action))))
(local-set-key kbd action))))
(defun h--draw-ui-buffer (forge-query-status user-query)
(defun my-repo-pins--draw-ui-buffer (forge-query-status user-query)
"Draws the UI depending on the app state.
FORGE-QUERY-STATUS being a alist in the form of (FORGE-NAME . LOOKUP-STATUS)
@ -534,34 +536,34 @@ to clone for.
We're going to draw these forge query status results in a buffer and
associate each of them with a key binding.
, ‘h--draw-forge-status’ is in charge of
drawing the forge status in the h.el buffer."
, ‘my-repo-pins--draw-forge-status’ is in charge of
drawing the forge status in the my-repo-pins.el buffer."
(let* (
(h-buffer (get-buffer-create "h.el"))
(h-window nil)
(my-repo-pins-buffer (get-buffer-create "my-repo-pins.el"))
(my-repo-pins-window nil)
(previous-buffer (current-buffer))
(forge-status-with-keys (h--add-keys-to-forge-status forge-query-status)))
(forge-status-with-keys (my-repo-pins--add-keys-to-forge-status forge-query-status)))
(progn
(set-buffer h-buffer)
(set-buffer my-repo-pins-buffer)
(setq buffer-read-only nil)
(erase-buffer)
(insert (format "Looking up for %s in different forges:\n\n\n" user-query))
(set-text-properties 1 (point) `(face (:foreground "orange" :weight bold)))
(seq-map
(lambda (e) (h--draw-forge-status e)) forge-status-with-keys)
(lambda (e) (my-repo-pins--draw-forge-status e)) forge-status-with-keys)
(insert "\n\nPlease select the forge we should clone the project from.\n")
(insert "Press q to close this window.")
(setq buffer-read-only t)
(h--evil-safe-binding (kbd "q")
(my-repo-pins--evil-safe-binding (kbd "q")
`(lambda () (interactive)
(progn
(delete-window)
(kill-buffer ,h-buffer))))
(kill-buffer ,my-repo-pins-buffer))))
(set-buffer previous-buffer)
(setq h-window (display-buffer h-buffer))
(select-window h-window))))
(setq my-repo-pins-window (display-buffer my-repo-pins-buffer))
(select-window my-repo-pins-window))))
(defun h--add-keys-to-forge-status (forge-query-status)
(defun my-repo-pins--add-keys-to-forge-status (forge-query-status)
"Add key bindings to relevant FORGE-QUERY-STATUS entries.
FORGE-QUERY-STATUS is list of alists in the form of ((FORGE-NAME .
@ -570,7 +572,7 @@ lookup results or the 'not-found atom when no results could be found.
This function adds a key binding alist to the LOOKUP-STATUS list when
results have been found, nothing if the repo couldn't be found.
‘h--find-next-available-key-binding’ is in charge of generating the
‘my-repo-pins--find-next-available-key-binding’ is in charge of generating the
key bindings."
(reverse
(cdr
@ -583,7 +585,7 @@ key bindings."
(key (car acc))
(isFound (listp status))
(nextKeybinding
(if isFound (h--find-next-available-key-binding (car acc)) (car acc)))
(if isFound (my-repo-pins--find-next-available-key-binding (car acc)) (car acc)))
(forge-status-with-key
(if isFound
`((status . ,status)
@ -595,7 +597,7 @@ key bindings."
forge-query-status
:initial-value '(?1 . ())))))
(defun h--draw-forge-status (forge-result)
(defun my-repo-pins--draw-forge-status (forge-result)
"Draws FORGE-RESULT status to the current buffer.
FORGE-STATUS being a alist in the form of (FORGE-NAME . LOOKUP-STATUS).
@ -611,7 +613,7 @@ https-checkout-url)) ('key . \"1\"))."
((eq status 'loading) (format "[?] %s (loading...)" forge-name))
((eq status 'not-found) (format "[X] %s" forge-name))
((listp status) (format "[✓] %s" forge-name))
(t (error (format "h--draw-forge-status: Invalid forge status %s" status)))))
(t (error (format "my-repo-pins--draw-forge-status: Invalid forge status %s" status)))))
(text (if (null key)
(format "%s\n" status-text)
(format "%s [%s]\n" status-text (char-to-string key))))
@ -619,18 +621,18 @@ https-checkout-url)) ('key . \"1\"))."
((eq status 'loading) "orange")
((eq status 'not-found) "red")
((listp status) "green")
(t (error (format "h--draw-forge-status: Invalid forge status %s" status)))))
(h-buffer (current-buffer))
(t (error (format "my-repo-pins--draw-forge-status: Invalid forge status %s" status)))))
(my-repo-pins-buffer (current-buffer))
(original-point (point)))
(progn
(if (not (null key))
(h--evil-safe-binding (kbd (format "%s" (char-to-string key)))
(my-repo-pins--evil-safe-binding (kbd (format "%s" (char-to-string key)))
`(lambda ()
(interactive)
(progn
(delete-window)
(kill-buffer ,h-buffer)
(h--clone-from-forge-result ',forge-result)))))
(kill-buffer ,my-repo-pins-buffer)
(my-repo-pins--clone-from-forge-result ',forge-result)))))
(insert text)
;; Set color for status indicator
(set-text-properties original-point
@ -641,8 +643,8 @@ https-checkout-url)) ('key . \"1\"))."
(set-text-properties (- (point) 4) (point)
'(face (:foreground "orange" :weight bold)))))))
(defun h--find-next-available-key-binding (cur-key-binding)
"Find a key binding starting CUR-KEY-BINDING for the h buffer.
(defun my-repo-pins--find-next-available-key-binding (cur-key-binding)
"Find a key binding starting CUR-KEY-BINDING for the my-repo-pins buffer.
We're using the 1-9 numbers, then, once all the numbers are already in
use, we start allocating the a-Z letters."
@ -650,7 +652,7 @@ use, we start allocating the a-Z letters."
((= cur-key-binding ?z) (error "Keys exhausted, can't bind any more"))
(t (+ cur-key-binding 1))))
(defun h--clone-from-forge-result (forge-result)
(defun my-repo-pins--clone-from-forge-result (forge-result)
"Clone a repository using the FORGE-RESULT alist.
The FORGE-RESULT alist is in the form of (status . (https .
@ -663,14 +665,14 @@ url."
((forge-result-status (alist-get 'status (cdr forge-result)))
(ssh-url (alist-get 'ssh forge-result-status))
(http-url (alist-get 'https forge-result-status))
(code-root (h--safe-get-code-root))
(dest-dir (concat code-root (h--filepath-from-clone-url http-url))))
(code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url http-url))))
(progn
(message (format "Cloning %s to %s" ssh-url dest-dir))
(cl-flet*
((clone-http
()
(h--git-clone-in-dir
(my-repo-pins--git-clone-in-dir
http-url
dest-dir
(lambda (exit-code)
@ -681,7 +683,7 @@ url."
(find-file dest-dir))))))
(clone-ssh
()
(h--git-clone-in-dir
(my-repo-pins--git-clone-in-dir
ssh-url
dest-dir
(lambda (exit-code)
@ -700,7 +702,7 @@ url."
;; Internal: improving builtin autocomplete
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun h--completing-read-or-custom (prompt collection)
(defun my-repo-pins--completing-read-or-custom (prompt collection)
"Behaves similarly to ‘complete-read’.
See the ‘complete-read’ documentation for more details about PROMPT
@ -721,31 +723,31 @@ READ-RESULT)"
;; Internal: Internal state management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun h--init-forges-state (forge-fetchers)
"Initialize ‘h--forge-fetchers-state’.
(defun my-repo-pins--init-forges-state (forge-fetchers)
"Initialize ‘my-repo-pins--forge-fetchers-state’.
We iterate through the forges set in FORGE-FETCHERS and associate
each of them with a pending status. We then return this new state
alist."
(seq-map (lambda (e) `(,(car e) . loading)) forge-fetchers))
(defun h--update-forges-state (forge-name new-state user-query)
"Update ‘h--forge-fetchers-state’ for FORGE-NAME with NEW-STATE.
(defun my-repo-pins--update-forges-state (forge-name new-state user-query)
"Update ‘my-repo-pins--forge-fetchers-state’ for FORGE-NAME with NEW-STATE.
USER-QUERY was the original query for this state update."
(progn
(mutex-lock h--forge-fetchers-state-mutex)
(setq h--forge-fetchers-state (assq-delete-all forge-name h--forge-fetchers-state))
(setq h--forge-fetchers-state (cons `(,forge-name . ,new-state) h--forge-fetchers-state))
(h--draw-ui-buffer h--forge-fetchers-state user-query)
(mutex-unlock h--forge-fetchers-state-mutex)))
(mutex-lock my-repo-pins--forge-fetchers-state-mutex)
(setq my-repo-pins--forge-fetchers-state (assq-delete-all forge-name my-repo-pins--forge-fetchers-state))
(setq my-repo-pins--forge-fetchers-state (cons `(,forge-name . ,new-state) my-repo-pins--forge-fetchers-state))
(my-repo-pins--draw-ui-buffer my-repo-pins--forge-fetchers-state user-query)
(mutex-unlock my-repo-pins--forge-fetchers-state-mutex)))
(defun h--query-forge-fetchers (repo-query)
(defun my-repo-pins--query-forge-fetchers (repo-query)
"Find repo matches to the relevant forges for REPO-QUERY then query forge.
TODO: split that mess before release. We shouldn't query here."
(let* ((parsed-repo-query (h--parse-repo-identifier repo-query))
(let* ((parsed-repo-query (my-repo-pins--parse-repo-identifier repo-query))
(repo-query-kind (alist-get 'tag parsed-repo-query)))
(cond
((equal repo-query-kind 'owner-repo)
@ -762,15 +764,15 @@ TODO: split that mess before release. We shouldn't query here."
(let ((new-state
(if (null result) 'not-found result)))
(progn
(h--update-forges-state ,forge-str new-state ,repo-query))))))))
h-forge-fetchers))
(my-repo-pins--update-forges-state ,forge-str new-state ,repo-query))))))))
my-repo-pins-forge-fetchers))
((equal repo-query-kind 'repo) (error (format "Can't checkout %s (for now), please specify a owner" repo-query)))
((equal repo-query-kind 'full-url)
(let*
((code-root (h--safe-get-code-root))
(dest-dir (concat code-root (h--filepath-from-clone-url repo-query))))
((code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url repo-query))))
(progn
(h--git-clone-in-dir
(my-repo-pins--git-clone-in-dir
repo-query
dest-dir
(lambda (exit-code)
@ -783,31 +785,29 @@ TODO: split that mess before release. We shouldn't query here."
;; Interactive Commands
;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun h-clone-project (user-query)
"Clone USER-QUERY in its appropriate directory in ‘h-code-root’."
(interactive "sGit repository to checkout: ")
(defun my-repo-pins--clone-project (user-query)
"Clone USER-QUERY in its appropriate directory in ‘my-repo-pins-code-root’."
(progn
(setq h--forge-fetchers-state (h--init-forges-state h-forge-fetchers))
(h--query-forge-fetchers user-query)))
(setq my-repo-pins--forge-fetchers-state (my-repo-pins--init-forges-state my-repo-pins-forge-fetchers))
(my-repo-pins--query-forge-fetchers user-query)))
;;;###autoload
(defun h-jump-to-project ()
"Open a project contained in the ‘h-code-root’ directory.
If the project is not in the ‘h-code-root’ yet, check it out from the
(defun my-repo-pins ()
"Open a project contained in the ‘my-repo-pins-code-root’ directory.
If the project is not in the ‘my-repo-pins-code-root’ yet, check it out from the
available forge sources."
(interactive)
(let ((user-query
(h--completing-read-or-custom
(my-repo-pins--completing-read-or-custom
"Jump to project: "
(h--get-code-root-projects (h--safe-get-code-root)))))
(my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root)))))
(cond
((equal (car user-query) 'in-collection)
(let ((selected-project-absolute-path (concat (h--safe-get-code-root) (cdr user-query))))
(let ((selected-project-absolute-path (concat (my-repo-pins--safe-get-code-root) (cdr user-query))))
(find-file selected-project-absolute-path)))
((equal (car user-query) 'user-provided)
(h-clone-project (cdr user-query))))))
(my-repo-pins--clone-project (cdr user-query))))))
(provide 'h)
;;; h.el ends here
(provide 'my-repo-pins)
;;; my-repo-pins.el ends here

2
tests/fixtures/gitea-get-request-ok.txt vendored
View File

@ -8,4 +8,4 @@ Set-Cookie: _csrf=000000000000000000000000000000000000000000000000000000; Path=/
X-Content-Type-Options: nosniff
X-Frame-Options: SAMEORIGIN
{"id":28,"owner":{"id":1,"login":"NinjaTrappeur","full_name":"","email":"felix@alternativebit.fr","avatar_url":"https://git.alternativebit.fr/avatars/326105984221f71c9e555addc514dae6","language":"","is_admin":false,"last_login":"0001-01-01T00:00:00Z","created":"2018-04-10T16:10:10+02:00","restricted":false,"active":false,"prohibit_login":false,"location":"","website":"","description":"","visibility":"public","followers_count":0,"following_count":0,"starred_repos_count":0,"username":"NinjaTrappeur"},"name":"h.el","full_name":"NinjaTrappeur/h.el","description":"","empty":false,"private":false,"fork":false,"template":false,"parent":null,"mirror":false,"size":107,"html_url":"https://git.alternativebit.fr/NinjaTrappeur/h.el","ssh_url":"gitea@git.alternativebit.fr:NinjaTrappeur/h.el.git","clone_url":"https://git.alternativebit.fr/NinjaTrappeur/h.el.git","original_url":"","website":"","stars_count":0,"forks_count":0,"watchers_count":1,"open_issues_count":0,"open_pr_counter":0,"release_counter":0,"default_branch":"master","archived":false,"created_at":"2020-10-25T15:53:38+01:00","updated_at":"2022-06-16T18:43:05+02:00","permissions":{"admin":false,"push":false,"pull":true},"has_issues":true,"internal_tracker":{"enable_time_tracker":true,"allow_only_contributors_to_track_time":true,"enable_issue_dependencies":true},"has_wiki":true,"has_pull_requests":true,"has_projects":false,"ignore_whitespace_conflicts":false,"allow_merge_commits":true,"allow_rebase":true,"allow_rebase_explicit":true,"allow_squash_merge":true,"default_merge_style":"merge","avatar_url":"","internal":false,"mirror_interval":"","mirror_updated":"0001-01-01T00:00:00Z","repo_transfer":null}
{"id":28,"owner":{"id":1,"login":"NinjaTrappeur","full_name":"","email":"felix@alternativebit.fr","avatar_url":"https://git.alternativebit.fr/avatars/326105984221f71c9e555addc514dae6","language":"","is_admin":false,"last_login":"0001-01-01T00:00:00Z","created":"2018-04-10T16:10:10+02:00","restricted":false,"active":false,"prohibit_login":false,"location":"","website":"","description":"","visibility":"public","followers_count":0,"following_count":0,"starred_repos_count":0,"username":"NinjaTrappeur"},"name":"my-repo-pins.el","full_name":"NinjaTrappeur/my-repo-pins.el","description":"","empty":false,"private":false,"fork":false,"template":false,"parent":null,"mirror":false,"size":107,"html_url":"https://git.alternativebit.fr/NinjaTrappeur/my-repo-pins.el","ssh_url":"gitea@git.alternativebit.fr:NinjaTrappeur/my-repo-pins.el.git","clone_url":"https://git.alternativebit.fr/NinjaTrappeur/my-repo-pins.el.git","original_url":"","website":"","stars_count":0,"forks_count":0,"watchers_count":1,"open_issues_count":0,"open_pr_counter":0,"release_counter":0,"default_branch":"master","archived":false,"created_at":"2020-10-25T15:53:38+01:00","updated_at":"2022-06-16T18:43:05+02:00","permissions":{"admin":false,"push":false,"pull":true},"has_issues":true,"internal_tracker":{"enable_time_tracker":true,"allow_only_contributors_to_track_time":true,"enable_issue_dependencies":true},"has_wiki":true,"has_pull_requests":true,"has_projects":false,"ignore_whitespace_conflicts":false,"allow_merge_commits":true,"allow_rebase":true,"allow_rebase_explicit":true,"allow_squash_merge":true,"default_merge_style":"merge","avatar_url":"","internal":false,"mirror_interval":"","mirror_updated":"0001-01-01T00:00:00Z","repo_transfer":null}

2
tests/fixtures/github-get-request-ok.txt vendored
View File

File diff suppressed because one or more lines are too long