suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changing build to write html and js separately

Browse Source
This commit is contained in:
Danny Yoo 2011-09-03 15:11:47 -04:00
parent 4bc4f0c15c
commit e36dddf430
4 changed files with 172 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
js-assembler/package.rkt
View File

@ -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
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<meta name="viewport" content="initial-scale=1.0, width=device-width, height=device-height, minimum-scale=1.0, maximum-scale=1.0, user-scalable=no" />
<meta charset="utf-8"/>
<title></title>
</head>
<script src="~a"></script>
<script>
var invokeMainModule = function() {
var MACHINE = plt.runtime.currentMachine;
invoke(MACHINE,
function() {
var startTime = new Date().valueOf();
plt.runtime.invokeMains(
MACHINE,
function() {
// On main module invokation success:
var stopTime = new Date().valueOf();
if (window.console && window.console.log) {
window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
}
},
function(MACHINE, e) {
var contMarkSet, appNames, i, appName;
// On main module invokation failure
if (window.console && window.console.log) {
window.console.log(e.stack || e);
}
MACHINE.params.currentErrorDisplayer(
MACHINE, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));
if (e.hasOwnProperty('racketError') &&
plt.baselib.exceptions.isExn(e.racketError)) {
contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
if (contMarkSet) {
appNames = contMarkSet.ref(plt.runtime.getTracedAppKey(MACHINE));
while (plt.baselib.lists.isPair(appNames)) {
appName = appNames.first;
MACHINE.params.currentErrorDisplayer(
MACHINE,
$('<div/>').text(' at ' + appName.elts[0] +
', line ' + appName.elts[2] +
', column ' + appName.elts[3])
.addClass('stacktrace')
.css('margin-left', '10px')
.css('whitespace', 'pre')
.css('color', 'red'));
appNames = appNames.rest;
}
}
}
})},
function() {
// On module loading failure
if (window.console && window.console.log) {
window.console.log(e.stack || e);
}
},
{});
};
$(document).ready(invokeMainModule);
</script>
</head>
<body>
</body>
</html>
EOF
js
))
;; get-code: source -> string
(define (get-code source-code)
(let ([buffer (open-output-string)])

8
parameters.rkt
View File

@ -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

70
whalesong-helpers.rkt
View File

@ -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)))

22
whalesong.rkt
View File

@ -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