picnoir/my-repo-pins
1
0
Fork 0
mirror of https://github.com/NinjaTrappeur/my-repo-pins.git synced 2024-06-16 18:41:57 +02:00
Code Issues Projects Releases Wiki Activity

Rename the project

Browse source 
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 all: compile test package-lint clean-elc
test: 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: 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 compile: clean-elc
${EMACS} -Q --eval ${INIT_PACKAGES} -L . --batch -f batch-byte-compile *.el ${EMACS} -Q --eval ${INIT_PACKAGES} -L . --batch -f batch-byte-compile *.el
clean-elc: clean:
rm -f f.elc rm -f f.elc
.PHONY: all compile clean-elc package-lint test .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. 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     │   └── mpv
    └── NinjaTrappeur     └── NinjaTrappeur
        ├── cinny         ├── 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. 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:** **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:** **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:** **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) ![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)
This plugin is heavily inspired by [**Zimbatm's h**](https://github.com/zimbatm/h).
## Quick Start ## 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: 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 ```elisp
(require 'h) (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: 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 ```elisp
(global-set-key (kbd "M-h") 'h-jump-to-project) (global-set-key (kbd "M-h") 'my-repo-pins)
``` ```
## Customization ## 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`. 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. 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 ## 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 ### 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: You can re-use these generic fetchers for your own forge instance using the following functions:
- GitLab: `h--query-gitlab-owner-repo` - GitLab: `my-repo-pins--query-gitlab-owner-repo`
- SourceHut: `h--query-sourcehut-owner-repo` - SourceHut: `my-repo-pins--query-sourcehut-owner-repo`
- Gitea: `h--query-gitea-owner-repo` - Gitea: `my-repo-pins--query-gitea-owner-repo`
These functions share the same 4 input arguments: 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`, … - `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. - `user-name`: the user name for which we want to clone the repository.
- `repo-name`: name of the repository we want to clone. - `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: 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 ```elisp
(setq h-forge-fetchers (setq my-repo-pins-forge-fetchers
`(("gitlab.gnome.org" (lambda (owner repo cb)(h--query-gitlab-owner-repo "gitlab.gnome.org" owner repo cb))) `(("gitlab.gnome.org" (lambda (owner repo cb)(my-repo-pins--query-gitlab-owner-repo "gitlab.gnome.org" owner repo cb)))
,h-forge-fetchers)) ,my-repo-pins-forge-fetchers))
``` ```
### Writing your Forge Fetcher from Scratch ### 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 ```elisp
(defun your-custom-fetcher (owner repo) (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: 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. - `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. `h.el` for the `ninjatrappeur/h.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: 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) '((ssh . SSH-CHECKOUT-URL)
(https . HTTPS-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é ;;; Copyright (C) 2022 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr> ;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr> ;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 0.1 ;;; Version: 0.1
;;; Homepage: https://github.com/NinjaTrappeur/h.el ;;; Homepage: https://github.com/NinjaTrappeur/my-repo-pins.el
;;; Package-Requires: ((emacs "26.1")) ;;; Package-Requires: ((emacs "26.1"))
;;; License: ;;; License:
;;; ;;;
@ -41,10 +41,10 @@
;;; │ └── mpv ;;; │ └── mpv
;;; └── NinjaTrappeur ;;; └── NinjaTrappeur
;;; ├── cinny ;;; ├── cinny
;;; └── h.el ;;; └── my-repo-pins.el
;;; ;;;
;;; The main entry point of this package is the h-jump-to-project ;;; The main entry point of this package is the my-repo-pins command.
;;; command. Using it, you can either: ;;; Using it, you can either:
;;; ;;;
;;; - Open dired in a local project you already cloned. ;;; - Open dired in a local project you already cloned.
;;; - Query remote forges for a repository, clone it, and finally open ;;; - Query remote forges for a repository, clone it, and finally open
@ -53,16 +53,16 @@
;;; ;;;
;;; The minimal configuration consists in setting the directory in ;;; The minimal configuration consists in setting the directory in
;;; which you want to clone all your git repositories via the ;;; 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 ;;; 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 ;;; ~/code-root directory. You'll want to add the following snippet in
;;; your Emacs configuration file: ;;; your Emacs configuration file:
;;; ;;;
;;; (require 'h) ;;; (require 'my-repo-pins)
;;; (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 ;;; 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 living in your ~/code-root directory or clone a new
;;; project in your code root. ;;; project in your code root.
;;; ;;;
@ -71,7 +71,7 @@
;;; add the following snippet to your Emacs configuration to set up ;;; add the following snippet to your Emacs configuration to set up
;;; this key binding: ;;; this key binding:
;;; ;;;
;;; (global-set-key (kbd "M-h") 'h-jump-to-project) ;;; (global-set-key (kbd "M-h") 'my-repo-pins)
;;; Code: ;;; Code:
@ -82,40 +82,40 @@
;; loaded by default in interactive emacs, not in batch-mode emacs. ;; loaded by default in interactive emacs, not in batch-mode emacs.
(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'subr-x))
(defgroup h-group nil (defgroup my-repo-pins-group nil
"Variables used to setup the h.el project manager." "Variables used to setup the my-repo-pins.el project manager."
:group 'Communication) :group 'Communication)
;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal: git primitives ;; Internal: git primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom h-git-bin "git" (defcustom my-repo-pins-git-bin "git"
"Path pointing to the git binary. "Path pointing to the git binary.
By default, it'll look for git in the current $PATH." By default, it'll look for git in the current $PATH."
:type 'file :type 'file
:group 'h-group) :group 'my-repo-pins-group)
(defun h--git-path () (defun my-repo-pins--git-path ()
"Find the git binary path using ‘h-git-bin’. "Find the git binary path using ‘my-repo-pins-git-bin’.
Errors out if we can't find it." Errors out if we can't find it."
(if (file-executable-p h-git-bin) (if (file-executable-p my-repo-pins-git-bin)
h-git-bin my-repo-pins-git-bin
(let ((git-from-bin-path (locate-file h-git-bin exec-path))) (let ((git-from-bin-path (locate-file my-repo-pins-git-bin exec-path)))
(if (file-executable-p git-from-bin-path) (if (file-executable-p git-from-bin-path)
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) (defun my-repo-pins--call-git-in-dir (dir &optional callback &rest args)
"Call the git binary as pointed by ‘h-git-bin’ in DIR with 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 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 code as single argument. If CALLBACK is set to nil, don't call any
callback. callback.
Returns the git PROCESS object." 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) (git-window nil)
(current-buffer (current-buffer)) (current-buffer (current-buffer))
(git-sentinel (lambda (git-sentinel (lambda
@ -133,49 +133,49 @@ Returns the git PROCESS object."
(setq git-window (display-buffer git-buffer)) (setq git-window (display-buffer git-buffer))
(prog1 (prog1
(make-process (make-process
:name "h-git-subprocess" :name "my-repo-pins-git-subprocess"
:buffer git-buffer :buffer git-buffer
:command (seq-concatenate 'list `(,(h--git-path)) args) :command (seq-concatenate 'list `(,(my-repo-pins--git-path)) args)
:sentinel git-sentinel) :sentinel git-sentinel)
(set-buffer current-buffer))))) (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. "Clone the CLONE-URL repo at CHECKOUT-FILEPATH.
Call CALLBACK with no arguments once the git subprocess exists." 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 ;; Internal: builtin fetchers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generic fetcher infrastructure ;;; Generic fetcher infrastructure
(defvar h--builtins-forge-fetchers (defvar my-repo-pins--builtins-forge-fetchers
'(("GitHub.com" . '(("GitHub.com" .
((query-user-repo . h--query-github-owner-repo))) ((query-user-repo . my-repo-pins--query-github-owner-repo)))
("GitLab.com" . ("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" . ("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" . ("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: This variable contains fetchers for:
- github.com") - github.com")
(defcustom h-forge-fetchers (defcustom my-repo-pins-forge-fetchers
h--builtins-forge-fetchers my-repo-pins--builtins-forge-fetchers
"List of forges for which we want to remote fetch projects." "List of forges for which we want to remote fetch projects."
:type '(alist :type '(alist
:key-type symbol :key-type symbol
:value-type (alist :value-type (alist
:key-type symbol :key-type symbol
:value-type (choice function string))) :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. "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\" . 'loading)
\(\"FORGE-NAME1\" . 'not-found)") \(\"FORGE-NAME1\" . 'not-found)")
(defvar h--forge-fetchers-state-mutex (defvar my-repo-pins--forge-fetchers-state-mutex
(make-mutex "h-ui-mutex") (make-mutex "my-repo-pins-ui-mutex")
"Mutex in charge of preventing several fetchers to update the state concurently.") "Mutex in charge of preventing several fetchers to update the state concurently.")
;;; Sourcehut Fetcher ;;; 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. "Query the INSTANCE-URL Sourcehut instance and retrieve some infos about a repo.
This function will try to determine whether or not the 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))) (setq url-request-method nil)))
;;; Gitlab Fetcher ;;; 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. "Queries the INSTANCE-URL Gitlab instance and retrieve some infos about a repo.
This function will try to determine whether or not the 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))) (setq url-request-method nil)))
;;; Github Fetcher ;;; 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. "Queries the GitHub API to retrieve some infos about a GitHub repo.
This function will first try to determine whether This function will first try to determine whether
github.com/USER-NAME/REPO-NAME exists. github.com/USER-NAME/REPO-NAME exists.
@ -271,10 +271,10 @@ nil as parameter."
(progn (progn
(url-retrieve (url-retrieve
(format "https://api.github.com/repos/%s/%s" user-name repo-name) (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. "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. 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))) nil)))
;;; Gitea Fetcher ;;; 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. "Queries the INSTANCE-URL gitea instance to retrieve a repo informations.
This function will first try to dertermine whether the This function will first try to dertermine whether the
USER-NAME/REPO-NAME exists. 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." nil as parameter."
(url-retrieve (url-retrieve
(format "https://%s/api/v1/repos/%s/%s" instance-url user-name repo-name) (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. "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. 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 ;; 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. "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: 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\")) \"https://full-url.org/path/to/git/repo/checkout\"))
or or
\(('tag . 'owner-repo) ('owner . \"NinjaTrappeur\") ('repo\ \(('tag . 'owner-repo) ('owner . \"NinjaTrappeur\") ('repo\
. \"h.el\")) . \"my-repo-pins.el\"))
or or
\(('tag . 'repo) ('repo . \"h.el\"))" \(('tag . 'repo) ('repo . \"my-repo-pins.el\"))"
(cond (cond
;; Full-url case ;; Full-url case
((or (string-match "^https?://.*/.*/.*$" query-str) ((or (string-match "^https?://.*/.*/.*$" query-str)
@ -386,7 +386,7 @@ or
;; repo case ;; repo case
(t `((tag . repo) (repo . ,query-str))))) (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. "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." 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 ;; Internal: code-root management functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom h-code-root nil (defcustom my-repo-pins-code-root nil
"Root directory containing all your projects. "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. tree of subdirectories will be created mirroring the remote URI.
For instance, after checking out For instance, after checking out
https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code 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" local directory"
:type 'directory :type 'directory
:group 'h-group) :group 'my-repo-pins-group)
(defun h--safe-get-code-root () (defun my-repo-pins--safe-get-code-root ()
"Ensure ‘h-code-root’ is correctly set, then canonalize the path. "Ensure ‘my-repo-pins-code-root’ is correctly set, then canonalize the path.
Errors out if ‘h-code-root’ has not been set yet." Errors out if ‘my-repo-pins-code-root’ has not been set yet."
(progn (when (not h-code-root) (progn (when (not my-repo-pins-code-root)
(error "h-code-root has not been set. Please point it to your 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 h-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’. "Vendored, slightly modified version of ‘directory-files-recursively’.
This library isn't available for Emacs > 25.1. Vendoring it for 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. ;; It's not a git repo, let's recurse into it.
(setq recur-result (setq recur-result
(nconc 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)))) (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. "Retrieve the projects contained in the CODE-ROOT directory.
We're going to make some hard assumptions about how the ‘h-code-root’ We're going to make some hard assumptions about how the
directory should look like. First of all, if a directory seem to be a ‘my-repo-pins-code-root’ directory should look like. First of all, if
git repository, it'll automatically be considered as a project root. 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 It means that after encountering a git repository, we won't recurse
any further. any further.
If the directory pointed by ‘h-code-root’ does not exists yet, returns If the directory pointed by ‘my-repo-pins-code-root’ does not exists
an empty list." yet, returns an empty list."
(if (not (file-directory-p code-root)) (if (not (file-directory-p code-root))
'() '()
(let* (let*
@ -486,7 +488,7 @@ an empty list."
(lambda (path) (lambda (path)
(let ((path-without-prefix (string-remove-prefix code-root path))) (let ((path-without-prefix (string-remove-prefix code-root path)))
(substring path-without-prefix 0 (1- (length path-without-prefix)))))) (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 (projects-relative-to-code-root
(mapcar remove-code-root-prefix-and-trailing-slash projects-absolute-path))) (mapcar remove-code-root-prefix-and-trailing-slash projects-absolute-path)))
projects-relative-to-code-root))) projects-relative-to-code-root)))
@ -495,7 +497,7 @@ an empty list."
;; Internal: UI ;; 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. "Bind ACTION to the KBD keyboard key.
This key binding will be bound to the current buffer. If ‘evil-mode’ 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)))) (eval `(evil-local-set-key 'normal ,kbd ',action))))
(local-set-key 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. "Draws the UI depending on the app state.
FORGE-QUERY-STATUS being a alist in the form of (FORGE-NAME . LOOKUP-STATUS) 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 We're going to draw these forge query status results in a buffer and
associate each of them with a key binding. associate each of them with a key binding.
, ‘h--draw-forge-status’ is in charge of , ‘my-repo-pins--draw-forge-status’ is in charge of
drawing the forge status in the h.el buffer." drawing the forge status in the my-repo-pins.el buffer."
(let* ( (let* (
(h-buffer (get-buffer-create "h.el")) (my-repo-pins-buffer (get-buffer-create "my-repo-pins.el"))
(h-window nil) (my-repo-pins-window nil)
(previous-buffer (current-buffer)) (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 (progn
(set-buffer h-buffer) (set-buffer my-repo-pins-buffer)
(setq buffer-read-only nil) (setq buffer-read-only nil)
(erase-buffer) (erase-buffer)
(insert (format "Looking up for %s in different forges:\n\n\n" user-query)) (insert (format "Looking up for %s in different forges:\n\n\n" user-query))
(set-text-properties 1 (point) `(face (:foreground "orange" :weight bold))) (set-text-properties 1 (point) `(face (:foreground "orange" :weight bold)))
(seq-map (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 "\n\nPlease select the forge we should clone the project from.\n")
(insert "Press q to close this window.") (insert "Press q to close this window.")
(setq buffer-read-only t) (setq buffer-read-only t)
(h--evil-safe-binding (kbd "q") (my-repo-pins--evil-safe-binding (kbd "q")
`(lambda () (interactive) `(lambda () (interactive)
(progn (progn
(delete-window) (delete-window)
(kill-buffer ,h-buffer)))) (kill-buffer ,my-repo-pins-buffer))))
(set-buffer previous-buffer) (set-buffer previous-buffer)
(setq h-window (display-buffer h-buffer)) (setq my-repo-pins-window (display-buffer my-repo-pins-buffer))
(select-window h-window)))) (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. "Add key bindings to relevant FORGE-QUERY-STATUS entries.
FORGE-QUERY-STATUS is list of alists in the form of ((FORGE-NAME . 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 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. 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." key bindings."
(reverse (reverse
(cdr (cdr
@ -583,7 +585,7 @@ key bindings."
(key (car acc)) (key (car acc))
(isFound (listp status)) (isFound (listp status))
(nextKeybinding (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 (forge-status-with-key
(if isFound (if isFound
`((status . ,status) `((status . ,status)
@ -595,7 +597,7 @@ key bindings."
forge-query-status forge-query-status
:initial-value '(?1 . ()))))) :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. "Draws FORGE-RESULT status to the current buffer.
FORGE-STATUS being a alist in the form of (FORGE-NAME . LOOKUP-STATUS). 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 'loading) (format "[?] %s (loading...)" forge-name))
((eq status 'not-found) (format "[X] %s" forge-name)) ((eq status 'not-found) (format "[X] %s" forge-name))
((listp status) (format "[✓] %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) (text (if (null key)
(format "%s\n" status-text) (format "%s\n" status-text)
(format "%s [%s]\n" status-text (char-to-string key)))) (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 'loading) "orange")
((eq status 'not-found) "red") ((eq status 'not-found) "red")
((listp status) "green") ((listp status) "green")
(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)))))
(h-buffer (current-buffer)) (my-repo-pins-buffer (current-buffer))
(original-point (point))) (original-point (point)))
(progn (progn
(if (not (null key)) (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 () `(lambda ()
(interactive) (interactive)
(progn (progn
(delete-window) (delete-window)
(kill-buffer ,h-buffer) (kill-buffer ,my-repo-pins-buffer)
(h--clone-from-forge-result ',forge-result))))) (my-repo-pins--clone-from-forge-result ',forge-result)))))
(insert text) (insert text)
;; Set color for status indicator ;; Set color for status indicator
(set-text-properties original-point (set-text-properties original-point
@ -641,8 +643,8 @@ https-checkout-url)) ('key . \"1\"))."
(set-text-properties (- (point) 4) (point) (set-text-properties (- (point) 4) (point)
'(face (:foreground "orange" :weight bold))))))) '(face (:foreground "orange" :weight bold)))))))
(defun h--find-next-available-key-binding (cur-key-binding) (defun my-repo-pins--find-next-available-key-binding (cur-key-binding)
"Find a key binding starting CUR-KEY-BINDING for the h buffer. "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 We're using the 1-9 numbers, then, once all the numbers are already in
use, we start allocating the a-Z letters." 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")) ((= cur-key-binding ?z) (error "Keys exhausted, can't bind any more"))
(t (+ cur-key-binding 1)))) (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. "Clone a repository using the FORGE-RESULT alist.
The FORGE-RESULT alist is in the form of (status . (https . 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))) ((forge-result-status (alist-get 'status (cdr forge-result)))
(ssh-url (alist-get 'ssh forge-result-status)) (ssh-url (alist-get 'ssh forge-result-status))
(http-url (alist-get 'https forge-result-status)) (http-url (alist-get 'https forge-result-status))
(code-root (h--safe-get-code-root)) (code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (h--filepath-from-clone-url http-url)))) (dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url http-url))))
(progn (progn
(message (format "Cloning %s to %s" ssh-url dest-dir)) (message (format "Cloning %s to %s" ssh-url dest-dir))
(cl-flet* (cl-flet*
((clone-http ((clone-http
() ()
(h--git-clone-in-dir (my-repo-pins--git-clone-in-dir
http-url http-url
dest-dir dest-dir
(lambda (exit-code) (lambda (exit-code)
@ -681,7 +683,7 @@ url."
(find-file dest-dir)))))) (find-file dest-dir))))))
(clone-ssh (clone-ssh
() ()
(h--git-clone-in-dir (my-repo-pins--git-clone-in-dir
ssh-url ssh-url
dest-dir dest-dir
(lambda (exit-code) (lambda (exit-code)
@ -700,7 +702,7 @@ url."
;; Internal: improving builtin autocomplete ;; 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’. "Behaves similarly to ‘complete-read’.
See the ‘complete-read’ documentation for more details about PROMPT See the ‘complete-read’ documentation for more details about PROMPT
@ -721,31 +723,31 @@ READ-RESULT)"
;; Internal: Internal state management ;; Internal: Internal state management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun h--init-forges-state (forge-fetchers) (defun my-repo-pins--init-forges-state (forge-fetchers)
"Initialize ‘h--forge-fetchers-state’. "Initialize ‘my-repo-pins--forge-fetchers-state’.
We iterate through the forges set in FORGE-FETCHERS and associate We iterate through the forges set in FORGE-FETCHERS and associate
each of them with a pending status. We then return this new state each of them with a pending status. We then return this new state
alist." alist."
(seq-map (lambda (e) `(,(car e) . loading)) forge-fetchers)) (seq-map (lambda (e) `(,(car e) . loading)) forge-fetchers))
(defun h--update-forges-state (forge-name new-state user-query) (defun my-repo-pins--update-forges-state (forge-name new-state user-query)
"Update ‘h--forge-fetchers-state’ for FORGE-NAME with NEW-STATE. "Update ‘my-repo-pins--forge-fetchers-state’ for FORGE-NAME with NEW-STATE.
USER-QUERY was the original query for this state update." USER-QUERY was the original query for this state update."
(progn (progn
(mutex-lock h--forge-fetchers-state-mutex) (mutex-lock my-repo-pins--forge-fetchers-state-mutex)
(setq h--forge-fetchers-state (assq-delete-all forge-name h--forge-fetchers-state)) (setq my-repo-pins--forge-fetchers-state (assq-delete-all forge-name my-repo-pins--forge-fetchers-state))
(setq h--forge-fetchers-state (cons `(,forge-name . ,new-state) h--forge-fetchers-state)) (setq my-repo-pins--forge-fetchers-state (cons `(,forge-name . ,new-state) my-repo-pins--forge-fetchers-state))
(h--draw-ui-buffer h--forge-fetchers-state user-query) (my-repo-pins--draw-ui-buffer my-repo-pins--forge-fetchers-state user-query)
(mutex-unlock h--forge-fetchers-state-mutex))) (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. "Find repo matches to the relevant forges for REPO-QUERY then query forge.
TODO: split that mess before release. We shouldn't query here." 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))) (repo-query-kind (alist-get 'tag parsed-repo-query)))
(cond (cond
((equal repo-query-kind 'owner-repo) ((equal repo-query-kind 'owner-repo)
@ -762,15 +764,15 @@ TODO: split that mess before release. We shouldn't query here."
(let ((new-state (let ((new-state
(if (null result) 'not-found result))) (if (null result) 'not-found result)))
(progn (progn
(h--update-forges-state ,forge-str new-state ,repo-query)))))))) (my-repo-pins--update-forges-state ,forge-str new-state ,repo-query))))))))
h-forge-fetchers)) 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 'repo) (error (format "Can't checkout %s (for now), please specify a owner" repo-query)))
((equal repo-query-kind 'full-url) ((equal repo-query-kind 'full-url)
(let* (let*
((code-root (h--safe-get-code-root)) ((code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (h--filepath-from-clone-url repo-query)))) (dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url repo-query))))
(progn (progn
(h--git-clone-in-dir (my-repo-pins--git-clone-in-dir
repo-query repo-query
dest-dir dest-dir
(lambda (exit-code) (lambda (exit-code)
@ -783,31 +785,29 @@ TODO: split that mess before release. We shouldn't query here."
;; Interactive Commands ;; Interactive Commands
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload (defun my-repo-pins--clone-project (user-query)
(defun h-clone-project (user-query) "Clone USER-QUERY in its appropriate directory in ‘my-repo-pins-code-root’."
"Clone USER-QUERY in its appropriate directory in ‘h-code-root’."
(interactive "sGit repository to checkout: ")
(progn (progn
(setq h--forge-fetchers-state (h--init-forges-state h-forge-fetchers)) (setq my-repo-pins--forge-fetchers-state (my-repo-pins--init-forges-state my-repo-pins-forge-fetchers))
(h--query-forge-fetchers user-query))) (my-repo-pins--query-forge-fetchers user-query)))
;;;###autoload ;;;###autoload
(defun h-jump-to-project () (defun my-repo-pins ()
"Open a project contained in the ‘h-code-root’ directory. "Open a project contained in the ‘my-repo-pins-code-root’ directory.
If the project is not in the ‘h-code-root’ yet, check it out from the If the project is not in the ‘my-repo-pins-code-root’ yet, check it out from the
available forge sources." available forge sources."
(interactive) (interactive)
(let ((user-query (let ((user-query
(h--completing-read-or-custom (my-repo-pins--completing-read-or-custom
"Jump to project: " "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 (cond
((equal (car user-query) 'in-collection) ((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))) (find-file selected-project-absolute-path)))
((equal (car user-query) 'user-provided) ((equal (car user-query) 'user-provided)
(h-clone-project (cdr user-query)))))) (my-repo-pins--clone-project (cdr user-query))))))
(provide 'h) (provide 'my-repo-pins)
;;; h.el ends here ;;; 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-Content-Type-Options: nosniff
X-Frame-Options: SAMEORIGIN 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