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

109
collects/rico/rico.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require setup/getinfo (require "command-name.ss"
"command-name.ss") "all-tools.ss")
(define cmdline (vector->list (current-command-line-arguments))) (define cmdline (vector->list (current-command-line-arguments)))
@ -23,79 +23,46 @@
(hash-ref hash s) (hash-ref hash s)
'ambiguous)))))) 'ambiguous))))))
(let* ([dirs (find-relevant-directories '(rico))] (let* ([tools (all-tools)]
[infos (map get-info/full dirs)] [show-all?
[tools (make-hash)]) (cond
(for-each (lambda (i d) [(null? cmdline) #f]
(for-each (lambda (entry) [(or (equal? (car cmdline) "--help")
(cond (equal? (car cmdline) "-h"))
[(and (list? entry) #t]
(= (length entry) 4) [(regexp-match? #rx"^-" (car cmdline))
(string? (car entry)) (fprintf (current-error-port) "~a: A flag must follow a command: ~a\n\n"
(module-path? (cadr entry)) (find-system-path 'run-file)
(string? (caddr entry)) (car cmdline))
(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?
(cond
[(null? cmdline) #f]
[(or (equal? (car cmdline) "--help")
(equal? (car cmdline) "-h"))
#t]
[(regexp-match? #rx"^-" (car cmdline))
(fprintf (current-error-port) "~a: A flag must follow a command: ~a\n\n"
(find-system-path 'run-file)
(car cmdline))
#f] #f]
[(or (hash-ref tools (car cmdline) #f) [(or (hash-ref tools (car cmdline) #f)
(find-by-prefix tools (car cmdline))) (find-by-prefix tools (car cmdline)))
=> (lambda (tool) => (lambda (tool)
(if (eq? 'ambiguous tool) (if (eq? 'ambiguous tool)
(begin (begin
(fprintf (current-error-port) "~a: Ambiguous command prefix: ~a\n\n" (fprintf (current-error-port) "~a: Ambiguous command prefix: ~a\n\n"
(find-system-path 'run-file) (find-system-path 'run-file)
(car cmdline)) (car cmdline))
#f) #f)
(parameterize ([current-command-line-arguments (parameterize ([current-command-line-arguments
(list->vector (cdr cmdline))] (list->vector (cdr cmdline))]
[current-command-name (car tool)]) [current-command-name (car tool)])
(dynamic-require (cadr tool) #f) (dynamic-require (cadr tool) #f)
(exit))))] (exit))))]
[else [else
(fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n" (fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n"
(find-system-path 'run-file) (find-system-path 'run-file)
(car cmdline)) (car cmdline))
#f])]) #f])])
(fprintf (current-error-port) "Usage: rico <command> <option> ... <arg> ...\n\n") (fprintf (current-error-port) "Usage: rico <command> <option> ... <arg> ...\n\n")
(fprintf (current-error-port) "~a commands:\n" (if show-all? (fprintf (current-error-port) "~a commands:\n" (if show-all?
"Available" "Available"
"Frequently used")) "Frequently used"))
(let ([l (sort (hash-map tools (lambda (k v) v)) (let ([l (sort (hash-map tools (lambda (k v) v))
(if show-all? (if show-all?
(lambda (a b) (string<? (car a) (car b))) (lambda (a b) (string<? (car a) (car b)))
(lambda (a b) (> (or (list-ref a 3) -inf.0) (or (list-ref b 3) -inf.0)))))]) (lambda (a b) (> (or (list-ref a 3) -inf.0) (or (list-ref b 3) -inf.0)))))])
(let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))]) (let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))])
(for ([i (in-list l)]) (for ([i (in-list l)])
(when (or show-all? (cadddr i)) (when (or show-all? (cadddr i))
(fprintf (current-error-port) (fprintf (current-error-port)
@ -108,4 +75,4 @@
(printf "\nSee `rico --help' for a complete list of commands.")) (printf "\nSee `rico --help' for a complete list of commands."))
(printf "\nSee `rico <command> --help' for help on a command.") (printf "\nSee `rico <command> --help' for help on a command.")
(newline) (newline)
(exit (if show-all? 0 1)))) (exit (if show-all? 0 1)))