suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Create separate module for listing all rico tools.

Browse Source
This commit is contained in:
Sam TH 2010-04-18 09:43:18 -04:00
parent 866600ac08
commit 89dc7afd02
1 changed files with 38 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/rico/rico.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require setup/getinfo
"command-name.ss")
(require "command-name.ss"
"all-tools.ss")
(define cmdline (vector->list (current-command-line-arguments)))
@ -23,41 +23,8 @@
(hash-ref hash s)
'ambiguous))))))
(let* ([dirs (find-relevant-directories '(rico))]
[infos (map get-info/full dirs)]
[tools (make-hash)])
(for-each (lambda (i d)
(for-each (lambda (entry)
(cond
[(and (list? entry)
(= (length entry) 4)
(string? (car entry))
(module-path? (cadr entry))
(string? (caddr entry))
(or (not (list-ref entry 3))
(real? (list-ref entry 3))))
(let ([p (hash-ref tools (car entry) #f)])
(when p
(fprintf
(current-error-port)
"warning: tool ~s registered twice: ~e and ~e"
(car entry)
(car p)
d)))
(hash-set! tools (car entry) entry)]
[else
(fprintf
(current-error-port)
"warning: ~s provided bad `rico' spec: ~e"
d
entry)]))
(let ([l (i 'rico (lambda () null))])
(if (list? l)
l
(list l)))))
infos
dirs)
(let ([show-all?
(let* ([tools (all-tools)]
[show-all?
(cond
[(null? cmdline) #f]
[(or (equal? (car cmdline) "--help")
@ -108,4 +75,4 @@
(printf "\nSee `rico --help' for a complete list of commands."))
(printf "\nSee `rico <command> --help' for help on a command.")
(newline)
(exit (if show-all? 0 1))))
(exit (if show-all? 0 1)))