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.
This commit is contained in:
Tom Willemse 2014-03-03 23:59:19 +01:00
parent 53db54e71d
commit 3c831f9381
4 changed files with 75 additions and 9 deletions

View file

@ -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 Remove @var{location} from the list of registered repositories. This
first checks to see whether or not this repository has even been first checks to see whether or not this repository has even been
registered. 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 @end deffn
In the event you (re)move some of your repositories and don't have the In the event you (re)move some of your repositories and don't have the

View file

@ -40,6 +40,7 @@
repository-location<? repository-location<?
repository-location-exists? repository-location-exists?
repository-name<? repository-name<?
repository-name=?
same-repository?)) same-repository?))
(define show-unchanged-branches? #f) (define show-unchanged-branches? #f)
@ -74,6 +75,10 @@
"Compare REPO1 and REPO2 to see if REPO1 should be considered less." "Compare REPO1 and REPO2 to see if REPO1 should be considered less."
(string<? (repo-name repo1) (repo-name repo2))) (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>)) (define-method (branch-pullable (branch <branch>))
(force (slot-ref branch 'pullable))) (force (slot-ref branch 'pullable)))

View file

@ -87,12 +87,35 @@
(repo-location repo))) (repo-location repo)))
repositories same-repository?))) 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) (define (remove-repository repository)
"Remove REPOSITORY from the list of known repositories." "Remove REPOSITORY from the list of known repositories."
(set! repositories (set! repositories
(delete repository repositories same-repository?)) (delete repository repositories same-repository?))
(save-repositories-list)) (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) (define (save-repositories-list)
"Save the list of repositories." "Save the list of repositories."
(ensure-directory-exists. (data-dir)) (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 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 fail if REPO does not indicate a git repository of if it hasn't been
registered." registered.
(set! repository (canonicalize-filename repository))
(if (known? repository) REPO should either be the name of a repository as displayed by the
(begin `list' command, or should be a absolute or relative path to a
(remove-repository repository) registered location. In case REPO is just a name and there is more
(simple-format #t "Repository ~A removed." repository)) than one repository with that name you are given a choice between the
(display "Not a registered repository.")) possible options."
(newline)) (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) (define-command (version)
"Display version information." "Display version information."

View file

@ -17,8 +17,11 @@
;; along with gitto. If not, see <http://www.gnu.org/licenses/>. ;; along with gitto. If not, see <http://www.gnu.org/licenses/>.
(define-module (gitto ui) (define-module (gitto ui)
#:use-module (ice-9 format)
#:use-module (ice-9 i18n)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:export (y-or-n?)) #:export (y-or-n?
choose))
(define* (y-or-n? prompt #:key (default #f)) (define* (y-or-n? prompt #:key (default #f))
(format #t "~a [~a] " prompt (if default "Y/n" "y/N")) (format #t "~a [~a] " prompt (if default "Y/n" "y/N"))
@ -35,3 +38,25 @@
(display "Invalid response, please use `y' or `n'.") (display "Invalid response, please use `y' or `n'.")
(newline) (newline)
(y-or-n? prompt #:default default))))) (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)))))