From 5962e542f78d7daaa390f38995469c261509c59f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 21 May 2012 12:07:45 -0600
Subject: [PATCH] slideshow: add `slide->pict'

---
 collects/scribblings/slideshow/slides.scrbl | 15 +++++++++++----
 collects/slideshow/base.rkt                 |  2 +-
 collects/slideshow/core.rkt                 |  6 ++++++
 collects/slideshow/sig.rkt                  |  2 +-
 collects/slideshow/slide.rkt                |  2 +-
 5 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/collects/scribblings/slideshow/slides.scrbl b/collects/scribblings/slideshow/slides.scrbl
index 6f2de64439..b1515c17f8 100644
--- a/collects/scribblings/slideshow/slides.scrbl
+++ b/collects/scribblings/slideshow/slides.scrbl
@@ -239,10 +239,16 @@ Returns @racket[#t] if @racket[v] is a comment produced by
 
 @section{Slide Registration}
 
+@defproc[(slide? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is a slide produced by
+@racket[most-recent-slide] or @racket[retract-most-recent-slide].}
+
 @defproc[(most-recent-slide) slide?]{
 
 Returns a slide structure that be supplied @racket[re-slide] to make a
-copy of the slide.}
+copy of the slide or @racket[slide->pict] to re-extract the entire
+slide as a pict.}
 
 @defproc[(retract-most-recent-slide) slide?]{
 
@@ -256,10 +262,11 @@ structure that be supplied to @racket[re-slide] to restore the slide
 Re-inserts a slide, @racket[lt-superimpose]ing the given additional
 @racket[pict].}
 
-@defproc[(slide? [v any/c]) boolean?]{
+@defproc[(slide->pict [slide slide?])
+         pict?]{
 
-Returns @racket[#t] if @racket[v] is a slide produced by
-@racket[most-recent-slide] or @racket[retract-most-recent-slide].}
+Converts a complete slide to a @racket[pict]. The bounding box of the
+result corresponds to the slide within its margins.}
 
 @; ------------------------------------------------------------------------
 
diff --git a/collects/slideshow/base.rkt b/collects/slideshow/base.rkt
index 8300f14bfa..98f366f1b7 100644
--- a/collects/slideshow/base.rkt
+++ b/collects/slideshow/base.rkt
@@ -24,7 +24,7 @@
                        [sliderec? slide?]
                        [just-a-comment? comment?])
            comment
-           most-recent-slide retract-most-recent-slide re-slide start-at-recent-slide
+           most-recent-slide retract-most-recent-slide re-slide slide->pict start-at-recent-slide
 	   make-outline
 	   (rename-out [item/kw item]
                        [subitem/kw subitem]
diff --git a/collects/slideshow/core.rkt b/collects/slideshow/core.rkt
index 0de2168d96..880cc933fa 100644
--- a/collects/slideshow/core.rkt
+++ b/collects/slideshow/core.rkt
@@ -560,6 +560,12 @@
 	    null
             (sliderec-timeout s)))
 	  (set! page-number (+ page-number 1))))
+      
+      (define (slide->pict s)
+        (unless (sliderec? s)
+          (raise-type-error 'slide->pict "slide" s))
+        (let ([orig (sliderec-drawer s)])
+          (dc orig client-w client-h)))
 
       (define (start-at-recent-slide)
 	(viewer:set-init-page! (max 0 (- page-number 2))))
diff --git a/collects/slideshow/sig.rkt b/collects/slideshow/sig.rkt
index ced7449fdb..879dd96ed2 100644
--- a/collects/slideshow/sig.rkt
+++ b/collects/slideshow/sig.rkt
@@ -55,7 +55,7 @@
      slide/center/timeout
      slide/title/center/timeout
      
-     most-recent-slide retract-most-recent-slide re-slide start-at-recent-slide
+     most-recent-slide retract-most-recent-slide re-slide slide->pict start-at-recent-slide
      scroll-transition pause-transition
      comment make-outline
      item/kw item item* page-item page-item*
diff --git a/collects/slideshow/slide.rkt b/collects/slideshow/slide.rkt
index 869c2ca342..7d61efd32a 100644
--- a/collects/slideshow/slide.rkt
+++ b/collects/slideshow/slide.rkt
@@ -102,7 +102,7 @@
                     [rt (string? . -> . pict?)]
                     [tt* (() () #:rest (listof string?) . ->* . pict?)])
   (provide slide/kw
-           most-recent-slide retract-most-recent-slide re-slide start-at-recent-slide
+           most-recent-slide retract-most-recent-slide re-slide slide->pict start-at-recent-slide
 	   scroll-transition pause-transition
 	   make-outline
 	   item item* page-item page-item*