initial support for offline webapp

This commit is contained in:
Danny Yoo 2011-09-26 12:30:42 -04:00
parent 37b788cd37
commit f7bcbff5ed
2 changed files with 34 additions and 9 deletions

View File

@ -490,15 +490,17 @@ EOF
) )
;; get-html-template: (listof string) -> string ;; get-html-template: (listof string) (#:manifest path) -> string
(define (get-html-template js-files) (define (get-html-template js-files
#:manifest (manifest #f)
#:title (title ""))
(format #<<EOF (format #<<EOF
<!DOCTYPE html> <!DOCTYPE html>
<html> <html ~a>
<head> <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 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"/> <meta charset="utf-8"/>
<title></title> <title>~a</title>
~a ~a
<script> <script>
~a ~a
@ -508,7 +510,8 @@ EOF
</body> </body>
</html> </html>
EOF EOF
(if manifest (format "manifest=~s" (path->string manifest)) "")
title
(string-join (map (lambda (js) (string-join (map (lambda (js)
(format " <script src='~a'></script>\n" js)) (format " <script src='~a'></script>\n" js))
js-files) js-files)

View File

@ -88,6 +88,7 @@
(turn-on-logger!) (turn-on-logger!)
(define written-js-paths '()) (define written-js-paths '())
(define written-resources '())
(define make-output-js-filename (define make-output-js-filename
(let ([n 0]) (let ([n 0])
(lambda () (lambda ()
@ -105,11 +106,20 @@
(define start-time (current-inexact-milliseconds)) (define start-time (current-inexact-milliseconds))
(let ([output-html-filename (let ([title
(regexp-replace #rx"([.](rkt|ss))$"
(path->string (file-name-from-path f))
"")]
[output-html-filename
(build-path (build-path
(regexp-replace #rx"[.](rkt|ss)$" (regexp-replace #rx"[.](rkt|ss)$"
(path->string (file-name-from-path f)) (path->string (file-name-from-path f))
".html"))]) ".html"))]
[output-manifest-filename
(build-path
(regexp-replace #rx"[.](rkt|ss)$"
(path->string (file-name-from-path f))
".manifest"))])
(unless (directory-exists? (current-output-dir)) (unless (directory-exists? (current-output-dir))
(fprintf (current-report-port) "Creating destination directory ~s\n" (current-output-dir)) (fprintf (current-report-port) "Creating destination directory ~s\n" (current-output-dir))
(make-directory* (current-output-dir))) (make-directory* (current-output-dir)))
@ -137,7 +147,8 @@
(resource-key r)))) (resource-key r))))
(copy-file (resource-path r) (copy-file (resource-path r)
(build-path (current-output-dir) (build-path (current-output-dir)
(resource-key r)))]))]) (resource-key r)))])
(set! written-resources (cons (resource-key r) written-resources)))])
(call-with-output-file* (make-output-js-filename) (call-with-output-file* (make-output-js-filename)
(lambda (op) (lambda (op)
(display (get-runtime) op) (display (get-runtime) op)
@ -153,9 +164,20 @@
(lambda (op) (lambda (op)
(display (get-html-template (display (get-html-template
(map file-name-from-path (map file-name-from-path
(reverse written-js-paths))) (reverse written-js-paths))
#:title title
#:manifest output-manifest-filename)
op)) op))
#:exists 'replace) #:exists 'replace)
;; Write the manifest
(call-with-output-file* (build-path (current-output-dir) output-manifest-filename)
(lambda (op)
(fprintf op "CACHE MANIFEST\n")
(for [(js-name (map file-name-from-path (reverse written-js-paths)))]
(fprintf op "~a\n" js-name))
(for [(resource-name written-resources)]
(fprintf op "~a\n" resource-name)))
#:exists 'replace)
(define stop-time (current-inexact-milliseconds)) (define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time))))) (fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time)))))