Separate command operations into module

Separate and encapsulate operations on commands in their own module.
This gives a more clearly defined API to the commands and will allow
other modules to specify commands as well.

3 files changed, 75 insertions, 35 deletions

diff --git a/gitto/Makefile b/gitto/Makefile
index 31e80fc..eb54268 100644
--- a/gitto/Makefile
+++ b/gitto/Makefile
@@ -3,8 +3,8 @@ SITEDIR = $(shell pkg-config guile-2.0 --variable=sitedir \
 	--define-variable=prefix=$(DESTDIR))
 COMPDIR = $(DESTDIR)/lib/guile/2.0/site-ccache
 
-objects = config.scm config.go git.scm git.go ui.scm ui.go path.scm \
-	path.go main.scm main.go
+objects = command.scm command.go config.scm config.go git.scm git.go \
+	ui.scm ui.go path.scm path.go main.scm main.go
 install-objects = $(addprefix install-,$(objects))
 uninstall-objects = $(addprefix uninstall-,$(objects))
 
diff --git a/gitto/command.scm b/gitto/command.scm
new file mode 100644
index 0000000..6e65f32
--- /dev/null
+++ b/gitto/command.scm
@@ -0,0 +1,63 @@
+;; -*- coding: utf-8; -*-
+;; gitto -- Keep track of your git repositories
+;; Copyright (C) 2012 Tom Willemse <tom at ryuslash dot org>
+
+;; This file is part of gitto.
+
+;; gitto is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; gitto is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with gitto.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gitto command)
+  #:export (define-command
+            command?
+            command-documentation
+            command-function
+            for-each-command))
+
+(define-syntax define-command
+  (syntax-rules ()
+    ((_ (name . args)
+        usage
+        longdoc
+        exp exp* ...)
+     (begin
+       (set! command-list
+             (cons
+              (list (symbol->string (quote name))
+                    (cons
+                     #:function
+                     (case-lambda*
+                      (args
+                       exp exp* ...)
+                      (lst (format #t "Wrong number of arguments.~%"))))
+                    (cons #:usage usage)
+                    (cons #:documentation longdoc))
+              command-list))))))
+
+(define command-list '())
+
+(define (command? name)
+  "Check if NAME corresponds to a command."
+  (not (null? (assoc-ref command-list name))))
+
+(define (command-documentation command)
+  "Get the documentation for COMMAND."
+  (assq-ref (assoc-ref command-list command) #:documentation))
+
+(define (command-function command)
+  "Get the function for COMMAND."
+  (assq-ref (assoc-ref command-list command) #:function))
+
+(define (for-each-command function)
+  "Execute FUNCTION for each known command."
+  (for-each function command-list))
diff --git a/gitto/main.scm b/gitto/main.scm
index 5f21e46..ffc7e34 100644
--- a/gitto/main.scm
+++ b/gitto/main.scm
@@ -18,6 +18,7 @@
 ;; along with gitto.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gitto main)
+  #:use-module (gitto command)
   #:use-module (gitto config)
   #:use-module (gitto git)
   #:use-module (gitto path)
@@ -28,27 +29,6 @@
   #:use-module (srfi srfi-1)
   #:export (main))
 
-(define-syntax define-command
-  (syntax-rules ()
-    ((_ (name . args)
-        usage
-        longdoc
-        exp exp* ...)
-     (begin
-       (set! command-list
-             (cons
-              (list (symbol->string (quote name))
-                    (cons
-                     #:function
-                     (case-lambda*
-                      (args
-                       exp exp* ...)
-                      (lst (format #t "Wrong number of arguments.~%"))))
-                    (cons #:usage usage)
-                    (cons #:documentation longdoc))
-              command-list))))))
-
-(define command-list '())
 (define config-exclusion-list '())
 
 (define (storage-dir xdg-env fallback)
@@ -80,10 +60,9 @@ Displays version and some copyright information."
 
 (define (print-command-help command)
   "Print the help message for COMMAND."
-  (let ((command-spec (assoc-ref command-list command)))
-    (if command-spec
-        (format #t "~a~%" (assq-ref command-spec #:documentation))
-        (format #t "Unknown command: ~a~%" command))))
+  (if (command? command)
+      (format #t "~a~%" (command-documentation command))
+      (format #t "Unknown command: ~a~%" command)))
 
 (define (print-short-command-help command)
   "Print COMMAND's name and its short description."
@@ -93,7 +72,7 @@ Displays version and some copyright information."
   "Print the general help message for gitto."
   (display "gitto [command [arguments ...]]")
   (newline)
-  (for-each print-short-command-help command-list))
+  (for-each-command print-short-command-help))
 
 (define-command (help #:optional command)
   "Display this help."
@@ -305,13 +284,11 @@ Don't do anything if REPO has been added to `config-exclusion-list'."
          (primitive-load cfg))))
 
     (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 (assq-ref command #:function)
-                 (if command? (cdr command-spec) '()))
+           (command-specified? (not (eq? command-spec '())))
+           (command (car (if command-specified? command-spec '("list")))))
+      (if (command? command)
+          (apply (command-function command)
+                 (if command-specified? (cdr command-spec) '()))
           (format #t "Unknown command: ~a~%" (car command-spec))))))
 
 (define repositories-file (data-file "repos.scm"))