From 79e52c67bcd3c41774daf363845c2dc5b7f4d758 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 28 Apr 2010 06:28:39 -0600
Subject: [PATCH] make 'raco help <command>' work

---
 collects/racket/cmdline.rkt      |   7 +-
 collects/raco/command-name.rkt   |   2 +-
 collects/raco/raco.rkt           | 119 +++++++++++++++++--------------
 collects/setup/setup-cmdline.rkt |   4 +-
 4 files changed, 73 insertions(+), 59 deletions(-)

diff --git a/collects/racket/cmdline.rkt b/collects/racket/cmdline.rkt
index a61b387735..2c0371802c 100644
--- a/collects/racket/cmdline.rkt
+++ b/collects/racket/cmdline.rkt
@@ -1,6 +1,9 @@
-#lang scheme/base
+#lang racket/base
 
-(require (for-syntax scheme/base))
+;; Minimize imports here, because `raco setup' has to load this file
+;; and its dependencies from source
+
+(require (for-syntax racket/base))
 
 (provide command-line parse-command-line)
 
diff --git a/collects/raco/command-name.rkt b/collects/raco/command-name.rkt
index c1693d85c9..e07da148ed 100644
--- a/collects/raco/command-name.rkt
+++ b/collects/raco/command-name.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 (provide current-command-name
          program+command-name
diff --git a/collects/raco/raco.rkt b/collects/raco/raco.rkt
index 9d29d1dcb8..ac2a63636d 100644
--- a/collects/raco/raco.rkt
+++ b/collects/raco/raco.rkt
@@ -2,8 +2,6 @@
 (require "command-name.ss"
          "all-tools.ss")
 
-(define cmdline (vector->list (current-command-line-arguments)))
-
 (define (find-by-prefix hash str)
   (let ([trie (make-hash)])
     (for ([key (in-hash-keys hash)])
@@ -23,56 +21,69 @@
                  (hash-ref hash s)
                  'ambiguous))))))
 
-(let* ([tools (all-tools)]
+(let* ([cmdline (vector->list (current-command-line-arguments))]
+       [cmdline (if (and (pair? cmdline)
+                         (equal? "help" (car cmdline))
+                         (pair? (cdr cmdline))
+                         (not (regexp-match? #rx"^-" (cadr cmdline))))
+                    (list* (cadr cmdline) "--help" (cddr cmdline))
+                    cmdline)]
+       [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))
-                      #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: raco <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)
-                     "  ~a~a~a\n"
-                     (car i)
-                     (make-string (- largest -3 (string-length (car i))) #\space)
-                     (caddr i))))))
-    (printf "\nA command can be specified by an unambigous prefix.")
-    (unless show-all?
-      (printf "\nSee `raco --help' for a complete list of commands."))
-    (printf "\nSee `raco <command> --help' for help on a command.")
-    (newline)
-    (exit (if show-all? 0 1)))
+        (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))
+                     #f)
+                   (parameterize ([current-command-line-arguments
+                                   (list->vector (cdr cmdline))]
+                                  [current-command-name (car tool)])
+                     (dynamic-require (cadr tool) #f)
+                     (exit))))]
+         [(equal? (car cmdline) "help") #t]
+         [else
+          (fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n"
+                   (find-system-path 'run-file)
+                   (car cmdline))
+          #f])])
+  (fprintf (current-error-port) "Usage: raco <command> <option> ... <arg> ...\n")
+  (for-each
+   (lambda (show-all?)
+     (fprintf (current-error-port) "\n~a commands:\n" (if show-all? 
+                                                          "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)
+                      "  ~a~a~a\n"
+                      (car i)
+                      (make-string (- largest -3 (string-length (car i))) #\space)
+                      (caddr i)))))))
+   (if show-all?
+       (list #f #t)
+       (list #f)))
+  (printf "\nA command can be specified by an unambigous prefix.")
+  (unless show-all?
+    (printf "\nSee `raco help' for a complete list of commands."))
+  (printf "\nSee `raco help <command>' for help on a command.")
+  (newline)
+  (exit (if show-all? 0 1)))
diff --git a/collects/setup/setup-cmdline.rkt b/collects/setup/setup-cmdline.rkt
index b36b69eb5b..8d9d1fd7bd 100644
--- a/collects/setup/setup-cmdline.rkt
+++ b/collects/setup/setup-cmdline.rkt
@@ -3,9 +3,9 @@
 ;;  both in setup.ss (pre-zo, pre-cm) and setup-go.ss (use zos and cm).
 ;; This means that command lines will be parsed twice.
 
-#lang scheme/base
+#lang racket/base
 
-(require scheme/cmdline
+(require racket/cmdline
          raco/command-name)
 
 (provide parse-cmdline)