From 70eca89c3934709f8bf4df3a6fecca08b18f2440 Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Mon, 20 May 2013 22:27:20 +0200 Subject: [PATCH] Add simplistic command structure 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'. --- gitto/main.scm | 84 +++++++++++++++++++++++--------------------------- 1 file changed, 38 insertions(+), 46 deletions(-) diff --git a/gitto/main.scm b/gitto/main.scm index 5c20c89..7832f27 100644 --- a/gitto/main.scm +++ b/gitto/main.scm @@ -22,12 +22,12 @@ #:use-module (gitto git) #:use-module (gitto path) #:use-module (ice-9 format) - #:use-module (ice-9 getopt-long) #:use-module (ice-9 popen) #:use-module (oop goops) #:use-module (srfi srfi-1) #:export (main)) +(define command-list '()) (define config-exclusion-list '()) (define (storage-dir xdg-env fallback) @@ -48,6 +48,7 @@ (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)) +(set! command-list (append command-list `(("version" . ,version)))) (define (help) "Display some help." @@ -60,6 +61,7 @@ gitto [options] -v, --version Display version -h, --help Display this help ")) +(set! command-list (append command-list `(("help" . ,help)))) (define (known? repo) "Do we know REPO?" @@ -88,6 +90,8 @@ gitto [options] "Check to see if REPOSITORY has been registered." (format #t "Repository is~a registered~%" (if (known? repository) "" " not"))) +(set! command-list (append command-list + `(("check" . ,repository-registered?)))) (define (register-repository repository) "Register REPOSITORY in the repository list." @@ -100,6 +104,8 @@ gitto [options] (repo-name repository))) (display "Repository already registered.")) (newline)) +(set! command-list (append command-list + `(("add" . ,register-repository)))) (define (remove-repository repository) "Remove/unregister REPOSITORY from the repository list." @@ -114,10 +120,16 @@ gitto [options] (simple-format #t "Repository ~A removed." repository)) (display "Not a registered repository.")) (newline)) +(set! command-list (append command-list + `(("remove" . ,remove-repository)))) -(define (list-repositories) +(define (list-repositories . args) "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) "List the registered locations of repositories." @@ -136,18 +148,24 @@ gitto [options] (file-exists? (repo-location repo))) repositories)) (save-repositories-list)) +(set! command-list (append command-list `(("purge" . ,purge)))) (define (show-global-config) (write-config global-config)) -(define (show-config) - (for-each (lambda (repo) - (display (string-upcase (repo-name repo))) - (newline) - (write-config (read-config (repo-location repo))) - (newline) - (newline)) - repositories)) +(define (show-config . args) + (cond + ((eq? args '()) + (for-each (lambda (repo) + (display (string-upcase (repo-name repo))) + (newline) + (write-config (read-config (repo-location repo))) + (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) (for-each (lambda (repo) @@ -159,49 +177,23 @@ gitto [options] (string-append (repo-location repo) "/.git/config")))) 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) "Parse the command line options and run the appropriate functions." - (let* ((options (getopt-long args option-spec)) - (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"))) + (let ((cfg (config-file "rc.scm"))) (when (file-exists? cfg) (save-module-excursion (lambda () (set-current-module (resolve-module '(gitto main))) (primitive-load cfg)))) - (cond (version-wanted? (version)) - (help-wanted? (help)) - (registration-needed? => register-repository) - (removal? => remove-repository) - (list? (list-repository-locations)) - (purge? (purge)) - (check? => repository-registered?) - (config? (show-config)) - (global-config? (show-global-config)) - (update-config? (update-config)) - (#t (list-repositories))))) + (let* ((command-spec (cdr (member "gitto" args string-suffix?))) + (command? (not (eq? command-spec '()))) + (command + (assoc-ref command-list + (car (if command? command-spec '("list")))))) + (if command + (apply command (if command? (cdr command-spec) '())) + (format #t "Unknown command: ~a~%" (car command-spec)))))) (define repositories-file (data-file "repos.scm"))