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:
parent
53db54e71d
commit
3c831f9381
4 changed files with 75 additions and 9 deletions
|
@ -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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
|
@ -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."
|
||||||
|
|
27
gitto/ui.scm
27
gitto/ui.scm
|
@ -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)))))
|
||||||
|
|
Loading…
Reference in a new issue