diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index aaaff28..0710adb 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -32,7 +32,8 @@ write-standalone-code get-runtime write-runtime - current-on-resource) + current-on-resource + get-html-template) @@ -376,6 +377,83 @@ EOF ) +;; get-html-template: string -> string +(define (get-html-template js) + (format #< + + + + + + + + + + + + +EOF + + js + )) + + ;; get-code: source -> string (define (get-code source-code) (let ([buffer (open-output-string)]) diff --git a/parameters.rkt b/parameters.rkt index 6956466..ef0ac01 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -16,7 +16,8 @@ current-warn-unimplemented-kernel-primitive current-seen-unimplemented-kernel-primitives current-kernel-module-locator? - current-compress-javascript?) + current-compress-javascript? + current-report-port) @@ -70,6 +71,11 @@ +(: current-report-port (Parameterof Output-Port)) +(define current-report-port (make-parameter (current-output-port))) + + + ;;; Do not touch the following parameters: they're used internally by package diff --git a/whalesong-helpers.rkt b/whalesong-helpers.rkt index f444c50..60a6513 100644 --- a/whalesong-helpers.rkt +++ b/whalesong-helpers.rkt @@ -7,7 +7,8 @@ "make/make-structs.rkt" "js-assembler/package.rkt" "resource/structs.rkt" - "logger.rkt") + "logger.rkt" + "parameters.rkt") (provide (all-defined-out)) @@ -16,6 +17,8 @@ (define current-output-dir (make-parameter (build-path (current-directory)))) (define current-write-resources? (make-parameter #t)) + + (define (same-file? p1 p2) (or (equal? (normalize-path p1) (normalize-path p2)) (bytes=? (call-with-input-file p1 port->bytes) @@ -37,7 +40,7 @@ (flush-output (current-error-port))])) (loop))))))) -(define (build f) +(define (build-standalone-xhtml f) (turn-on-logger!) (let-values ([(base filename dir?) (split-path f)]) @@ -47,10 +50,10 @@ (path->string filename) ".xhtml"))]) (unless (directory-exists? (current-output-dir)) + (fprintf (current-report-form) "Creating destination directory ~s" (current-output-dir)) (make-directory* (current-output-dir))) (parameterize ([current-on-resource (lambda (r) - (log-info (format "Writing resource ~s" (resource-path r))) (cond [(file-exists? (build-path (current-output-dir) (resource-key r))) @@ -63,9 +66,14 @@ (build-path (current-output-dir) (resource-key r)))])] [else + (fprintf (current-report-port) + (format "Writing resource ~s" (build-path (current-output-dir) + (resource-path r)))) (copy-file (resource-path r) (build-path (current-output-dir) (resource-key r)))]))]) + (fprintf (current-report-port) + (format "Writing program ~s" (build-path (current-output-port) output-filename))) (call-with-output-file* (build-path (current-output-dir) output-filename) (lambda (op) (package-standalone-xhtml @@ -75,6 +83,62 @@ +(define (build-html-and-javascript f) + (turn-on-logger!) + (let-values ([(base filename dir?) + (split-path f)]) + (let ([output-js-filename (build-path + (regexp-replace #rx"[.](rkt|ss)$" + (path->string filename) + ".js"))] + [output-html-filename + (build-path + (regexp-replace #rx"[.](rkt|ss)$" + (path->string filename) + ".html"))]) + (unless (directory-exists? (current-output-dir)) + (fprintf (current-report-form) "Creating destination directory ~s" (current-output-dir)) + (make-directory* (current-output-dir))) + (parameterize ([current-on-resource + (lambda (r) + (cond + [(file-exists? (build-path (current-output-dir) + (resource-key r))) + (cond [(same-file? (build-path (current-output-dir) + (resource-key r)) + (resource-path r)) + (void)] + [else + (error 'whalesong "Unable to write resource ~s; this will overwrite a file" + (build-path (current-output-dir) + (resource-key r)))])] + [else + (fprintf (current-report-port) + (format "Writing resource ~s" (build-path (current-output-dir) + (resource-path r)))) + (copy-file (resource-path r) + (build-path (current-output-dir) + (resource-key r)))]))]) + (fprintf (current-report-port) + (format "Writing program ~s" (build-path (current-output-port) output-js-filename))) + (call-with-output-file* (build-path (current-output-dir) output-js-filename) + (lambda (op) + (display (get-runtime) op) + (display (get-code (make-ModuleSource (build-path f))) + op)) + #:exists 'replace) + + (fprintf (current-report-port) + (format "Writing html ~s" (build-path (current-output-port) output-html-filename))) + (call-with-output-file* (build-path (current-output-dir) output-html-filename) + (lambda (op) + (display (get-html-template output-js-filename) op)) + #:exists 'replace) + )))) + + + + (define (print-the-runtime) (turn-on-logger!) (display (get-runtime) (current-output-port))) diff --git a/whalesong.rkt b/whalesong.rkt index 0db2870..b1ce3a4 100755 --- a/whalesong.rkt +++ b/whalesong.rkt @@ -37,8 +37,8 @@ #:program "whalesong" #: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." + ["build-xhtml" "build a standalone xhtml package" + "Builds a Racket program and its required dependencies into a .xhtml file." #:once-each [("-v" "--verbose") ("Display verbose messages.") @@ -51,7 +51,23 @@ ("Set destination directory (default: current-directory)") (current-output-dir dest-dir)] #:args (path) - (build path)] + (build-standalone-xhtml path)] + ["build" "build a standalone html and javascript package" + "Builds a Racket program and its required dependencies into a .html and .js file." + #:once-each + [("-v" "--verbose") + ("Display verbose messages.") + (current-verbose? #t)] + [("--compress-javascript") + ("Compress JavaScript with Google Closure (requires Java)") + (current-compress-javascript? #t)] + [("--dest-dir") + dest-dir + ("Set destination directory (default: current-directory)") + (current-output-dir dest-dir)] + #:args (path) + (build-html-and-javascript path)] + ["get-runtime" "print the runtime library to standard output" "Prints the runtime JavaScript library that's used by Whalesong programs." #:once-each