Create separate module for listing all rico tools.
This commit is contained in:
parent
866600ac08
commit
89dc7afd02
|
@ -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,79 +23,46 @@
|
|||
(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?
|
||||
(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))
|
||||
(let* ([tools (all-tools)]
|
||||
[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]
|
||||
[(or (hash-ref tools (car cmdline) #f)
|
||||
(find-by-prefix tools (car cmdline)))
|
||||
=> (lambda (tool)
|
||||
(if (eq? 'ambiguous tool)
|
||||
(begin
|
||||
(fprintf (current-error-port) "~a: Ambiguous command prefix: ~a\n\n"
|
||||
(find-system-path 'run-file)
|
||||
(car cmdline))
|
||||
[(or (hash-ref tools (car cmdline) #f)
|
||||
(find-by-prefix tools (car cmdline)))
|
||||
=> (lambda (tool)
|
||||
(if (eq? 'ambiguous tool)
|
||||
(begin
|
||||
(fprintf (current-error-port) "~a: Ambiguous command prefix: ~a\n\n"
|
||||
(find-system-path 'run-file)
|
||||
(car cmdline))
|
||||
#f)
|
||||
(parameterize ([current-command-line-arguments
|
||||
(list->vector (cdr cmdline))]
|
||||
[current-command-name (car tool)])
|
||||
(dynamic-require (cadr tool) #f)
|
||||
(exit))))]
|
||||
[else
|
||||
(fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n"
|
||||
(find-system-path 'run-file)
|
||||
(car cmdline))
|
||||
#f])])
|
||||
(fprintf (current-error-port) "Usage: rico <command> <option> ... <arg> ...\n\n")
|
||||
(fprintf (current-error-port) "~a commands:\n" (if show-all?
|
||||
"Available"
|
||||
"Frequently used"))
|
||||
(let ([l (sort (hash-map tools (lambda (k v) v))
|
||||
(if show-all?
|
||||
(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)))))])
|
||||
(let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))])
|
||||
(dynamic-require (cadr tool) #f)
|
||||
(exit))))]
|
||||
[else
|
||||
(fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n"
|
||||
(find-system-path 'run-file)
|
||||
(car cmdline))
|
||||
#f])])
|
||||
(fprintf (current-error-port) "Usage: rico <command> <option> ... <arg> ...\n\n")
|
||||
(fprintf (current-error-port) "~a commands:\n" (if show-all?
|
||||
"Available"
|
||||
"Frequently used"))
|
||||
(let ([l (sort (hash-map tools (lambda (k v) v))
|
||||
(if show-all?
|
||||
(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)))))])
|
||||
(let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))])
|
||||
(for ([i (in-list l)])
|
||||
(when (or show-all? (cadddr i))
|
||||
(fprintf (current-error-port)
|
||||
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user