Allow a name to be used to remove a repository

Allow users to specify a name instead of a path to remove a repository
from the repository list. Paths may also still be used.

4 files changed, 76 insertions, 10 deletions

diff --git a/doc/gitto.texi b/doc/gitto.texi
index f99ae82..0469a09 100644
--- a/doc/gitto.texi
+++ b/doc/gitto.texi
@@ -197,6 +197,15 @@ for example if you have given up on a project, you can use the
 Remove @var{location} from the list of registered repositories. This
 first checks to see whether or not this repository has even been
 registered.
+
+@var{location} may be either an absolute or relative path, or it may
+also be the name of a repository as displayed by @command{list}.
+
+In case a name is specified and there are multiple possibilities a
+list will be presented to you and you may choose which of the
+repositories to remove based on the locations of each repository. The
+question will be repeated until a valid answer is given (a number
+appearing in the printed list).
 @end deffn
 
 In the event you (re)move some of your repositories and don't have the
diff --git a/gitto/git.scm b/gitto/git.scm
index 3f760e2..fc40077 100644
--- a/gitto/git.scm
+++ b/gitto/git.scm
@@ -40,6 +40,7 @@
             repository-location<?
             repository-location-exists?
             repository-name<?
+            repository-name=?
             same-repository?))
 
 (define show-unchanged-branches? #f)
@@ -74,6 +75,10 @@
   "Compare REPO1 and REPO2 to see if REPO1 should be considered less."
   (string<? (repo-name repo1) (repo-name repo2)))
 
+(define (repository-name=? repo name)
+  "Company the name of REPO1 to NAME and determine equality."
+  (string= (repo-name repo) name))
+
 (define-method (branch-pullable (branch <branch>))
   (force (slot-ref branch 'pullable)))
 
diff --git a/gitto/main.scm b/gitto/main.scm
index 3a2a5b7..8b0d101 100644
--- a/gitto/main.scm
+++ b/gitto/main.scm
@@ -87,12 +87,35 @@
                             (repo-location repo)))
               repositories same-repository?)))
 
+(define (remove-one-repository repos)
+  "Remove one repository from those in REPOS.
+
+In case REPOS only contains one repository, remove it. Otherwise ask
+the user to choose one and remove the chosen repository."
+  (if (> (length repos) 1)
+      (let* ((prompt
+              "Which of the following repositories would you like to remove?")
+             (location (repo-location (choose repos prompt repo-location))))
+        (when location (remove-repository-by-location location)))
+      (remove-repository-by-location (repo-location (car repos)))))
+
 (define (remove-repository repository)
   "Remove REPOSITORY from the list of known repositories."
   (set! repositories
         (delete repository repositories same-repository?))
   (save-repositories-list))
 
+(define (remove-repository-by-location location)
+  "Look for a repository in LOCATION and try to remove it."
+  (set! location (canonicalize-filename location))
+
+  (if (known? location)
+      (begin
+        (remove-repository location)
+        (simple-format #t "Repository ~A removed." location))
+      (display "Not a registered repository."))
+  (newline))
+
 (define (save-repositories-list)
   "Save the list of repositories."
   (ensure-directory-exists. (data-dir))
@@ -258,15 +281,19 @@ which no longer point to a git repository."
 
 Removes REPO from the registered repository list. This command will
 fail if REPO does not indicate a git repository of if it hasn't been
-registered."
-  (set! repository (canonicalize-filename repository))
-
-  (if (known? repository)
-      (begin
-        (remove-repository repository)
-        (simple-format #t "Repository ~A removed." repository))
-      (display "Not a registered repository."))
-  (newline))
+registered.
+
+REPO should either be the name of a repository as displayed by the
+`list' command, or should be a absolute or relative path to a
+registered location. In case REPO is just a name and there is more
+than one repository with that name you are given a choice between the
+possible options."
+  (let ((results (filter (lambda (repo)
+                           (repository-name=? repo repository))
+                         repositories)))
+    (if (null? results)
+        (remove-repository-by-location repository)
+        (remove-one-repository results))))
 
 (define-command (version)
   "Display version information."
diff --git a/gitto/ui.scm b/gitto/ui.scm
index fffe080..093e784 100644
--- a/gitto/ui.scm
+++ b/gitto/ui.scm
@@ -17,8 +17,11 @@
 ;; along with gitto.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gitto ui)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 i18n)
   #:use-module (ice-9 rdelim)
-  #:export (y-or-n?))
+  #:export (y-or-n?
+            choose))
 
 (define* (y-or-n? prompt #:key (default #f))
   (format #t "~a [~a] " prompt (if default "Y/n" "y/N"))
@@ -35,3 +38,25 @@
        (display "Invalid response, please use `y' or `n'.")
        (newline)
        (y-or-n? prompt #:default default)))))
+
+(define* (choose collection prompt #:optional (key identity))
+  "Ask the user to choose one of COLLECTION.
+
+PROMPT is the question to ask the user and KEY is the function to use
+to present the options to the user."
+  (format #t "~a~%~%Choose one:~%~%" prompt)
+
+  (do ((idx 1 (1+ idx))
+       (cll collection (cdr cll)))
+      ((null? cll))
+    (format #t "~3d. ~a~%" idx (key (car cll))))
+
+  (newline)
+  (display "Your Choice: ")
+
+  (let ((response (locale-string->integer (read-line))))
+    (if (and response (<= 1 response (length collection)))
+        (list-ref collection (1- response))
+        (begin
+          (format #t "Improper response.~%")
+          (choose collection prompt key)))))