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

Compare commits

base: picnoir:fe7c50f5a1d8b3c7c796868a4fa82bffc00ff9ed
Branches Tags
picnoir:master
picnoir:emacs29
picnoir:0.5
picnoir:0.4
picnoir:0.3
picnoir:0.2
picnoir:0.1
...
compare: picnoir:e6fe3864e244e6db74b668d24857c04472b2d475
Branches Tags
picnoir:emacs29
picnoir:master
picnoir:0.5
picnoir:0.4
picnoir:0.3
picnoir:0.2
picnoir:0.1

2 Commits
fe7c50f5a1 ... e6fe3864e2

Author SHA1 Message Date
Félix Baylac Jacqué e6fe3864e2 Release: 0.5 
Fix the short form cloning regression.
 2023-01-20 12:05:12 +01:00
Félix Baylac Jacqué 47083f9a74 Bugfix 2: do not clone a repository already downloaded 
Second stab at fixing this bug. Except I tool the time to do it in a
non-rushed clean way this time around.

We introduce a properly tested is-clone-url-in-code-root predicate. We
then plug this predicate at the clone call sites instead of wrapping
the interactive command.
 2023-01-20 11:53:30 +01:00
2 changed files with 73 additions and 47 deletions
Show Stats Expand all files Collapse all files

17
my-repo-pins-tests.el
View File

