From eeb62f47f734f7001c58f05e07dc3a77088f581b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 8 Jan 2008 01:48:39 +0000 Subject: [PATCH] fix quick doc build svn: r8253 --- collects/scribblings/guide/guide.scrbl | 2 +- collects/scribblings/quick/images/exprs.dat | 4 +-- collects/scribblings/quick/mred-doc.ss | 18 ----------- collects/scribblings/quick/mreval.ss | 30 +++++++++++-------- collects/scribblings/quick/quick.scrbl | 11 ++----- .../scribblings/quick/slideshow-code-doc.ss | 18 ----------- collects/scribblings/quick/slideshow-doc.ss | 30 ------------------- 7 files changed, 23 insertions(+), 90 deletions(-) delete mode 100644 collects/scribblings/quick/mred-doc.ss delete mode 100644 collects/scribblings/quick/slideshow-code-doc.ss delete mode 100644 collects/scribblings/quick/slideshow-doc.ss diff --git a/collects/scribblings/guide/guide.scrbl b/collects/scribblings/guide/guide.scrbl index 327f6c0130..c04bf9b594 100644 --- a/collects/scribblings/guide/guide.scrbl +++ b/collects/scribblings/guide/guide.scrbl @@ -122,7 +122,7 @@ normally used by C programs. "top"]} describes the PLT Scheme web server, which supports servlets implemented in Scheme. -@italic{@secref[#:doc '(lib "scribblings/start/start.scrbl") "top"]} provides +@secref[#:doc '(lib "scribblings/start/start.scrbl") "top"] provides links to documentation for many other libraries distributed with PLT Scheme or installed on your system. diff --git a/collects/scribblings/quick/images/exprs.dat b/collects/scribblings/quick/images/exprs.dat index ca1a53b852..cb255120f7 100644 --- a/collects/scribblings/quick/images/exprs.dat +++ b/collects/scribblings/quick/images/exprs.dat @@ -1,6 +1,6 @@ ((1) 0 () 0 () () 5) ((1) 0 () 0 () () 5) -((1) 0 () 0 () () "art gallery") +((1) 0 () 0 () () (c begin c "art gallery")) ((1) 0 () 0 () () "art gallery") ((1) 0 () 0 () () (c circle c 10)) ((1) 2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img0.png")) (c "[image]"))))) @@ -75,7 +75,7 @@ ((1) 0 () 0 () () (c require c (c planet c "random.ss" c (c "schematics" c "random.plt" c 1 c 0)))) ((1) 0 () 0 () () (void)) ((1) 0 () 0 () () (c random-gaussian)) -((1) 0 () 0 () () 0.9050686838895684) +((1) 0 () 0 () () 0.7386912134436788) ((1) 0 () 0 () () (c require c slideshow/code)) ((1) 0 () 0 () () (void)) ((1) 0 () 0 () () (c code c (c circle c 10))) diff --git a/collects/scribblings/quick/mred-doc.ss b/collects/scribblings/quick/mred-doc.ss deleted file mode 100644 index 12551c01bc..0000000000 --- a/collects/scribblings/quick/mred-doc.ss +++ /dev/null @@ -1,18 +0,0 @@ -(module mred-doc mzscheme - - (define mr-eval? (getenv "MREVAL")) - - (define-syntax bounce - (syntax-rules () - [(_ id) - (begin - (provide id) - (define id (if mr-eval? - (dynamic-require '(lib "mred/mred.ss") 'id) - #f)))] - [(_ id ...) - (begin (bounce id) ...)])) - - (bounce frame% canvas% - bitmap% bitmap-dc% - color%)) diff --git a/collects/scribblings/quick/mreval.ss b/collects/scribblings/quick/mreval.ss index fcf1065827..310bda7e58 100644 --- a/collects/scribblings/quick/mreval.ss +++ b/collects/scribblings/quick/mreval.ss @@ -7,8 +7,6 @@ (lib "file.ss") (lib "runtime-path.ss") (lib "serialize.ss") - "slideshow-doc.ss" - "mred-doc.ss" (lib "exn.ss" "scribblings" "quick")) (define-syntax define-mr @@ -20,7 +18,9 @@ (syntax-rules () [(_ x (... ...)) (parameterize ([scribble-eval-handler mr-eval-handler]) - (orig x (... ...)))])))])) + (orig #:eval mr-eval x (... ...)))])))])) + + (define mr-eval (make-base-eval)) (define-mr mr-interaction interaction) (define-mr mr-interaction-eval interaction-eval) @@ -32,6 +32,10 @@ (define mred? (getenv "MREVAL")) + (when mred? + (mr-eval '(require scheme/gui/base)) + (mr-eval '(require slideshow))) + ;; This one needs to be relative, because it ends up in the ;; exprs.dat file: (define img-dir "images") ; relative to src dir @@ -45,7 +49,7 @@ (let ([eh (scribble-eval-handler)] [log-file (open-output-file exprs-dat-file 'truncate/replace)]) (lambda (ev catching-exns? expr) - (write (serialize (syntax-object->datum expr)) log-file) + (write (serialize (if (syntax? expr) (syntax-object->datum expr) expr)) log-file) (newline log-file) (flush-output log-file) (let ([result @@ -75,7 +79,9 @@ (if (eof-object? v) (error "expression not in log file") (let ([v (deserialize v)]) - (if (equal? v (syntax-object->datum expr)) + (if (equal? v (if (syntax? expr) + (syntax-object->datum expr) + expr)) (let ([v (read log-file)]) (if (eof-object? v) (error "expression result missing in log file") @@ -90,8 +96,6 @@ expr v)))))))))) - (define mr-namespace (current-namespace)) - (define image-counter 0) ;; This path will be marshaled for use on multiple platforms @@ -99,17 +103,17 @@ (define (fixup-picts v) (cond - [(pict? v) + [((mr-eval 'pict?) v) (let ([fn (build-string-path img-dir (format "img~a.png" image-counter))]) (set! image-counter (add1 image-counter)) - (let* ([bm (make-object bitmap% - (inexact->exact (ceiling (pict-width v))) - (inexact->exact (ceiling (pict-height v))))] - [dc (make-object bitmap-dc% bm)]) + (let* ([bm (make-object (mr-eval 'bitmap%) + (inexact->exact (ceiling ((mr-eval 'pict-width) v))) + (inexact->exact (ceiling ((mr-eval 'pict-height) v))))] + [dc (make-object (mr-eval 'bitmap-dc%) bm)]) (send dc set-smoothing 'aligned) (send dc clear) - ((make-pict-drawer v) dc 0 0) + (((mr-eval 'make-pict-drawer) v) dc 0 0) (send bm save-file fn 'png) (make-element #f (list (make-element (make-image-file fn) (list "[image]"))))))] [(pair? v) (cons (fixup-picts (car v)) diff --git a/collects/scribblings/quick/quick.scrbl b/collects/scribblings/quick/quick.scrbl index 88a30bfdd4..580d889334 100644 --- a/collects/scribblings/quick/quick.scrbl +++ b/collects/scribblings/quick/quick.scrbl @@ -10,22 +10,17 @@ scribble/urls scribble/struct scheme/class - "slideshow-doc.ss" - "slideshow-code-doc.ss" - "mred-doc.ss" (for-label scheme/base scheme/gui/base scheme/class - slideshow) + slideshow + slideshow/code + slideshow/flash) (for-syntax scheme/base)) @(begin - (define filled-flash (lambda args (apply (eval 'filled-flash) args))) - (define random-gaussian (lambda args (apply (eval 'random-gaussian) args))) - (define-syntax code (syntax-rules () [(_ v) (typeset-code (quote-syntax v))])) - (provide filled-flash random-gaussian code) (define (keep-file file) (make-delayed-element (lambda (render part ri) diff --git a/collects/scribblings/quick/slideshow-code-doc.ss b/collects/scribblings/quick/slideshow-code-doc.ss deleted file mode 100644 index 3f8786fd0c..0000000000 --- a/collects/scribblings/quick/slideshow-code-doc.ss +++ /dev/null @@ -1,18 +0,0 @@ -(module slideshow-code-doc mzscheme - (require (only "slideshow-doc.ss")) - - (define mr-eval? (getenv "MREVAL")) - - (define-syntax bounce - (syntax-rules () - [(_ id) - (begin - (provide id) - (define id (if mr-eval? - (dynamic-require '(lib "code.ss" "slideshow") 'id) - #f)))] - [(_ id ...) - (begin (bounce id) ...)])) - - (bounce typeset-code)) - diff --git a/collects/scribblings/quick/slideshow-doc.ss b/collects/scribblings/quick/slideshow-doc.ss deleted file mode 100644 index 5012421a4d..0000000000 --- a/collects/scribblings/quick/slideshow-doc.ss +++ /dev/null @@ -1,30 +0,0 @@ -(module slideshow-doc mzscheme - - (define mr-eval? (getenv "MREVAL")) - - (when mr-eval? - (parameterize ([current-command-line-arguments #()]) - (dynamic-require '(lib "slideshow/main.ss") #f))) - - (define-syntax bounce - (syntax-rules () - [(_ id) - (begin - (provide id) - (define id (if mr-eval? - (dynamic-require '(lib "slideshow/main.ss") 'id) - #f)))] - [(_ id ...) - (begin (bounce id) ...)])) - - (bounce circle - rectangle - hc-append - filled-rectangle - vc-append - colorize - scale - bitmap - make-pict-drawer - - pict? pict-width pict-height))