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

fix quick doc build

Browse Source 
svn: r8253
This commit is contained in:
Matthew Flatt 2008-01-08 01:48:39 +00:00
parent 343308481a
commit eeb62f47f7
7 changed files with 23 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scribblings/guide/guide.scrbl
View File

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

4
collects/scribblings/quick/images/exprs.dat
View File

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

18
collects/scribblings/quick/mred-doc.ss
View File

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

30
collects/scribblings/quick/mreval.ss
View File

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

11
collects/scribblings/quick/quick.scrbl
View File

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

18
collects/scribblings/quick/slideshow-code-doc.ss
View File

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

30
collects/scribblings/quick/slideshow-doc.ss
View File

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