diff --git a/collects/scribblings/quick/exn.ss b/collects/scribblings/quick/exn.ss deleted file mode 100644 index 0489465706..0000000000 --- a/collects/scribblings/quick/exn.ss +++ /dev/null @@ -1,9 +0,0 @@ - -(module exn mzscheme - (require mzlib/serialize) - - (define-serializable-struct mr-exn (message)) - - (provide (struct mr-exn (message)))) - - diff --git a/collects/scribblings/quick/images/exprs.dat b/collects/scribblings/quick/images/exprs.dat index 734a83fb5a..1c405ec3aa 100644 --- a/collects/scribblings/quick/images/exprs.dat +++ b/collects/scribblings/quick/images/exprs.dat @@ -7,7 +7,7 @@ ((1) 0 () 0 () () (c rectangle c 10 c 20)) ((1) 2 (((lib "scribble/struct.ss") . deserialize-info:element-v0) ((lib "scribble/struct.ss") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img1.pdf") 1.0) (c "[image]"))))) ((1) 0 () 0 () () (c circle c 10 c 20)) -((1) 1 (((lib "scribblings/quick/exn.ss") . deserialize-info:mr-exn-v0)) 0 () () (0 "procedure circle: expects 1 argument, given 2: 10 20")) +((1) 1 (((lib "scriblib/private/mr-eval-exn.ss") . deserialize-info:gui-exn-v0)) 0 () () (0 "procedure circle: expects 1 argument, given 2: 10 20")) ((1) 0 () 0 () () (c hc-append c (c circle c 10) c (c rectangle c 10 c 20))) ((1) 2 (((lib "scribble/struct.ss") . deserialize-info:element-v0) ((lib "scribble/struct.ss") . deserialize-info:image-file-v0)) 0 () () (0 #f (c (0 (1 (u . "images/img2.pdf") 1.0) (c "[image]"))))) ((1) 0 () 0 () () (c define c c c (c circle c 10))) diff --git a/collects/scribblings/quick/images/img0.pdf b/collects/scribblings/quick/images/img0.pdf index beff370cc2..1f1d232289 100644 Binary files a/collects/scribblings/quick/images/img0.pdf and b/collects/scribblings/quick/images/img0.pdf differ diff --git a/collects/scribblings/quick/images/img1.pdf b/collects/scribblings/quick/images/img1.pdf index 5c70242db3..b58d655e7f 100644 Binary files a/collects/scribblings/quick/images/img1.pdf and b/collects/scribblings/quick/images/img1.pdf differ diff --git a/collects/scribblings/quick/images/img10.pdf b/collects/scribblings/quick/images/img10.pdf index 077d341243..202004913a 100644 --- a/collects/scribblings/quick/images/img10.pdf +++ b/collects/scribblings/quick/images/img10.pdf @@ -42,10 +42,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -55,8 +55,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -73,7 +73,7 @@ xref 0000000640 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [] +/ID [<5B9C18337FC8389A1DFF2A1017EF4F38><5B9C18337FC8389A1DFF2A1017EF4F38>] >> startxref 2278 diff --git a/collects/scribblings/quick/images/img11.pdf b/collects/scribblings/quick/images/img11.pdf index 10868b4f77..04a82e45b5 100644 Binary files a/collects/scribblings/quick/images/img11.pdf and b/collects/scribblings/quick/images/img11.pdf differ diff --git a/collects/scribblings/quick/images/img12.pdf b/collects/scribblings/quick/images/img12.pdf index 497a8f0ca5..36b9710aa3 100644 Binary files a/collects/scribblings/quick/images/img12.pdf and b/collects/scribblings/quick/images/img12.pdf differ diff --git a/collects/scribblings/quick/images/img13.pdf b/collects/scribblings/quick/images/img13.pdf index c64aca851c..8266f4fae1 100644 Binary files a/collects/scribblings/quick/images/img13.pdf and b/collects/scribblings/quick/images/img13.pdf differ diff --git a/collects/scribblings/quick/images/img14.pdf b/collects/scribblings/quick/images/img14.pdf index 81007a2929..c2b005af55 100644 --- a/collects/scribblings/quick/images/img14.pdf +++ b/collects/scribblings/quick/images/img14.pdf @@ -42,10 +42,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -55,8 +55,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -73,7 +73,7 @@ xref 0000000577 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [] +/ID [] >> startxref 2215 diff --git a/collects/scribblings/quick/images/img15.pdf b/collects/scribblings/quick/images/img15.pdf index a1d8495558..b1cbc9a987 100644 Binary files a/collects/scribblings/quick/images/img15.pdf and b/collects/scribblings/quick/images/img15.pdf differ diff --git a/collects/scribblings/quick/images/img16.pdf b/collects/scribblings/quick/images/img16.pdf index 74db5eb3b3..1a8ee8f3db 100644 --- a/collects/scribblings/quick/images/img16.pdf +++ b/collects/scribblings/quick/images/img16.pdf @@ -42,10 +42,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -55,8 +55,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -73,7 +73,7 @@ xref 0000000588 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [<69B6A830B23F42EA9BF1DDBF732CBB15><69B6A830B23F42EA9BF1DDBF732CBB15>] +/ID [<1AE0C6090561E21FACDD570510EAE550><1AE0C6090561E21FACDD570510EAE550>] >> startxref 2226 diff --git a/collects/scribblings/quick/images/img17.pdf b/collects/scribblings/quick/images/img17.pdf index 0c819fb7c9..c0d1d37f93 100644 Binary files a/collects/scribblings/quick/images/img17.pdf and b/collects/scribblings/quick/images/img17.pdf differ diff --git a/collects/scribblings/quick/images/img18.pdf b/collects/scribblings/quick/images/img18.pdf index 3a7600cf5a..da9f0d9756 100644 Binary files a/collects/scribblings/quick/images/img18.pdf and b/collects/scribblings/quick/images/img18.pdf differ diff --git a/collects/scribblings/quick/images/img19.pdf b/collects/scribblings/quick/images/img19.pdf index 3440feac20..8380ccb19f 100644 Binary files a/collects/scribblings/quick/images/img19.pdf and b/collects/scribblings/quick/images/img19.pdf differ diff --git a/collects/scribblings/quick/images/img2.pdf b/collects/scribblings/quick/images/img2.pdf index 74c52a3d6d..cb76bc3763 100644 --- a/collects/scribblings/quick/images/img2.pdf +++ b/collects/scribblings/quick/images/img2.pdf @@ -44,10 +44,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -57,8 +57,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -75,7 +75,7 @@ xref 0000000546 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [] +/ID [<390C745AD3529AFF7AA2F07ADD0F632F><390C745AD3529AFF7AA2F07ADD0F632F>] >> startxref 2184 diff --git a/collects/scribblings/quick/images/img20.pdf b/collects/scribblings/quick/images/img20.pdf index 74c34dfdeb..95bb37c2fa 100644 Binary files a/collects/scribblings/quick/images/img20.pdf and b/collects/scribblings/quick/images/img20.pdf differ diff --git a/collects/scribblings/quick/images/img21.pdf b/collects/scribblings/quick/images/img21.pdf index 37a6d91828..3f408c33b4 100644 Binary files a/collects/scribblings/quick/images/img21.pdf and b/collects/scribblings/quick/images/img21.pdf differ diff --git a/collects/scribblings/quick/images/img22.pdf b/collects/scribblings/quick/images/img22.pdf index 35dd60ffb0..f27ab75406 100644 Binary files a/collects/scribblings/quick/images/img22.pdf and b/collects/scribblings/quick/images/img22.pdf differ diff --git a/collects/scribblings/quick/images/img23.pdf b/collects/scribblings/quick/images/img23.pdf index f7d0dc6cb9..06be15da56 100644 Binary files a/collects/scribblings/quick/images/img23.pdf and b/collects/scribblings/quick/images/img23.pdf differ diff --git a/collects/scribblings/quick/images/img24.pdf b/collects/scribblings/quick/images/img24.pdf index 20529b0651..6e31d991b2 100644 Binary files a/collects/scribblings/quick/images/img24.pdf and b/collects/scribblings/quick/images/img24.pdf differ diff --git a/collects/scribblings/quick/images/img25.pdf b/collects/scribblings/quick/images/img25.pdf index 279cd23403..df7858d076 100644 --- a/collects/scribblings/quick/images/img25.pdf +++ b/collects/scribblings/quick/images/img25.pdf @@ -43,10 +43,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -56,8 +56,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -74,7 +74,7 @@ xref 0000000577 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [<75604C19F8497283D7E44AF2FE91D00A><75604C19F8497283D7E44AF2FE91D00A>] +/ID [] >> startxref 2215 diff --git a/collects/scribblings/quick/images/img26.pdf b/collects/scribblings/quick/images/img26.pdf index 186787dba1..dc8d47295f 100644 --- a/collects/scribblings/quick/images/img26.pdf +++ b/collects/scribblings/quick/images/img26.pdf @@ -42,10 +42,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -55,8 +55,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -73,7 +73,7 @@ xref 0000000622 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [<694B7C614AF7EA90FCDB118411A69C86><694B7C614AF7EA90FCDB118411A69C86>] +/ID [] >> startxref 2260 diff --git a/collects/scribblings/quick/images/img27.pdf b/collects/scribblings/quick/images/img27.pdf index f46ee985a5..d38263bd0c 100644 Binary files a/collects/scribblings/quick/images/img27.pdf and b/collects/scribblings/quick/images/img27.pdf differ diff --git a/collects/scribblings/quick/images/img28.pdf b/collects/scribblings/quick/images/img28.pdf index d0991d81a4..bfa4f6f371 100644 Binary files a/collects/scribblings/quick/images/img28.pdf and b/collects/scribblings/quick/images/img28.pdf differ diff --git a/collects/scribblings/quick/images/img29.pdf b/collects/scribblings/quick/images/img29.pdf index 8451f2874b..b67a155167 100644 Binary files a/collects/scribblings/quick/images/img29.pdf and b/collects/scribblings/quick/images/img29.pdf differ diff --git a/collects/scribblings/quick/images/img3.pdf b/collects/scribblings/quick/images/img3.pdf index 8daf9223a2..38eda2d263 100644 Binary files a/collects/scribblings/quick/images/img3.pdf and b/collects/scribblings/quick/images/img3.pdf differ diff --git a/collects/scribblings/quick/images/img4.pdf b/collects/scribblings/quick/images/img4.pdf index 9f1ad67277..1502bfe87f 100644 --- a/collects/scribblings/quick/images/img4.pdf +++ b/collects/scribblings/quick/images/img4.pdf @@ -44,10 +44,10 @@ endobj - -PLT Scheme - -Untitledmflatt@Macintosh \(Matthew Flatt\) + +PLT Scheme + +Untitledmflatt@Macintosh \(Matthew Flatt\) @@ -57,8 +57,8 @@ endstream endobj 2 0 obj <>endobj xref @@ -75,7 +75,7 @@ xref 0000000546 00000 n trailer << /Size 10 /Root 1 0 R /Info 2 0 R -/ID [<3B906556814EFBD523E9061C020AD58D><3B906556814EFBD523E9061C020AD58D>] +/ID [] >> startxref 2184 diff --git a/collects/scribblings/quick/images/img5.pdf b/collects/scribblings/quick/images/img5.pdf index 2c60618c19..ad579eb9f4 100644 Binary files a/collects/scribblings/quick/images/img5.pdf and b/collects/scribblings/quick/images/img5.pdf differ diff --git a/collects/scribblings/quick/images/img6.pdf b/collects/scribblings/quick/images/img6.pdf index 6004020783..16ddf01249 100644 Binary files a/collects/scribblings/quick/images/img6.pdf and b/collects/scribblings/quick/images/img6.pdf differ diff --git a/collects/scribblings/quick/images/img7.pdf b/collects/scribblings/quick/images/img7.pdf index ca15e67d85..f6abd6e42d 100644 Binary files a/collects/scribblings/quick/images/img7.pdf and b/collects/scribblings/quick/images/img7.pdf differ diff --git a/collects/scribblings/quick/images/img8.pdf b/collects/scribblings/quick/images/img8.pdf index d3b8f9fa90..a3ea212248 100644 Binary files a/collects/scribblings/quick/images/img8.pdf and b/collects/scribblings/quick/images/img8.pdf differ diff --git a/collects/scribblings/quick/images/img9.pdf b/collects/scribblings/quick/images/img9.pdf index 2cf63f4e19..85c0693208 100644 Binary files a/collects/scribblings/quick/images/img9.pdf and b/collects/scribblings/quick/images/img9.pdf differ diff --git a/collects/scribblings/quick/info.ss b/collects/scribblings/quick/info.ss index ba32a0f325..699ae531b2 100644 --- a/collects/scribblings/quick/info.ss +++ b/collects/scribblings/quick/info.ss @@ -1,4 +1,3 @@ #lang setup/infotab -(define scribblings '(("quick.scrbl" () (getting-started 9)) - ("mreval.scrbl"))) +(define scribblings '(("quick.scrbl" () (getting-started 9)))) diff --git a/collects/scribblings/quick/mreval.scrbl b/collects/scribblings/quick/mreval.scrbl deleted file mode 100644 index 042cb9ccb5..0000000000 --- a/collects/scribblings/quick/mreval.scrbl +++ /dev/null @@ -1,21 +0,0 @@ -#lang scribble/manual -@(require (for-label scribble/eval "mreval.ss")) - -@title{Writing Examples with Pict Results} - -@defmodule[scribblings/quick/mreval]{The -@schememodname[scribblings/quick/mreval] library support example -evaluations with results that are @schememodname[slideshow] picts.} - -@defform[(mr-interaction datum ...)]{ - -Like @scheme[interaction], but using an evaluator that includes -@schememodname[scheme/gui/base] and @schememodname[slideshow]. - -The trick is that @schememodname[scheme/gui] is not generally -available when rendering documentation, because it requires a GUI -context. The picture output is rendered to an image file when the -@envvar{MREVAL} environment variable is set, so run the enclosing -document once with the environment varibale to generate the -images. Future runs (with the environment variable unset) use the -generated image.} diff --git a/collects/scribblings/quick/mreval.ss b/collects/scribblings/quick/mreval.ss index 39c4931c1a..f717181c70 100644 --- a/collects/scribblings/quick/mreval.ss +++ b/collects/scribblings/quick/mreval.ss @@ -1,141 +1,11 @@ +#lang scheme/base -(module mreval mzscheme - (require scribble/eval - scribble/struct - scribble/scheme - mzlib/class - mzlib/file - mzlib/runtime-path - mzlib/serialize - scribblings/quick/exn - scheme/system) - - (define-syntax define-mr - (syntax-rules () - [(_ mr orig) - (begin - (provide mr) - (define-syntax mr - (syntax-rules () - [(_ x (... ...)) - (parameterize ([scribble-eval-handler mr-eval-handler]) - (orig #:eval mr-eval x (... ...)))])))])) - - (define mr-eval (make-base-eval)) - - (define-mr mr-interaction interaction) - (define-mr mr-interaction-eval interaction-eval) - (define-mr mr-interaction-eval-show interaction-eval-show) - (define-mr mr-def+int def+int) - (define-mr mr-defs+int defs+int) - (define-mr mr-schememod+eval schememod+eval) - (define-mr mr-schemeblock+eval schemeblock+eval) - - (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 - - ;; This one can be absolute: - (define exprs-dat-file (build-path "images" - "exprs.dat")) - - (define mr-eval-handler - (if mred? - (let ([eh (scribble-eval-handler)] - [log-file (open-output-file exprs-dat-file 'truncate/replace)]) - (lambda (ev catching-exns? expr) - (write (serialize (if (syntax? expr) (syntax-object->datum expr) expr)) log-file) - (newline log-file) - (flush-output log-file) - (let ([result - (with-handlers ([exn:fail? - (lambda (exn) - (make-mr-exn (exn-message exn)))]) - (eh ev catching-exns? expr))]) - (let ([result (fixup-picts result)]) - (write (serialize result) log-file) - (newline log-file) - (flush-output log-file) - (if (mr-exn? result) - (raise (make-exn:fail - (mr-exn-message result) - (current-continuation-marks))) - result))))) - (let ([log-file (with-handlers ([exn:fail:filesystem? - (lambda (exn) - (open-input-string ""))]) - (open-input-file exprs-dat-file))]) - (lambda (ev catching-exns? expr) - (with-handlers ([exn:fail? (lambda (exn) - (if catching-exns? - (raise exn) - (void)))]) - (let ([v (read log-file)]) - (if (eof-object? v) - (error "expression not in log file") - (let ([v (deserialize v)]) - (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") - (let ([v (deserialize v)]) - (if (mr-exn? v) - (raise (make-exn:fail - (mr-exn-message v) - (current-continuation-marks))) - v)))) - (error 'mreval - "expression does not match log file: ~e versus: ~e" - expr - v)))))))))) - - (define image-counter 0) - - ;; This path will be marshaled for use on multiple platforms - (define (build-string-path a b) (string-append a "/" b)) - - (define (fixup-picts v) - (cond - [((mr-eval 'pict?) v) - (let ([fn (build-string-path img-dir - (format "img~a.png" image-counter))]) - (set! image-counter (add1 image-counter)) - (let ([dc (let ([pss (make-object (mr-eval 'ps-setup%))]) - (send pss set-mode 'file) - (send pss set-file (path-replace-suffix fn #".ps")) - (parameterize ([(mr-eval 'current-ps-setup) pss]) - (make-object (mr-eval 'post-script-dc%) #f)))]) - (send dc start-doc "Image") - (send dc start-page) - (((mr-eval 'make-pict-drawer) v) dc 0 0) - (send dc end-page) - (send dc end-doc) - (system (format "epstopdf ~a" (path-replace-suffix fn #".ps")))) - (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) - (((mr-eval 'make-pict-drawer) v) dc 0 0) - (send bm save-file fn 'png) - (make-element #f (list (make-element (make-image-file - ;; For HTML output, .pdf is automatically changed to .png. - ;; Be sure to use a string rather than a path, because - ;; it gets recorded in "exprs.dat". - (path->string (path-replace-suffix fn #".pdf")) - 1.0) - (list "[image]"))))))] - [(pair? v) (cons (fixup-picts (car v)) - (fixup-picts (cdr v)))] - [(serializable? v) v] - [else (make-element #f (list (format "~s" v)))]))) +(require scriblib/gui-eval) +(provide (rename-out [gui-interaction mr-interaction] + [gui-interaction-eval mr-interaction-eval] + [gui-schememod+eval mr-schememod+eval] + [gui-schemeblock+eval mr-schemeblock+eval] + [gui-def+int mr-def+int] + [gui-defs+int mr-defs+int] + [gui-interaction-eval-show mr-interaction-eval-show])) diff --git a/collects/scriblib/gui-eval.ss b/collects/scriblib/gui-eval.ss new file mode 100644 index 0000000000..e2ccbcfc06 --- /dev/null +++ b/collects/scriblib/gui-eval.ss @@ -0,0 +1,140 @@ +#lang scheme/base + +(require scribble/eval + scribble/struct + scribble/scheme + scheme/class + scheme/file + scheme/runtime-path + scheme/serialize + "private/mr-eval-exn.ss" + scheme/system) + +(define-syntax define-mr + (syntax-rules () + [(_ mr orig) + (begin + (provide mr) + (define-syntax mr + (syntax-rules () + [(_ x (... ...)) + (parameterize ([scribble-eval-handler gui-eval-handler]) + (orig #:eval gui-eval x (... ...)))])))])) + +(define gui-eval (make-base-eval)) + +(define-mr gui-interaction interaction) +(define-mr gui-interaction-eval interaction-eval) +(define-mr gui-interaction-eval-show interaction-eval-show) +(define-mr gui-def+int def+int) +(define-mr gui-defs+int defs+int) +(define-mr gui-schememod+eval schememod+eval) +(define-mr gui-schemeblock+eval schemeblock+eval) + +(define mred? (getenv "MREVAL")) + +(when mred? + (gui-eval '(require scheme/gui/base)) + (gui-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 + +;; This one can be absolute: +(define exprs-dat-file (build-path "images" + "exprs.dat")) + +(define gui-eval-handler + (if mred? + (let ([eh (scribble-eval-handler)] + [log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)]) + (lambda (ev catching-exns? expr) + (write (serialize (if (syntax? expr) (syntax->datum expr) expr)) log-file) + (newline log-file) + (flush-output log-file) + (let ([result + (with-handlers ([exn:fail? + (lambda (exn) + (make-gui-exn (exn-message exn)))]) + (eh ev catching-exns? expr))]) + (let ([result (fixup-picts result)]) + (write (serialize result) log-file) + (newline log-file) + (flush-output log-file) + (if (gui-exn? result) + (raise (make-exn:fail + (gui-exn-message result) + (current-continuation-marks))) + result))))) + (let ([log-file (with-handlers ([exn:fail:filesystem? + (lambda (exn) + (open-input-string ""))]) + (open-input-file exprs-dat-file))]) + (lambda (ev catching-exns? expr) + (with-handlers ([exn:fail? (lambda (exn) + (if catching-exns? + (raise exn) + (void)))]) + (let ([v (read log-file)]) + (if (eof-object? v) + (error "expression not in log file") + (let ([v (deserialize v)]) + (if (equal? v (if (syntax? expr) + (syntax->datum expr) + expr)) + (let ([v (read log-file)]) + (if (eof-object? v) + (error "expression result missing in log file") + (let ([v (deserialize v)]) + (if (gui-exn? v) + (raise (make-exn:fail + (gui-exn-message v) + (current-continuation-marks))) + v)))) + (error 'mreval + "expression does not match log file: ~e versus: ~e" + expr + v)))))))))) + +(define image-counter 0) + +;; This path will be marshaled for use on multiple platforms +(define (build-string-path a b) (string-append a "/" b)) + +(define (fixup-picts v) + (cond + [((gui-eval 'pict?) v) + (let ([fn (build-string-path img-dir + (format "img~a.png" image-counter))]) + (set! image-counter (add1 image-counter)) + (let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))]) + (send pss set-mode 'file) + (send pss set-file (path-replace-suffix fn #".ps")) + (parameterize ([(gui-eval 'current-ps-setup) pss]) + (make-object (gui-eval 'post-script-dc%) #f)))]) + (send dc start-doc "Image") + (send dc start-page) + (((gui-eval 'make-pict-drawer) v) dc 0 0) + (send dc end-page) + (send dc end-doc) + (system (format "epstopdf ~a" (path-replace-suffix fn #".ps")))) + (let* ([bm (make-object (gui-eval 'bitmap%) + (inexact->exact (ceiling ((gui-eval 'pict-width) v))) + (inexact->exact (ceiling ((gui-eval 'pict-height) v))))] + [dc (make-object (gui-eval 'bitmap-dc%) bm)]) + (send dc set-smoothing 'aligned) + (send dc clear) + (((gui-eval 'make-pict-drawer) v) dc 0 0) + (send bm save-file fn 'png) + (make-element #f (list (make-element (make-image-file + ;; For HTML output, .pdf is automatically changed to .png. + ;; Be sure to use a string rather than a path, because + ;; it gets recorded in "exprs.dat". + (path->string (path-replace-suffix fn #".pdf")) + 1.0) + (list "[image]"))))))] + [(pair? v) (cons (fixup-picts (car v)) + (fixup-picts (cdr v)))] + [(serializable? v) v] + [else (make-element #f (list (format "~s" v)))])) diff --git a/collects/scriblib/private/mr-eval-exn.ss b/collects/scriblib/private/mr-eval-exn.ss new file mode 100644 index 0000000000..daad531f69 --- /dev/null +++ b/collects/scriblib/private/mr-eval-exn.ss @@ -0,0 +1,6 @@ +#lang scheme/base +(require mzlib/serialize) + +(define-serializable-struct gui-exn (message)) + +(provide (struct-out gui-exn)) diff --git a/collects/scriblib/scribblings/gui-eval.scrbl b/collects/scriblib/scribblings/gui-eval.scrbl new file mode 100644 index 0000000000..84d1e06e5c --- /dev/null +++ b/collects/scriblib/scribblings/gui-eval.scrbl @@ -0,0 +1,31 @@ +#lang scribble/manual +@(require (for-label scribble/eval scriblib/gui-eval)) + +@title[#:tag "gui-eval"]{Writing Examples with Pict Results} + +@defmodule[scriblib/gui-eval]{The +@schememodname[scriblib/gui-eval] library support example +evaluations with results that are @schememodname[slideshow] picts.} + +The trick is that @schememodname[scheme/gui] is not generally +available when rendering documentation, because it requires a GUI +context. The picture output is rendered to an image file when the +@envvar{MREVAL} environment variable is set, so run the enclosing +document once with the environment varibale to generate the +images. Future runs (with the environment variable unset) use the +generated image. + +@deftogether[( +@defform[(gui-interaction datum ...)] +@defform[(gui-interaction-eval datum ...)] +@defform[(gui-interaction-eval-show datum ...)] +@defform[(gui-schemeblock+eval datum ...)] +@defform[(gui-schememod+eval datum ...)] +@defform[(gui-def+int datum ...)] +@defform[(gui-defs+int datum ...)] +)]{ + +Like @scheme[interaction], etc., but actually evaluating the forms +only when the @envvar{MREVAL} environment variable is set, and then in +an evaluator that is initialized with @schememodname[scheme/gui/base] +and @schememodname[slideshow]. } diff --git a/collects/scriblib/scribblings/info.ss b/collects/scriblib/scribblings/info.ss new file mode 100644 index 0000000000..e7e57e0483 --- /dev/null +++ b/collects/scriblib/scribblings/info.ss @@ -0,0 +1,3 @@ +#lang setup/infotab + +(define scribblings '(("scriblib.scrbl" (multi-page)))) diff --git a/collects/scriblib/scribblings/scriblib.scrbl b/collects/scriblib/scribblings/scriblib.scrbl new file mode 100644 index 0000000000..cf0006540e --- /dev/null +++ b/collects/scriblib/scribblings/scriblib.scrbl @@ -0,0 +1,7 @@ +#lang scribble/manual + +@title{@bold{Scriblib}: Extra Scribble Libraries} + +@table-of-contents[] + +@include-section["gui-eval.scrbl"]