Release: 0.5

Fix the short form cloning regression.

my-repo-pins-tests.el

@@ -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 ()

my-repo-pins.el

@@ -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)
+    (if (my-repo-pins--is-clone-url-in-code-root http-url code-root)
-      (cl-flet*
+        (my-repo-pins--open dest-dir)
-          ((clone-http
+      (progn
-            ()
+        (message "Cloning %s to %s" ssh-url dest-dir)
-            (my-repo-pins--git-clone-in-dir
+        (cl-flet*
-                  http-url
+            ((clone-http
-                  dest-dir
+              ()
-                  (lambda (exit-code)
+              (my-repo-pins--git-clone-in-dir
-                    (if (not (equal exit-code 0))
+               http-url
-                         (error "Cannot clone %s nor %s" ssh-url http-url)
+               dest-dir
-                      (progn
+               (lambda (exit-code)
-                        (message "Successfully cloned %s" dest-dir)
+                 (if (not (equal exit-code 0))
-                        (my-repo-pins--open dest-dir))))))
+                     (error "Cannot clone %s nor %s" ssh-url http-url)
-           (clone-ssh
+                   (progn
-            ()
+                     (message "Successfully cloned %s" dest-dir)
-            (my-repo-pins--git-clone-in-dir
+                     (my-repo-pins--open dest-dir))))))
-                  ssh-url
+             (clone-ssh
-                  dest-dir
+              ()
-                  (lambda (exit-code)
+              (my-repo-pins--git-clone-in-dir
-                    (if (not (equal exit-code 0))
+               ssh-url
-                         (progn
+               dest-dir
-                           (message "Failed to clone %s" ssh-url)
+               (lambda (exit-code)
-                           (message "Trying again with %s" http-url)
+                 (if (not (equal exit-code 0))
-                           (clone-http))
+                     (progn
-                      (progn
+                       (message "Failed to clone %s" ssh-url)
-                        (message "Successfully cloned %s" dest-dir)
+                       (message "Trying again with %s" http-url)
-                        (my-repo-pins--open dest-dir)))))))
+                       (clone-http))
-        (clone-ssh))))
+                   (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))
+    (if (my-repo-pins--is-clone-url-in-code-root full-url code-root)
-        (my-repo-pins--git-clone-in-dir
+        (my-repo-pins--open dest-dir)
-         full-url
+      (my-repo-pins--git-clone-in-dir
-         dest-dir
+       full-url
-         (lambda (exit-code)
+       dest-dir
-           (if callback
+       (lambda (exit-code)
-               (funcall callback exit-code))
+         (if callback
-           (if (equal exit-code 0)
+             (funcall callback exit-code))
-               (my-repo-pins--open dest-dir)
+         (if (equal exit-code 0)
-             (error "Cannot clone %s" full-url))))
+             (my-repo-pins--open dest-dir)
-      (error "%s does not seem to be a valid git repository URL " full-url))))
+           (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)))
+           (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)))))
     (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--clone-project (cdr user-query))))))
-          (my-repo-pins--open query-local-path)
-        (my-repo-pins--clone-project (cdr user-query)))))))
 
 
 (provide 'my-repo-pins)