Add push command
This commit is contained in:
parent
3c831f9381
commit
420b55c52c
2 changed files with 40 additions and 3 deletions
|
@ -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)))
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
Loading…
Reference in a new issue