Add push command

This commit is contained in:
Tom Willemse 2014-03-04 21:35:36 +01:00
parent 3c831f9381
commit 420b55c52c
2 changed files with 40 additions and 3 deletions

View file

@ -31,6 +31,7 @@
branch-pushable branch-pushable
branch-updated branch-updated
git-dir? git-dir?
git-push
print print
repo-branches repo-branches
repo-clean? repo-clean?
@ -144,6 +145,12 @@ sub-directory."
(close-pipe pipe) (close-pipe pipe)
num)) num))
(define (git-push repository)
"Try to push REPOSITORY to its default upstream."
(let* ((pipe (start-git (repo-location repository)
(format #f "push --all"))))
(close-pipe pipe)))
(define-method (initialize (branch <branch>) args) (define-method (initialize (branch <branch>) args)
(let ((name (car args)) (let ((name (car args))
(dir (cadr args))) (dir (cadr args)))

View file

@ -116,6 +116,10 @@ the user to choose one and remove the chosen repository."
(display "Not a registered repository.")) (display "Not a registered repository."))
(newline)) (newline))
(define (repositories-by-name name)
"Get the repositories identified by NAME."
(filter (lambda (repo) (repository-name=? repo name)) repositories))
(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))
@ -275,6 +279,34 @@ which no longer point to a git repository."
(set! repositories (filter repository-location-exists? repositories)) (set! repositories (filter repository-location-exists? repositories))
(save-repositories-list)) (save-repositories-list))
(define-command (push #:optional repository)
"Push all or the specified repository to its default upstream."
"Usage: gitto push [repository]
Go through the list of registered repositories and push all the ones
with changes to their default upstream. If REPOSITORY has been
specified just try to push that repository regardless of status."
(define (push-and-report repo)
(if (git-push repo)
(format #t "Succesfully pushed ~a~%" (repo-name repo))
(format #f "Pushing ~a failed~%" (repo-name repo))))
(if repository
(let* ((repositories-by-name (repositories-by-name repository))
(results (length repositories-by-name))
(repo #f))
(when (> results 0)
(set! repo
(if (= results 1)
(car repositories-by-name)
(choose repositories-by-name
"Push to which repository?" repo-location))))
(if (or (> results 0) (known? repository))
(push-and-report (or repo (make <repository> repository)))
(format #t "Unknown repository: ~a~%" repository)))
(for-each push-and-report repositories)))
(define-command (remove repository) (define-command (remove repository)
"Unregister a repository." "Unregister a repository."
"Usage: gitto remove REPO "Usage: gitto remove REPO
@ -288,9 +320,7 @@ REPO should either be the name of a repository as displayed by the
registered location. In case REPO is just a name and there is more 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 than one repository with that name you are given a choice between the
possible options." possible options."
(let ((results (filter (lambda (repo) (let ((results (repositories-by-name repository)))
(repository-name=? repo repository))
repositories)))
(if (null? results) (if (null? results)
(remove-repository-by-location repository) (remove-repository-by-location repository)
(remove-one-repository results)))) (remove-one-repository results))))