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 + +;; 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 . + +(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 . (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"))