;; Copyright 2006-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; This is from the perl world, a hash of hashes is a super easy way to keep a handle on
;; lots of disparate data
;;
(declare (unit mttop))
(module mttop
*
(import chicken scheme
;; data-structures posix
srfi-1
;; srfi-13
srfi-69
ports
extras
regex
posix
data-structures
matchable
)
(define (str-is-cmd cmd all-cmds)
(let* ((rx (regexp (conc "^" cmd ".*")))
(mx (filter string? (map (lambda (x)
(let ((res (string-match rx x)))
(if res (car res) #f)))
all-cmds))))
(if (eq? (length mx) 1) ;; have a command
(car mx)
#f)))
(define (mttop-run args all-cmds)
;; any path through this call must end in exit if it is NOT an old Megatest call
(if (null? args)
#f ;; continue on and do the old Megatest stuff
(let ((cmd (str-is-cmd (car args) all-cmds)))
(if cmd
(begin
(case (string->symbol cmd)
((help)(print "New help"))
(else (print "Command " cmd " is not implemented yet.")))
(exit)) ;; always exit here
#f)))) ;; or continue on to Megatest old stuff here
)