Reorder commands
This commit is contained in:
parent
e72c093057
commit
2dd972c770
1 changed files with 142 additions and 142 deletions
284
gitto/main.scm
284
gitto/main.scm
|
|
@ -46,18 +46,6 @@ set in the current environment."
|
||||||
(define (data-dir) (storage-dir "XDG_DATA_HOME" "/.local/share"))
|
(define (data-dir) (storage-dir "XDG_DATA_HOME" "/.local/share"))
|
||||||
(define (data-file file) (string-append (data-dir) "/" file))
|
(define (data-file file) (string-append (data-dir) "/" file))
|
||||||
|
|
||||||
(define-command (version)
|
|
||||||
"Display version information."
|
|
||||||
"Usage: gitto version
|
|
||||||
|
|
||||||
Displays version and some copyright information."
|
|
||||||
(display "gitto 0.1.0") (newline)
|
|
||||||
(display "Copyright (C) 2012 Tom Willemse") (newline)
|
|
||||||
(display "This program comes with ABSOLUTELY NO WARRANTY.") (newline)
|
|
||||||
(display "You may redistribute copies of this program") (newline)
|
|
||||||
(display "under the terms of the GNU General Public License.") (newline)
|
|
||||||
(display "For more information about these matters, see the file named COPYING.") (newline))
|
|
||||||
|
|
||||||
(define (registered? repo)
|
(define (registered? repo)
|
||||||
"Check if REPO has been registered."
|
"Check if REPO has been registered."
|
||||||
(or (member repo repositories same-repository?)
|
(or (member repo repositories same-repository?)
|
||||||
|
|
@ -91,76 +79,6 @@ Displays version and some copyright information."
|
||||||
(write repos port)
|
(write repos port)
|
||||||
(close-port port)))
|
(close-port port)))
|
||||||
|
|
||||||
(define-command (check repository)
|
|
||||||
"Check to see if a repository has been registered."
|
|
||||||
"Usage: gitto check REPO
|
|
||||||
|
|
||||||
Checks whether or not the git repository REPO has been registered with
|
|
||||||
gitto."
|
|
||||||
(format #t "Repository is~a registered~%"
|
|
||||||
(if (known? repository) "" " not")))
|
|
||||||
|
|
||||||
(define-command (add repository)
|
|
||||||
"Register a repository."
|
|
||||||
"Usage: gitto add REPO
|
|
||||||
|
|
||||||
Add REPO to the registered repository list. This command will fail if
|
|
||||||
REPO does not indicate a git repository or if it has already been
|
|
||||||
registered."
|
|
||||||
(set! repository (make <repository> (realpath repository)))
|
|
||||||
(if (not (known? repository))
|
|
||||||
(begin
|
|
||||||
(set! repositories (append `(,repository) repositories))
|
|
||||||
(save-repositories-list)
|
|
||||||
(simple-format #t "Repository ~A registered.~%"
|
|
||||||
(repo-name repository))
|
|
||||||
|
|
||||||
;; Ask the user if they would like to merge their config
|
|
||||||
;; template with the newly registered repository if they have
|
|
||||||
;; a configuration set-up and the current input port is a tty.
|
|
||||||
(when (and (isatty? (current-input-port))
|
|
||||||
(not (eq? global-config '()))
|
|
||||||
(y-or-n? "Would you like to merge your settings?"
|
|
||||||
#:default #t))
|
|
||||||
(update-repo-config repository)))
|
|
||||||
(display "Repository already registered."))
|
|
||||||
(newline))
|
|
||||||
|
|
||||||
(define-command (remove repository)
|
|
||||||
"Unregister a repository."
|
|
||||||
"Usage: gitto remove REPO
|
|
||||||
|
|
||||||
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."
|
|
||||||
(unless (member repository repositories same-repository?)
|
|
||||||
(set! repository (realpath repository)))
|
|
||||||
|
|
||||||
(if (known? repository)
|
|
||||||
(begin
|
|
||||||
(set! repositories
|
|
||||||
(delete repository repositories same-repository?))
|
|
||||||
(save-repositories-list)
|
|
||||||
(simple-format #t "Repository ~A removed." repository))
|
|
||||||
(display "Not a registered repository."))
|
|
||||||
(newline))
|
|
||||||
|
|
||||||
(define-command (list . args)
|
|
||||||
"List information about every repository."
|
|
||||||
"Usage: gitto list
|
|
||||||
gitto list locations
|
|
||||||
|
|
||||||
The first form shows an overview of the status of your registered
|
|
||||||
repositories and their branches. By default branches without changer
|
|
||||||
aren't shown, but you can change this behaviour by setting the
|
|
||||||
`show-unchanged-branches?' variable in your init file.
|
|
||||||
|
|
||||||
The second form prints the location on your filesystem for each
|
|
||||||
registered repository as absolute paths."
|
|
||||||
(if (and (not (eq? args '())) (equal? (car args) "locations"))
|
|
||||||
(list-repository-locations)
|
|
||||||
(for-each print repositories)))
|
|
||||||
|
|
||||||
(define (list-repository-locations)
|
(define (list-repository-locations)
|
||||||
"List the registered locations of repositories."
|
"List the registered locations of repositories."
|
||||||
(for-each
|
(for-each
|
||||||
|
|
@ -171,70 +89,10 @@ registered repository as absolute paths."
|
||||||
(lambda (s1 s2)
|
(lambda (s1 s2)
|
||||||
(string<? (repo-location s1) (repo-location s2))))))
|
(string<? (repo-location s1) (repo-location s2))))))
|
||||||
|
|
||||||
(define-command (purge)
|
|
||||||
"Purge all registered repositories that can no longer be found."
|
|
||||||
"Usage: gitto purge
|
|
||||||
|
|
||||||
Go through the list of registered repositories and remove all the ones
|
|
||||||
which no longer point to a git repository."
|
|
||||||
(set! repositories
|
|
||||||
(filter (lambda (repo)
|
|
||||||
(file-exists? (repo-location repo)))
|
|
||||||
repositories))
|
|
||||||
(save-repositories-list))
|
|
||||||
|
|
||||||
(define (show-global-config)
|
(define (show-global-config)
|
||||||
"Show the template specified in `global-config'."
|
"Show the template specified in `global-config'."
|
||||||
(write-config global-config))
|
(write-config global-config))
|
||||||
|
|
||||||
(define-command (hooks #:optional sub repository)
|
|
||||||
"Manage your repositories' hooks."
|
|
||||||
"Usage: gitto hooks init [repository]
|
|
||||||
|
|
||||||
Installs the configured hooks into each repository or the given
|
|
||||||
repository."
|
|
||||||
(cond
|
|
||||||
((equal? sub "init")
|
|
||||||
(let ((hookwrapper
|
|
||||||
(lambda (r)
|
|
||||||
(unless (member (repo-name r) config-exclusion-list)
|
|
||||||
(install-hooks (repo-location r))))))
|
|
||||||
(if repository
|
|
||||||
(if (known? repository)
|
|
||||||
(hookwrapper (make <repository> repository))
|
|
||||||
(format #t "Unknown repository: ~a~%" repository))
|
|
||||||
(for-each hookwrapper repositories))))))
|
|
||||||
|
|
||||||
(define-command (config #:optional sub repository)
|
|
||||||
"Manage your repositories' configurations."
|
|
||||||
"Usage: gitto config
|
|
||||||
gitto config global
|
|
||||||
gitto config update [repository]
|
|
||||||
|
|
||||||
The first form prints the configurations for each registered
|
|
||||||
repository.
|
|
||||||
|
|
||||||
The second form shows what your configured configuration template
|
|
||||||
looks like as a git configuration file. This does not expand the `%a'
|
|
||||||
format specifier which can be used to indicate the repository name.
|
|
||||||
|
|
||||||
The third form merges the template in and existing configurations,
|
|
||||||
overwriting settings when necessary. The repositories in the
|
|
||||||
`config-exclusion-list' will be skipped. If REPOSITORY is specified it
|
|
||||||
only updates the configuration for that repository. *Note:* This is a
|
|
||||||
destructive operation, you should be mindful."
|
|
||||||
(cond
|
|
||||||
((not sub)
|
|
||||||
(for-each (lambda (repo)
|
|
||||||
(display (string-upcase (repo-name repo)))
|
|
||||||
(newline)
|
|
||||||
(write-config (read-config (repo-location repo)))
|
|
||||||
(newline)
|
|
||||||
(newline))
|
|
||||||
repositories))
|
|
||||||
((equal? sub "global") (show-global-config))
|
|
||||||
((equal? sub "update") (update-config repository))))
|
|
||||||
|
|
||||||
(define (update-repo-config repo)
|
(define (update-repo-config repo)
|
||||||
"Merge the configured configuration with REPO's configuration.
|
"Merge the configured configuration with REPO's configuration.
|
||||||
|
|
||||||
|
|
@ -280,3 +138,145 @@ Don't do anything if REPO has been added to `config-exclusion-list'."
|
||||||
(close-port port)
|
(close-port port)
|
||||||
(map-in-order (lambda (repo) (make <repository> repo)) result))
|
(map-in-order (lambda (repo) (make <repository> repo)) result))
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
|
(define-command (add repository)
|
||||||
|
"Register a repository."
|
||||||
|
"Usage: gitto add REPO
|
||||||
|
|
||||||
|
Add REPO to the registered repository list. This command will fail if
|
||||||
|
REPO does not indicate a git repository or if it has already been
|
||||||
|
registered."
|
||||||
|
(set! repository (make <repository> (realpath repository)))
|
||||||
|
(if (not (known? repository))
|
||||||
|
(begin
|
||||||
|
(set! repositories (append `(,repository) repositories))
|
||||||
|
(save-repositories-list)
|
||||||
|
(simple-format #t "Repository ~A registered.~%"
|
||||||
|
(repo-name repository))
|
||||||
|
|
||||||
|
;; Ask the user if they would like to merge their config
|
||||||
|
;; template with the newly registered repository if they have
|
||||||
|
;; a configuration set-up and the current input port is a tty.
|
||||||
|
(when (and (isatty? (current-input-port))
|
||||||
|
(not (eq? global-config '()))
|
||||||
|
(y-or-n? "Would you like to merge your settings?"
|
||||||
|
#:default #t))
|
||||||
|
(update-repo-config repository)))
|
||||||
|
(display "Repository already registered."))
|
||||||
|
(newline))
|
||||||
|
|
||||||
|
(define-command (check repository)
|
||||||
|
"Check to see if a repository has been registered."
|
||||||
|
"Usage: gitto check REPO
|
||||||
|
|
||||||
|
Checks whether or not the git repository REPO has been registered with
|
||||||
|
gitto."
|
||||||
|
(format #t "Repository is~a registered~%"
|
||||||
|
(if (known? repository) "" " not")))
|
||||||
|
|
||||||
|
(define-command (config #:optional sub repository)
|
||||||
|
"Manage your repositories' configurations."
|
||||||
|
"Usage: gitto config
|
||||||
|
gitto config global
|
||||||
|
gitto config update [repository]
|
||||||
|
|
||||||
|
The first form prints the configurations for each registered
|
||||||
|
repository.
|
||||||
|
|
||||||
|
The second form shows what your configured configuration template
|
||||||
|
looks like as a git configuration file. This does not expand the `%a'
|
||||||
|
format specifier which can be used to indicate the repository name.
|
||||||
|
|
||||||
|
The third form merges the template in and existing configurations,
|
||||||
|
overwriting settings when necessary. The repositories in the
|
||||||
|
`config-exclusion-list' will be skipped. If REPOSITORY is specified it
|
||||||
|
only updates the configuration for that repository. *Note:* This is a
|
||||||
|
destructive operation, you should be mindful."
|
||||||
|
(cond
|
||||||
|
((not sub)
|
||||||
|
(for-each (lambda (repo)
|
||||||
|
(display (string-upcase (repo-name repo)))
|
||||||
|
(newline)
|
||||||
|
(write-config (read-config (repo-location repo)))
|
||||||
|
(newline)
|
||||||
|
(newline))
|
||||||
|
repositories))
|
||||||
|
((equal? sub "global") (show-global-config))
|
||||||
|
((equal? sub "update") (update-config repository))))
|
||||||
|
|
||||||
|
(define-command (hooks #:optional sub repository)
|
||||||
|
"Manage your repositories' hooks."
|
||||||
|
"Usage: gitto hooks init [repository]
|
||||||
|
|
||||||
|
Installs the configured hooks into each repository or the given
|
||||||
|
repository."
|
||||||
|
(cond
|
||||||
|
((equal? sub "init")
|
||||||
|
(let ((hookwrapper
|
||||||
|
(lambda (r)
|
||||||
|
(unless (member (repo-name r) config-exclusion-list)
|
||||||
|
(install-hooks (repo-location r))))))
|
||||||
|
(if repository
|
||||||
|
(if (known? repository)
|
||||||
|
(hookwrapper (make <repository> repository))
|
||||||
|
(format #t "Unknown repository: ~a~%" repository))
|
||||||
|
(for-each hookwrapper repositories))))))
|
||||||
|
|
||||||
|
(define-command (list . args)
|
||||||
|
"List information about every repository."
|
||||||
|
"Usage: gitto list
|
||||||
|
gitto list locations
|
||||||
|
|
||||||
|
The first form shows an overview of the status of your registered
|
||||||
|
repositories and their branches. By default branches without changer
|
||||||
|
aren't shown, but you can change this behaviour by setting the
|
||||||
|
`show-unchanged-branches?' variable in your init file.
|
||||||
|
|
||||||
|
The second form prints the location on your filesystem for each
|
||||||
|
registered repository as absolute paths."
|
||||||
|
(if (and (not (eq? args '())) (equal? (car args) "locations"))
|
||||||
|
(list-repository-locations)
|
||||||
|
(for-each print repositories)))
|
||||||
|
|
||||||
|
(define-command (purge)
|
||||||
|
"Purge all registered repositories that can no longer be found."
|
||||||
|
"Usage: gitto purge
|
||||||
|
|
||||||
|
Go through the list of registered repositories and remove all the ones
|
||||||
|
which no longer point to a git repository."
|
||||||
|
(set! repositories
|
||||||
|
(filter (lambda (repo)
|
||||||
|
(file-exists? (repo-location repo)))
|
||||||
|
repositories))
|
||||||
|
(save-repositories-list))
|
||||||
|
|
||||||
|
(define-command (remove repository)
|
||||||
|
"Unregister a repository."
|
||||||
|
"Usage: gitto remove REPO
|
||||||
|
|
||||||
|
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."
|
||||||
|
(unless (member repository repositories same-repository?)
|
||||||
|
(set! repository (realpath repository)))
|
||||||
|
|
||||||
|
(if (known? repository)
|
||||||
|
(begin
|
||||||
|
(set! repositories
|
||||||
|
(delete repository repositories same-repository?))
|
||||||
|
(save-repositories-list)
|
||||||
|
(simple-format #t "Repository ~A removed." repository))
|
||||||
|
(display "Not a registered repository."))
|
||||||
|
(newline))
|
||||||
|
|
||||||
|
(define-command (version)
|
||||||
|
"Display version information."
|
||||||
|
"Usage: gitto version
|
||||||
|
|
||||||
|
Displays version and some copyright information."
|
||||||
|
(display "gitto 0.1.0") (newline)
|
||||||
|
(display "Copyright (C) 2012 Tom Willemse") (newline)
|
||||||
|
(display "This program comes with ABSOLUTELY NO WARRANTY.") (newline)
|
||||||
|
(display "You may redistribute copies of this program") (newline)
|
||||||
|
(display "under the terms of the GNU General Public License.") (newline)
|
||||||
|
(display "For more information about these matters, see the file named COPYING.") (newline))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue