trying to incorporate the command line parser used by PLaneT. I hate code copying, but here I am doing it all over again.

private/command.rkt

@@ -0,0 +1,133 @@
+#lang racket/base
+(require "prefix-dispatcher.ss"
+         racket/cmdline
+         (for-syntax racket/base))
+
+
+;; dyoo: this is directly copied out of planet/private/command.rkt.
+;; Maybe someone should generalize this so there's no duplication...
+
+
+(provide svn-style-command-line)
+
+;; implements an "svn-style" command-line interface as a wrapper around racket/cmdline. At the moment,
+;; it is light on error-checking and makes choices that are somewhat specific to the PLaneT commandline
+;; tool, thus its inclusion in planet/private rather than somewhere more visible. The idea is that you
+;; write
+#|
+
+(svn-style-command-line
+   #:program <name-of-the-program-string>
+   #:argv <argument vector, generally (current-command-line-arguments)>
+   <program-general-description string>
+   [<command1> <brief-help-string> <long-help-description-string>
+    ... arguments just like the command-line macro takes, until ...
+    #:args formals
+    body-expr] ...)
+|#
+
+;; This macro turns that into a command-line type of thing that implements
+;;    program command1 ... args ...
+;;    program command2 ... args ...
+;; etc.
+;; It provides two nonobvious features:
+;;   1. It automatically includes a help feature that prints out all available subcommands
+;;   2. It automatically lets users use any unambiguous prefix of any command.
+;;      This means that no command name may be a prefix of any other command name, because it
+;;      would mean there was no way to unambiguously name the shorter one.
+
+(define-syntax (svn-style-command-line stx)
+  (syntax-case stx ()
+    [(_ #:program prog 
+        #:argv args
+        general-description
+        [name description long-description body ... #:args formals final-expr] ...)
+     (with-syntax ([(n ...) (generate-temporaries #'(name ...))])
+       #'(let* ([p prog]
+                [a args]
+                [n name] ...
+                [argslist (cond 
+                            [(list? a) a]
+                            [(vector? a) (vector->list a)]
+                            [else (error 'command "expected a vector or list for arguments, received ~e" a)])]
+                [help (λ () (display-help-message p general-description `((name description) ...)))])
+           (let-values ([(the-command remainder)
+                         (if (null? argslist)
+                             (values "help" '())
+                             (values (car argslist) (cdr argslist)))])
+             (prefix-case the-command
+                          [n 
+                           (command-line 
+                            #:program (format "~a ~a" p n)
+                            #:argv remainder 
+                            body ...
+                            #:handlers
+                            (λ (_ . formals) final-expr)
+                            (pimap symbol->string 'formals)
+                            (λ (help-string)
+                              (for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
+                              (newline)
+                              (display "Usage:\n")
+                              (display help-string)
+                              (exit)))] ...
+                          ["help" (help)]
+                          [else (help)]))))]))
+
+
+;; display-help-message : string string (listof (list string string)) -> void
+;; prints out the help message
+(define (display-help-message prog general-description commands)
+  (let* ([maxlen (apply max (map (λ (p) (string-length (car p))) commands))]
+         [message-lines
+          `(,(format "Usage: ~a <subcommand> [option ...] <arg ...>" prog)
+            ,(format "  where any unambiguous prefix can be used for a subcommand")
+            ""
+            ,@(wrap-to-count general-description 80)
+            ""
+            ,(format "For help on a particular subcommand, use '~a <subcommand> --help'" prog)
+            ,@(map (λ (command) 
+                     (let* ([padded-name (pad (car command) maxlen)]
+                            [desc        (cadr command)]
+                            [msg         (format "  ~a ~a    ~a" prog padded-name desc)])
+                       msg))
+                   commands))])
+    (for-each (λ (line) (display line) (newline)) message-lines)))
+
+;; ----------------------------------------
+;; utility
+
+;; pad : string nat[>= string-length str] -> string
+;; pads the given string up to the given length.
+(define (pad str n)
+  (let* ([l (string-length str)]
+         [extra (build-string (- n l) (λ (n) #\space))])
+    (string-append str extra)))
+
+;; pimap : (A -> B) improper-listof A -> improper-listof B 
+(define (pimap f pil)
+  (cond
+    [(null? pil) '()]
+    [(pair? pil) (cons (pimap f (car pil))
+                       (pimap f (cdr pil)))]
+    [else (f pil)]))
+
+;; wrap-to-count : string nat -> (listof string)
+;; breaks str into substrings such that no substring
+;; is longer than n characters long. Only breaks on spaces, which
+;; are eaten in the process.
+(define (wrap-to-count str n)
+  (cond
+    [(< (string-length str) n) (list str)]
+    [(regexp-match-positions #rx"\n" str 0 n)
+     =>
+     (λ (posn)
+       (let-values ([(x y) (values (car (car posn)) (cdr (car posn)))])
+         (cons (substring str 0 x) (wrap-to-count (substring str y) n))))] 
+    [else
+     ;; iterate backwards from char n looking for a good break
+     (let loop ([k n])
+       (cond
+         [(= k 0) (error wrap-to-count "could not break string")]
+         [(char=? (string-ref str k) #\space)
+          (cons (substring str 0 k) (wrap-to-count (substring str (add1 k)) n))]
+         [else (loop (sub1 k))]))]))

private/prefix-dispatcher.rkt

@@ -0,0 +1,124 @@
+#lang racket/base
+
+(require (for-syntax racket/base))
+(provide (all-defined-out))
+
+;; ============================================================
+;; PREFIX DISPATCHER
+;; Code to determine the entry specified by an arbitrary
+;; (unambiguous) prefix of a set of possible entries
+
+(define-struct (exn:prefix-dispatcher exn:fail) ())
+(define-struct (exn:unknown-command exn:prefix-dispatcher) (entry))
+(define-struct (exn:ambiguous-command exn:prefix-dispatcher) (possibilities))
+
+;; get-prefix-dispatcher : (listof (list string A)) -> string -> A
+;; gets the 
+(define (get-prefix-dispatcher options)
+  ;; implementation strategy is dumb regexp-filter. It is possible to do a trie or something fancy like that,
+  ;; but it would cost more to build than it would be worth, and we're only expecting lists of a few items anyway
+  (let ([pre/full (get-prefix-and-suffix (map car options))])
+    (when pre/full
+      (error 'get-prefix-dispatcher "No element may be a strict prefix of any other element; given ~a and ~a" 
+             (car pre/full)
+             (cadr pre/full))))
+  
+  (λ (target)
+    (let* ([re (format "^~a" (regexp-quote target))]
+           [matches (filter (λ (x) (regexp-match re (car x))) options)])
+      (cond
+        [(length=? matches 1) (cadr (car matches))]
+        [(null? matches)
+         (raise (make-exn:unknown-command (format "Unknown command: ~a" target)
+                                          (current-continuation-marks)
+                                          target))]
+        [else
+         (raise (make-exn:ambiguous-command (format "Ambiguous command: ~a" target)
+                                            (current-continuation-marks)
+                                            (map car matches)))]))))
+;; length=? : list nat -> boolean
+;; determines if the given list has the given length. Running time is proportional
+;; to the shorter of the magnitude of the number or the actual length of the list
+(define (length=? lst len)
+  (cond
+    [(and (null? lst) (zero? len)) #t]
+    [(null? lst)                   #f]
+    [(zero? len)                   #f]
+    [else                          (length=? (cdr lst) (sub1 len))]))
+      
+;; get-prefix-and-suffix : (listof string) -> (list string string) | #f
+;; returns a pair of strings in the given list such that the first string is a prefix of the second,
+;; or #f if no such pair exists
+(define (get-prefix-and-suffix strs)
+  (cond
+    [(null? strs) #f]
+    [else
+     (sorted-nelist-contains-prefix? (sort strs string<?))]))
+
+;; sorted-nelist-contains-prefix? : (nonempty-listof string) -> (list string string) | #f
+;; given a lexicographically-sorted, nonempty list of strings, returns either
+;; two strings from the list such that the first is a prefix of the second, or #f if 
+;; no such pair exists
+(define (sorted-nelist-contains-prefix? nel)
+  (cond
+    [(null? (cdr nel)) #f]
+    [(prefix? (car nel) (cadr nel))
+     (list (car nel) (cadr nel))]
+    [else (sorted-nelist-contains-prefix? (cdr nel))]))
+
+;; prefix? : string string -> boolean
+;; determins if s1 is a prefix of s2
+(define (prefix? s1 s2)
+  (and (<= (string-length s1) (string-length s2))
+       (string=? s1 (substring s2 0 (string-length s1)))))
+
+
+(define-syntax (prefix-case stx)
+  
+  (define (else? stx)
+    (syntax-case stx (else)
+      [(else clause) #t]
+      [_ #f]))
+  
+  (define (amb? stx)
+    (syntax-case stx (ambiguous)
+      [(ambiguous (name) body) #t]
+      [_ #f]))
+  
+  (define (extract-clause name options transformer default)
+    (case (length options)
+      [(0) default]
+      [(1) (transformer (car options))]
+      [else
+       (raise-syntax-error #f (format "only 1 ~a clause is allowed" name) stx (list-ref options 1))]))
+
+  (define (else-clause->body c)
+    (syntax-case c (else)
+      [(else body) #'body]
+      [_ (raise-syntax-error #f "malformed else clause" stx c)]))
+  
+  (define (amb-clause->body c)
+    (syntax-case c (ambiguous)
+      [(ambiguous (name) body) #'(λ (name) body)]
+      [_ (raise-syntax-error #f "malformed ambiguous clause" stx c)]))
+  
+  (syntax-case stx ()
+    [(_ elt
+      clause ...)
+     (let* ([clauses (syntax-e #'(clause ...))]
+            [else-clauses (filter else? clauses)]
+            [amb-clauses  (filter amb?  clauses)]
+            [rest         (filter (λ (x) (not (or (else? x) (amb? x)))) clauses)]
+            [else (extract-clause "else" else-clauses else-clause->body 
+                                  #'(error 'prefix-case "element ~e was not a prefix" e))]
+            [amb  (extract-clause "ambiguous" amb-clauses amb-clause->body 
+                                  #'(λ (opts) (error 'prefix-case "element matches more than one option: ~s" opts)))])
+       (with-syntax ([else-clause else]
+                     [amb-clause amb]
+                     [((option result) ...) rest])
+         #'(with-handlers ([exn:ambiguous-command? 
+                            (λ (e) (amb-clause (exn:ambiguous-command-possibilities e)))]
+                           [exn:unknown-command?
+                            (λ (e) else-clause)])
+             (((get-prefix-dispatcher (list (list option (λ () result)) ...))
+               elt)))))]))

scribblings/manual.scrbl

@@ -42,7 +42,7 @@
 Whalesong is a compiler from Racket to JavaScript; it takes Racket
 programs and translates them so that they can run stand-alone on a
 user's web browser.  It should allow Racket programs to run with
-little modification, and provide access through the foreign-function
+(hopefully!) little modification, and provide access through the foreign-function
 interface to native JavaScript APIs.  The included runtime library
 also includes a framework to programming the web in functional
 event-driven style.
@@ -73,14 +73,16 @@ Prerequisites: at least @link["http://racket-lang.org/"]{Racket
 
 @subsection{Installing Whalesong}
 
-At the time of this writing, Whalesong hasn't been deployed to
+At the time of this writing, although Whalesong has been deployed to
-@link["http://planet.racket-lang.org"]{PLaneT} yet, so getting it
+@link["http://planet.racket-lang.org"]{PLaneT}, what's up there is probably
+already out of date!  You may want to get the latest sources instead
+of using the version on PLaneT.  Doing so
 requires doing a little bit of manual work.  The steps are:
 
 @itemlist[
 @item{Check Whalesong out of Github.}
 @item{Set up the PLaneT development link to your local Whalesong instance.}
-@item{Run @tt{raco setup} over Whalesong to finish the installation}]
+@item{Run @link["http://docs.racket-lang.org/raco/setup.html"]{@tt{raco setup}} over Whalesong to finish the installation}]
 
 We can check it out of the source repository in
 @link["https://github.com/"]{GitHub}; the repository can be checked out by
@@ -96,6 +98,9 @@ then run this on your command line:
 @verbatim|{
 $ planet link dyoo whalesong.plt 1 0 whalesong
 }|
+(You may need to adjust the @tt{1} and @tt{0} major/minor numbers a bit to be larger
+than the latest version that's on PLaneT at the time.)
+
 
 
 Finally, we need to set up Whalesong with @tt{raco setup}.
@@ -123,9 +128,10 @@ and if this does appear, then Whalesong should be installed successfully.
 
 Let's try making a simple, standalone executable.  At the moment, the
 program must be written in the base language of @racket[(planet
-dyoo/whalesong)].  This restriction currently prevents arbitrary
+dyoo/whalesong)].  This restriction unfortunately  prevents arbitrary
-racket/base programs from compiling, and the developers will be working
+@racketmodname[racket/base] programs from compiling at the moment;
-to remove this restriction.
+the developers (namely, dyoo) will be working to remove this
+restriction as quickly as possible.
 
 
 Write a @filepath{hello.rkt} with the following content
@@ -135,13 +141,13 @@ Write a @filepath{hello.rkt} with the following content
     (display "hello world")
     (newline)
 }}
-This program can be executed in Racket,
+This program is a regular Racket program, and can be executed normally,
 @verbatim|{
 $ racket hello.rkt 
 hello world
 $
 }|
-and it can also be packaged with @filepath{whalesong}.
+However, it can also be packaged with @filepath{whalesong}.
 @verbatim|{
     $ whalesong build hello.rkt
 
@@ -206,6 +212,11 @@ web browser, we should see a pale, green page with some output.
 @section{Extended example}
 @;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(This example needs to use modules.  It should also show how we can use the
+other command-line options to compress the javascript, and how to
+use @tt{get-javascript} and @tt{get-runtime}, to allow the user to 
+build a customized html file.)
+
 
 
 
@@ -227,6 +238,24 @@ we can use.)
 (We also need an example that shows how to use the get-javascript and get-runtime
 commands to do something interesting...)
 
+@subsection{@tt{build}}
+
+@subsection{@tt{get-runtime}}
+
+@subsection{@tt{get-javascript}}
+
+
+
+@section{The JavaScript API}
+
+(This needs to describe what hooks we've got from the JavaScript side of things.
+
+In particular, we need to talk about the plt namespace constructed by the runtime,
+and the major, external bindings, like @tt{plt.runtime.invokeMains})
+
+
+
+
 
 @;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 @section{Internals}

whalesong.rkt

@@ -4,7 +4,9 @@
 (require racket/list
          racket/string
          "make/make-structs.rkt"
-         "js-assembler/package.rkt")
+         "js-assembler/package.rkt"
+         "private/command.rkt"
+         raco/command-name)
 
 
 ;; Usage:
@@ -47,8 +49,24 @@
           (string-join command-names ", ")))
 
 (define (at-toplevel)
-  (define args (vector->list (current-command-line-arguments)))
+  (svn-style-command-line
-  (cond [(empty? args)
+   #:program (short-program+command-name)
+   #:argv (current-command-line-arguments)
+   "The Whalesong command-line tool for compiling Racket to JavaScript"
+   ["build" "build a standalone xhtml package" 
+            "Builds a Racket program and its required dependencies into a standalone .xhtml file."
+            #:args paths
+            (do-the-build paths)]
+   ["get-runtime" "print the runtime library to standard output"
+                  "Prints the runtime JavaScript library that's used by Whalesong programs."
+                  #:args ()
+                  (print-the-runtime)]
+   ["get-javascript" "Gets just the JavaScript code and prints it to standard output"
+                     "Builds a racket program into JavaScript.  The outputted file depends on the runtime."
+                     #:args (file)
+                     (get-javascript-code file)])
+  #;(define args (vector->list (current-command-line-arguments)))
+  #;(cond [(empty? args)
          (print-expected-command)]
         [else
          (cond