@ -3,7 +3,7 @@
;;; Copyright (C) 2022-2023 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 0.4
;;; Version: 0.5
;;; Packages-Requires: ((ert-async "0.1.2"))
;;; License:
@ -435,6 +435,21 @@ it'll get deleted before the end of the test."
(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-is-repo-cloned-in-code-root ()
"Test the is-repo-cloned-in-code-root function."
(my-repo-pins--tests-run-on-testroot-1
(lambda (code-root)
(progn
(should (equal t (my-repo-pins--is-clone-url-in-code-root "ssh://git@example1.tld:user1/proj1.git" code-root)))
(should (equal t (my-repo-pins--is-clone-url-in-code-root "https://example1.tld/user1/proj1.git" code-root)))
(should (equal t (my-repo-pins--is-clone-url-in-code-root "git@example1.tld:user1/proj1.git" code-root)))
(should (equal nil (my-repo-pins--is-clone-url-in-code-root "git@example1.tld:user1/proj9.git" code-root)))
(should (equal nil (my-repo-pins--is-clone-url-in-code-root "ssh://git@invalid-url.tld:user1/proj1.git" code-root)))
(should (equal nil (my-repo-pins--is-clone-url-in-code-root "https://invalid-url.tld/user1/proj1.git" code-root)))
(should (equal nil (my-repo-pins--is-clone-url-in-code-root "https://invalid-url.tld/user1/proj1.git" code-root)))
(should (equal nil (my-repo-pins--is-clone-url-in-code-root "git@invalid-url.tld:user1/proj1.git" code-root)))))))
;;; State Management tests
(ert-deftest my-repo-pins--test-init-forges-state ()

103
my-repo-pins.el
View File

@ -3,7 +3,7 @@
;;; Copyright (C) 2022-2023 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 0.4
;;; Version: 0.5
;;; Homepage: https://alternativebit.fr/projects/my-repo-pins/
;;; Package-Requires: ((emacs "26.1"))
;;; License:
@ -163,6 +163,18 @@ Returns the git PROCESS object."
:sentinel git-sentinel)
(set-buffer current-buffer))))
(defun my-repo-pins--is-clone-url-in-code-root (clone-url code-root)
"Check if CLONE-URL has been already cloned to the CODE-ROOT.
Return t if that's the case, nil if it's not."
(let ((clone-filepath (my-repo-pins--filepath-from-clone-url clone-url)))
(and
(not (eq nil clone-filepath))
(file-directory-p
(concat code-root
(my-repo-pins--filepath-from-clone-url clone-url))))))
(defun my-repo-pins--git-clone-in-dir (clone-url checkout-filepath &optional callback)
"Clone the CLONE-URL repo at CHECKOUT-FILEPATH.
@ -741,34 +753,37 @@ url."
(http-url (alist-get 'https forge-result-status))
(code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url http-url))))
(message "Cloning %s to %s" ssh-url dest-dir)
(cl-flet*
((clone-http
()
(my-repo-pins--git-clone-in-dir
http-url
dest-dir
(lambda (exit-code)
(if (not (equal exit-code 0))
(error "Cannot clone %s nor %s" ssh-url http-url)
(progn
(message "Successfully cloned %s" dest-dir)
(my-repo-pins--open dest-dir))))))
(clone-ssh
()
(my-repo-pins--git-clone-in-dir
ssh-url
dest-dir
(lambda (exit-code)
(if (not (equal exit-code 0))
(progn
(message "Failed to clone %s" ssh-url)
(message "Trying again with %s" http-url)
(clone-http))
(progn
(message "Successfully cloned %s" dest-dir)
(my-repo-pins--open dest-dir)))))))
(clone-ssh))))
(if (my-repo-pins--is-clone-url-in-code-root http-url code-root)
(my-repo-pins--open dest-dir)
(progn
(message "Cloning %s to %s" ssh-url dest-dir)
(cl-flet*
((clone-http
()
(my-repo-pins--git-clone-in-dir
http-url
dest-dir
(lambda (exit-code)
(if (not (equal exit-code 0))
(error "Cannot clone %s nor %s" ssh-url http-url)
(progn
(message "Successfully cloned %s" dest-dir)
(my-repo-pins--open dest-dir))))))
(clone-ssh
()
(my-repo-pins--git-clone-in-dir
ssh-url
dest-dir
(lambda (exit-code)
(if (not (equal exit-code 0))
(progn
(message "Failed to clone %s" ssh-url)
(message "Trying again with %s" http-url)
(clone-http))
(progn
(message "Successfully cloned %s" dest-dir)
(my-repo-pins--open dest-dir)))))))
(clone-ssh))))))
(defun my-repo-pins--clone-from-full-url (full-url &optional callback)
"Clone a repository from a fully-qualified FULL-URL git URL.
@ -778,17 +793,17 @@ exit-code parameter containing the process exit code."
(let*
((code-root (my-repo-pins--safe-get-code-root))
(dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url full-url))))
(if (not (file-directory-p dest-dir))
(my-repo-pins--git-clone-in-dir
full-url
dest-dir
(lambda (exit-code)
(if callback
(funcall callback exit-code))
(if (equal exit-code 0)
(my-repo-pins--open dest-dir)
(error "Cannot clone %s" full-url))))
(error "%s does not seem to be a valid git repository URL " full-url))))
(if (my-repo-pins--is-clone-url-in-code-root full-url code-root)
(my-repo-pins--open dest-dir)
(my-repo-pins--git-clone-in-dir
full-url
dest-dir
(lambda (exit-code)
(if callback
(funcall callback exit-code))
(if (equal exit-code 0)
(my-repo-pins--open dest-dir)
(error "Cannot clone %s" full-url)))))))
;;=========================================
;; Internal: improving builtin autocomplete
@ -876,17 +891,13 @@ available forge sources."
(let* ((user-query
(my-repo-pins--completing-read-or-custom
"Jump to project: "
(my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root) my-repo-pins-max-depth)))
(query-local-path (concat (my-repo-pins--safe-get-code-root)
(my-repo-pins--filepath-from-clone-url (cdr user-query)))))
(my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root) my-repo-pins-max-depth))))
(cond
((equal (car user-query) 'in-collection)
(let ((selected-project-absolute-path (concat (my-repo-pins--safe-get-code-root) (cdr user-query))))
(my-repo-pins--open selected-project-absolute-path)))
((equal (car user-query) 'user-provided)
(if (file-directory-p query-local-path)
(my-repo-pins--open query-local-path)
(my-repo-pins--clone-project (cdr user-query)))))))
(my-repo-pins--clone-project (cdr user-query))))))
(provide 'my-repo-pins)