ryuslash/gitto
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add simplistic command structure

Browse source 
Now instead of using `gitto --register' or `gitto -r' one would use
`gitto add'. Here is the list of what was and what is:

--version, -v      => version
--help, -h         => help
--register, -r     => add
--remove, -R       => remove
--repositories, -l => list locations
--purge, -p        => purge
--check, -c        => check
--config, -C       => config
--global-config    => config global
--update-config    => config update

Running gitto without arguments keeps the same functionality, though
it can also be called as `gitto list'.
This commit is contained in:
Tom Willemse 2013-05-20 22:27:20 +02:00
parent e293a71f9c
commit 70eca89c39
1 changed files with 38 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
gitto/main.scm
View file

@ -22,12 +22,12 @@
#:use-module (gitto git) #:use-module (gitto git)
#:use-module (gitto path) #:use-module (gitto path)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:use-module (oop goops) #:use-module (oop goops)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (main)) #:export (main))
(define command-list '())
(define config-exclusion-list '()) (define config-exclusion-list '())
(define (storage-dir xdg-env fallback) (define (storage-dir xdg-env fallback)
@ -48,6 +48,7 @@
(display "You may redistribute copies of this program") (newline) (display "You may redistribute copies of this program") (newline)
(display "under the terms of the GNU General Public License.") (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)) (display "For more information about these matters, see the file named COPYING.") (newline))
(set! command-list (append command-list `(("version" . ,version))))
(define (help) (define (help)
"Display some help." "Display some help."
@ -60,6 +61,7 @@ gitto [options]
-v, --version Display version -v, --version Display version
-h, --help Display this help -h, --help Display this help
")) "))
(set! command-list (append command-list `(("help" . ,help))))
(define (known? repo) (define (known? repo)
"Do we know REPO?" "Do we know REPO?"
@ -88,6 +90,8 @@ gitto [options]
"Check to see if REPOSITORY has been registered." "Check to see if REPOSITORY has been registered."
(format #t "Repository is~a registered~%" (format #t "Repository is~a registered~%"
(if (known? repository) "" " not"))) (if (known? repository) "" " not")))
(set! command-list (append command-list
`(("check" . ,repository-registered?))))
(define (register-repository repository) (define (register-repository repository)
"Register REPOSITORY in the repository list." "Register REPOSITORY in the repository list."
@ -100,6 +104,8 @@ gitto [options]
(repo-name repository))) (repo-name repository)))
(display "Repository already registered.")) (display "Repository already registered."))
(newline)) (newline))
(set! command-list (append command-list
`(("add" . ,register-repository))))
(define (remove-repository repository) (define (remove-repository repository)
"Remove/unregister REPOSITORY from the repository list." "Remove/unregister REPOSITORY from the repository list."
@ -114,10 +120,16 @@ gitto [options]
(simple-format #t "Repository ~A removed." repository)) (simple-format #t "Repository ~A removed." repository))
(display "Not a registered repository.")) (display "Not a registered repository."))
(newline)) (newline))
(set! command-list (append command-list
`(("remove" . ,remove-repository))))
(define (list-repositories) (define (list-repositories . args)
"List information about every repository." "List information about every repository."
(for-each print repositories)) (if (and (not (eq? args '())) (equal? (car args) "locations"))
(list-repository-locations)
(for-each print repositories)))
(set! command-list (append command-list
`(("list" . ,list-repositories))))
(define (list-repository-locations) (define (list-repository-locations)
"List the registered locations of repositories." "List the registered locations of repositories."
@ -136,18 +148,24 @@ gitto [options]
(file-exists? (repo-location repo))) (file-exists? (repo-location repo)))
repositories)) repositories))
(save-repositories-list)) (save-repositories-list))
(set! command-list (append command-list `(("purge" . ,purge))))
(define (show-global-config) (define (show-global-config)
(write-config global-config)) (write-config global-config))
(define (show-config) (define (show-config . args)
(for-each (lambda (repo) (cond
(display (string-upcase (repo-name repo))) ((eq? args '())
(newline) (for-each (lambda (repo)
(write-config (read-config (repo-location repo))) (display (string-upcase (repo-name repo)))
(newline) (newline)
(newline)) (write-config (read-config (repo-location repo)))
repositories)) (newline)
(newline))
repositories))
((equal? (car args) "global") (show-global-config))
((equal? (car args) "update") (update-config))))
(set! command-list (append command-list `(("config" . ,show-config))))
(define (update-config) (define (update-config)
(for-each (lambda (repo) (for-each (lambda (repo)
@ -159,49 +177,23 @@ gitto [options]
(string-append (repo-location repo) "/.git/config")))) (string-append (repo-location repo) "/.git/config"))))
repositories)) repositories))
(define option-spec
`((version (single-char #\v))
(help (single-char #\h))
(register (single-char #\r) (value #t) (predicate ,git-dir?))
(remove (single-char #\R) (value #t) (predicate ,known?))
(repositories (single-char #\l))
(purge (single-char #\p))
(check (single-char #\c) (value #t))
(config (single-char #\C))
(global-config)
(update-config)))
(define (main args) (define (main args)
"Parse the command line options and run the appropriate functions." "Parse the command line options and run the appropriate functions."
(let* ((options (getopt-long args option-spec)) (let ((cfg (config-file "rc.scm")))
(help-wanted? (option-ref options 'help #f))
(version-wanted? (option-ref options 'version #f))
(registration-needed? (option-ref options 'register #f))
(removal? (option-ref options 'remove #f))
(list? (option-ref options 'repositories #f))
(purge? (option-ref options 'purge #f))
(check? (option-ref options 'check #f))
(config? (option-ref options 'config #f))
(global-config? (option-ref options 'global-config #f))
(update-config? (option-ref options 'update-config #f))
(cfg (config-file "rc.scm")))
(when (file-exists? cfg) (when (file-exists? cfg)
(save-module-excursion (save-module-excursion
(lambda () (lambda ()
(set-current-module (resolve-module '(gitto main))) (set-current-module (resolve-module '(gitto main)))
(primitive-load cfg)))) (primitive-load cfg))))
(cond (version-wanted? (version)) (let* ((command-spec (cdr (member "gitto" args string-suffix?)))
(help-wanted? (help)) (command? (not (eq? command-spec '())))
(registration-needed? => register-repository) (command
(removal? => remove-repository) (assoc-ref command-list
(list? (list-repository-locations)) (car (if command? command-spec '("list"))))))
(purge? (purge)) (if command
(check? => repository-registered?) (apply command (if command? (cdr command-spec) '()))
(config? (show-config)) (format #t "Unknown command: ~a~%" (car command-spec))))))
(global-config? (show-global-config))
(update-config? (update-config))
(#t (list-repositories)))))
(define repositories-file (data-file "repos.scm")) (define repositories-file (data-file "repos.scm"))