slideshow fixes

svn: r8035

collects/scheme/private/with-stx.ss

@@ -74,6 +74,8 @@
 		(datum->syntax #f (append-number x))]
 	       [(string? x)
 		(datum->syntax #f (append-number x))]
+	       [(keyword? x)
+		(datum->syntax #f (append-number (keyword->string x)))]
 	       [(identifier? x)
 		(datum->syntax #f (append-number (syntax-e x)))]
 	       [else 

collects/scribblings/reference/stx-ops.scrbl

@@ -189,7 +189,7 @@ Returns a list of identifiers that are distinct from all other
 identifiers. The list contains as many identifiers as
 @scheme[stx-pair] contains elements. The @scheme[stx-pair] argument
 must be a syntax pair that can be flattened into a list. The elements
-of @scheme[stx-pair] can be anything, but string, symbol, and
+of @scheme[stx-pair] can be anything, but string, symbol, keyword, and
 identifier elements will be embedded in the corresponding generated
 name (useful for debugging purposes). The generated identifiers are
 built with interned symbols (not @scheme[gensym]s), so the limitations

collects/scribblings/slideshow/picts.scrbl

@@ -554,6 +554,16 @@ Returns a pict like @scheme[pict], but with the last element (as
 reported by @scheme[pict-last]) set to @scheme[sub-pict]. The
 @scheme[sub-pict] must exist as a sub-pict within @scheme[pict].}
 
+@defproc[(use-last* [pict pict?] [sub-pict pict?]) pict?]{
+
+Propagates the last element of @scheme[sub-pict] to @scheme[pict].
+
+That is, @scheme[use-last*] is like @scheme[use-last], but the last
+element of @scheme[sub-pict] is used as the new last element for
+@scheme[pict], instead of @scheme[sub-pict] itself---unless
+@scheme[(pict-last sub-pict)] is @scheme[#f], in which case
+@scheme[sub-pict] is used as the last element of @scheme[pict].}
+
 @; ------------------------------------------------------------------------
 
 @section{Pict Finders}

collects/texpict/code.ss

@@ -8,10 +8,7 @@
   (provide define-code code^ code-params^ code@)
 
   (define (to-code-pict p extension)
-    (let ([last (pict-last extension)])
+    (use-last* p extension))
-      (if last
-          (use-last p last)
-          (use-last p extension))))
 
   (define (code-pict? p)
     (and (pict-last p) #t))
@@ -21,19 +18,22 @@
 
   (define (make-code-append htl-append)
     (case-lambda
-     [(a b) (if (code-pict? a)
+     [(a b) (let ([a-last (pict-last a)])
-		(let ([extension (htl-append (ghost (code-pict-bottom-line a)) b)])
+              (if a-last
-		  (let ([p (lt-superimpose
+                  (let ([extension (htl-append (ghost a-last) b)])
+                    (let ([p (let-values ([(x y) (lt-find a a-last)]
+                                          [(dx dy) (lt-find extension a-last)])
+                               (let ([ex (- x dx)]
+                                     [ey (- y dy)])
+                                 (if (negative? ey)
+                                     (lt-superimpose
+                                      (inset a 0 (- ey) 0 0)
+                                      (inset extension ex 0 0 0))
+                                     (lt-superimpose
                                       a
-			    (let-values ([(x y) (lt-find a (code-pict-bottom-line a))])
+                                      (inset extension ex ey 0 0)))))])
-			      (inset extension x y 0 0)))])
+                      (use-last* p b)))
-		    (to-code-pict p (if (code-pict? b)
+                  (htl-append a b)))]
-					(code-pict-bottom-line b)
-					extension))))
-		(let ([p (htl-append a b)])
-		  (if (code-pict? b)
-		      (to-code-pict p (code-pict-bottom-line b))
-		      p)))]
      [(a) a]
      [(a . rest)
       ((make-code-append htl-append)
@@ -129,7 +129,12 @@
 	((current-code-tt) s))
 
       (define (code-align p)
-	(lift (inset p 0 (pict-height p) 0 0) (pict-height p)))
+        (let ([b (dc void 
+                     (pict-width p)
+                     (pict-height p)
+                     (pict-height p)
+                     0)])
+          (refocus (cc-superimpose p b) b)))
 
       (define (code-pict-bottom-line-pict p)
 	(if (code-pict? p)

collects/texpict/private/common-sig.ss

@@ -58,6 +58,7 @@
      panorama       ; pict -> pict
 
      use-last       ; pict pict -> pict
+     use-last*      ; pict pict -> pict
 
      hline        ; w h -> pict
      dash-hline   ; w h seg-length -> pict ; default seg-length is 5

collects/texpict/private/common-unit.ss

@@ -303,6 +303,9 @@
 	       ,w ,h
 	       (put ,l ,b ,(pict-draw box)))))]))
 
+      (define (use-last* p sub-p)
+        (use-last p (or (pict-last sub-p) sub-p)))
+
       (define (use-last p sub-p)
 	(if (let floop ([p p])
               (or (eq? p sub-p)
@@ -868,9 +871,10 @@
 		       [else
 			(error who
 			       "expects two numbers or a sub-pict and a find procedure")])])
-	  (cons-picture*
+	  (use-last (cons-picture*
                      base
-	   `((place ,dx ,(- dy (pict-height target)) ,target)))))
+                     `((place ,dx ,(- dy (pict-height target)) ,target)))
+                    (or (pict-last base) base))))
 
       (define (place-over base dx dy target)
 	(place-it 'place-over #f base dx dy target))