diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
index b4f4bdb37d..82faf9ba1a 100644
--- a/collects/scribble/basic.ss
+++ b/collects/scribble/basic.ss
@@ -32,10 +32,11 @@
         (apply append (map (lambda (t) (convert-tag t content)) tag))
         `((part ,(or tag (gen-tag content))))))
   
-  (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
+  (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]  #:version [version #f] . str)
     (let ([content (decode-content str)])
       (make-title-decl (prefix->string prefix)
                        (convert-tag tag content)
+                       version
                        style
                        content)))
   
diff --git a/collects/scribble/decode.ss b/collects/scribble/decode.ss
index fd55cd5659..d62a12ac31 100644
--- a/collects/scribble/decode.ss
+++ b/collects/scribble/decode.ss
@@ -16,6 +16,7 @@
   (provide-structs
    [title-decl ([tag-prefix (or/c false/c string?)]
                 [tags (listof tag?)]
+                [version (or/c string? false/c)]
                 [style any/c]
                 [content list?])]
    [part-start ([depth integer?]
@@ -57,8 +58,14 @@
         null
         (list (decode-paragraph (reverse (skip-whitespace accum))))))
 
-  (define (decode-flow* l keys colls tag-prefix tags style title part-depth)
-    (let loop ([l l][next? #f][keys keys][colls colls][accum null][title title][tag-prefix tag-prefix][tags tags][style style])
+  (define (part-version p)
+    (if (versioned-part? p)
+        (versioned-part-version p)
+        #f))
+
+  (define (decode-flow* l keys colls tag-prefix tags vers style title part-depth)
+    (let loop ([l l][next? #f][keys keys][colls colls][accum null][title title]
+               [tag-prefix tag-prefix][tags tags][vers vers][style style])
       (cond
        [(null? l) 
         (let ([k-tags (map (lambda (k)
@@ -67,36 +74,37 @@
               [tags (if (null? tags)
                         (list `(part ,(make-generated-tag)))
                         tags)])
-          (make-part tag-prefix
-                     (append tags k-tags)
-                     title 
-                     style
-                     (let ([l (map (lambda (k tag)
-                                     (make-index-element
-                                      #f
-                                      null
-                                      tag
-                                      (part-index-decl-plain-seq k)
-                                      (part-index-decl-entry-seq k)
-                                      #f))
-                                   keys k-tags)])
-                       (append
-                        (if (and title (not (or (eq? 'hidden style)
-                                                (and (list? style)
-                                                     (memq 'hidden style)))))
-                            (cons (make-index-element
-                                   #f
-                                   null
-                                   (car tags)
-                                   (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
-                                                         ""))
-                                   (list (make-element #f title))
-                                   (make-part-index-desc))
-                                  l)
-                            l)
-                        colls))
-                     (make-flow (decode-accum-para accum))
-                     null))]
+          (make-versioned-part tag-prefix
+                               (append tags k-tags)
+                               title 
+                               style
+                               (let ([l (map (lambda (k tag)
+                                               (make-index-element
+                                                #f
+                                                null
+                                                tag
+                                                (part-index-decl-plain-seq k)
+                                                (part-index-decl-entry-seq k)
+                                                #f))
+                                             keys k-tags)])
+                                 (append
+                                  (if (and title (not (or (eq? 'hidden style)
+                                                          (and (list? style)
+                                                               (memq 'hidden style)))))
+                                      (cons (make-index-element
+                                             #f
+                                             null
+                                             (car tags)
+                                             (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
+                                                                   ""))
+                                             (list (make-element #f title))
+                                             (make-part-index-desc))
+                                            l)
+                                      l)
+                                  colls))
+                               (make-flow (decode-accum-para accum))
+                               null
+                               vers))]
        [(title-decl? (car l))
         (unless part-depth
           (error 'decode
@@ -110,31 +118,34 @@
               (title-decl-content (car l))
               (title-decl-tag-prefix (car l))
               (title-decl-tags (car l))
+              (title-decl-version (car l))
               (title-decl-style (car l)))]
        [(flow-element? (car l))
         (let ([para (decode-accum-para accum)]
-              [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
-          (make-part (part-tag-prefix part)
-                     (part-tags part)
-                     (part-title-content part)
-                     (part-style part)
-                     (part-to-collect part)
-                     (make-flow (append para
-                                        (list (car l)) 
-                                        (flow-paragraphs (part-flow part))))
-                     (part-parts part)))]
+              [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)])
+          (make-versioned-part (part-tag-prefix part)
+                               (part-tags part)
+                               (part-title-content part)
+                               (part-style part)
+                               (part-to-collect part)
+                               (make-flow (append para
+                                                  (list (car l)) 
+                                                  (flow-paragraphs (part-flow part))))
+                               (part-parts part)
+                               (part-version part)))]
        [(part? (car l))
         (let ([para (decode-accum-para accum)]
-              [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
-          (make-part (part-tag-prefix part)
-                     (part-tags part)
-                     (part-title-content part)
-                     (part-style part)
-                     (part-to-collect part)
-                     (make-flow (append para
-                                        (flow-paragraphs
-                                         (part-flow part))))
-                     (cons (car l) (part-parts part))))]
+              [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)])
+          (make-versioned-part (part-tag-prefix part)
+                               (part-tags part)
+                               (part-title-content part)
+                               (part-style part)
+                               (part-to-collect part)
+                               (make-flow (append para
+                                                  (flow-paragraphs
+                                                   (part-flow part))))
+                               (cons (car l) (part-parts part))
+                               (part-version part)))]
        [(and (part-start? (car l))
              (or (not part-depth)
                  ((part-start-depth (car l)) . <= . part-depth)))
@@ -156,54 +167,56 @@
                                              (part-start-style s)
                                              (part-start-title s)
                                              (add1 part-depth))]
-                      [part (decode-flow* l keys colls tag-prefix tags style title part-depth)])
-                  (make-part (part-tag-prefix part)
-                             (part-tags part)
-                             (part-title-content part)
-                             (part-style part)
-                             (part-to-collect part)
-                             (make-flow para)
-                             (cons s (part-parts part))))
+                      [part (decode-flow* l keys colls tag-prefix tags vers style title part-depth)])
+                  (make-versioned-part (part-tag-prefix part)
+                                       (part-tags part)
+                                       (part-title-content part)
+                                       (part-style part)
+                                       (part-to-collect part)
+                                       (make-flow para)
+                                       (cons s (part-parts part))
+                                       (part-version part)))
                 (if (splice? (car l))
                     (loop (append (splice-run (car l)) (cdr l)) s-accum)
                     (loop (cdr l) (cons (car l) s-accum))))))]
        [(splice? (car l))
-	(loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags style)]
-       [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags style)]
+	(loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags vers style)]
+       [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags vers style)]
        [(part-index-decl? (car l))
-        (loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags style)]
+        (loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags vers style)]
        [(part-collect-decl? (car l))
-        (loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags style)]
+        (loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags vers style)]
        [(part-tag-decl? (car l))
-        (loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) style)]
+        (loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) vers style)]
        [(and (pair? (cdr l))
 	     (splice? (cadr l)))
-	(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags style)]
+	(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags vers style)]
        [(line-break? (car l))
 	(if next?
-	    (loop (cdr l) #t keys colls accum title tag-prefix tags style)
+	    (loop (cdr l) #t keys colls accum title tag-prefix tags vers style)
 	    (let ([m (match-newline-whitespace (cdr l))])
               (if m
-                  (let ([part (loop m #t keys colls null title tag-prefix tags style)])
-                    (make-part (part-tag-prefix part)
-                               (part-tags part)
-                               (part-title-content part)
-                               (part-style part)
-                               (part-to-collect part)
-                               (make-flow (append (decode-accum-para accum)
-                                                  (flow-paragraphs (part-flow part))))
-                               (part-parts part)))
-                  (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style))))]
-       [else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style)])))
+                  (let ([part (loop m #t keys colls null title tag-prefix tags vers style)])
+                    (make-versioned-part (part-tag-prefix part)
+                                         (part-tags part)
+                                         (part-title-content part)
+                                         (part-style part)
+                                         (part-to-collect part)
+                                         (make-flow (append (decode-accum-para accum)
+                                                            (flow-paragraphs (part-flow part))))
+                                         (part-parts part)
+                                         (part-version part)))
+                  (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style))))]
+       [else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style)])))
 
   (define (decode-part l tags title depth)
-    (decode-flow* l null null #f tags #f title depth))
+    (decode-flow* l null null #f tags #f #f title depth))
 
   (define (decode-styled-part l tag-prefix tags style title depth)
-    (decode-flow* l null null tag-prefix tags style title depth))
+    (decode-flow* l null null tag-prefix tags #f style title depth))
 
   (define (decode-flow l)
-    (part-flow (decode-flow* l null null #f null #f #f #f)))
+    (part-flow (decode-flow* l null null #f null #f #f #f #f)))
 
   (define (match-newline-whitespace l)
     (cond
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index e1421d0186..06d7c1d93f 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -25,6 +25,7 @@
   (define collecting-sub (make-parameter 0))
   (define current-no-links (make-parameter #f))
   (define extra-breaking? (make-parameter #f))
+  (define current-version (make-parameter (version)))
 
   (define (path->relative p)
     (let ([p (path->main-doc-relative p)])
@@ -326,7 +327,7 @@
                   null
                   (if (part-style? d 'hidden)
                       (map (lambda (t)
-                              `(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
+                             `(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
                            (part-tags d))
                       `((,(case (length number)
                             [(0) 'h2]
@@ -754,36 +755,53 @@
                               ri)))))
 
       (define/override (render-part d ri)
-        (let ([number (collected-info-number (part-collected-info d ri))])
-          (cond
-           [(and (not (on-separate-page))
-                 (or (= 1 (length number))
-                     (next-separate-page)))
-            ;; Render as just a link, and put the actual 
-            ;; content in a new file:
-            (let* ([filename (derive-filename d)]
-                   [full-path (build-path (path-only (current-output-file))
-                                          filename)])
-              (parameterize ([on-separate-page #t])
-                (with-output-to-file full-path
-                  #:exists 'truncate/replace
-                  (lambda ()
-                    (render-one-part d ri full-path number)))
-                null))]
-           [else
-            (let ([sep? (on-separate-page)])
-              (parameterize ([next-separate-page (toc-part? d)]
-                             [on-separate-page #f])
-                (if sep?
-                    ;; Navigation bars;
-                    `(,@(navigation d ri)
-                      (p nbsp)
-                      ,@(super render-part d ri)
-                      (p nbsp)
-                      ,@(navigation d ri)
-                      (p nbsp))
-                    ;; Normal section render
-                    (super render-part d ri))))])))
+        (parameterize ([current-version
+                        (if (and (versioned-part? d)
+                                 (versioned-part-version d))
+                            (versioned-part-version d)
+                            (current-version))])
+          (let ([number (collected-info-number (part-collected-info d ri))])
+            (cond
+             [(and (not (on-separate-page))
+                   (or (= 1 (length number))
+                       (next-separate-page)))
+              ;; Render as just a link, and put the actual 
+              ;; content in a new file:
+              (let* ([filename (derive-filename d)]
+                     [full-path (build-path (path-only (current-output-file))
+                                            filename)])
+                (parameterize ([on-separate-page #t])
+                  (with-output-to-file full-path
+                    #:exists 'truncate/replace
+                    (lambda ()
+                      (render-one-part d ri full-path number)))
+                  null))]
+             [else
+              (let ([sep? (on-separate-page)])
+                (parameterize ([next-separate-page (toc-part? d)]
+                               [on-separate-page #f])
+                  (if sep?
+                      ;; Navigation bars;
+                      `(,@(navigation d ri)
+                        (p nbsp)
+                        ,@(render-table (make-table
+                                         "versionbox"
+                                         (list 
+                                          (list
+                                           (make-flow
+                                            (list
+                                             (make-paragraph (list 
+                                                              (make-element "version"
+                                                                            (list "Version: "
+                                                                                  (current-version))))))))))
+                                        d
+                                        ri)
+                        ,@(super render-part d ri)
+                        (p nbsp)
+                        ,@(navigation d ri)
+                        (p nbsp))
+                      ;; Normal section render
+                      (super render-part d ri))))]))))
 
       (super-new)))
 
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index c347a05796..35833269a0 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -84,6 +84,7 @@
         s))
 
   (define-code scheme to-element unsyntax keep-s-expr add-sq-prop)
+  (define-code SCHEME to-element UNSYNTAX keep-s-expr add-sq-prop)
   (define-code schemeresult to-element/result unsyntax keep-s-expr add-sq-prop)
   (define-code schemeid to-element/id unsyntax keep-s-expr add-sq-prop)
   (define-code *schememodname to-element unsyntax keep-s-expr add-sq-prop)
@@ -221,7 +222,7 @@
            schemeblock0 SCHEMEBLOCK0 schemeblock0/form
            schemeinput
            schememod
-           scheme scheme/form schemeresult schemeid schememodname
+           scheme SCHEME scheme/form schemeresult schemeid schememodname
            defmodule defmodule* defmodulelang defmodulelang*
            defmodule*/no-declare defmodulelang*/no-declare
            indexed-scheme
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
index 371915853b..c7a28acbfd 100644
--- a/collects/scribble/scribble.css
+++ b/collects/scribble/scribble.css
@@ -21,6 +21,20 @@
                text-align: left;
                }
 
+               .versionbox { 
+                  position: relative;
+                  float: right;
+                  left: 3em;
+                  top: -2em;
+                  height: 0em;                
+                  width: 13em;
+                  margin: 0em -13em 0em 0em;
+                }
+               .version {
+                  font-family: sans-serif;
+                  font-size: 13px;
+                }
+
                .refpara { 
                 font-family: Consolas, Courier, monospace; font-size: 13px;
                 position: relative;
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
index a4616ee867..98f45a4033 100644
--- a/collects/scribble/struct.ss
+++ b/collects/scribble/struct.ss
@@ -131,6 +131,7 @@
           [flow flow?]
           [parts (listof part?)])]
    [(unnumbered-part part) ()]
+   [(versioned-part part) ([version (or/c string? false/c)])]
    [flow ([paragraphs (listof flow-element?)])]
    [paragraph ([content list?])]
    [(styled-paragraph paragraph) ([style any/c])]
diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl
index 7b727aecec..df4c0e2d1a 100644
--- a/collects/scribblings/reference/procedures.scrbl
+++ b/collects/scribblings/reference/procedures.scrbl
@@ -53,7 +53,7 @@ function consumes.
 Like @scheme[apply], but @scheme[kw-lst] and @scheme[kw-val-lst]
 supply by-keyword arguments in addition to the by-position arguments
 of the @scheme[v]s and @scheme[lst]. The given @scheme[kw-lst] must be
-sorted using @scheme[keyword<], and no keyword can appear twice in
+sorted using @scheme[keyword<?], and no keyword can appear twice in
 @scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
 given @scheme[kw-val-lst] must have the same length as
 @scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
@@ -136,9 +136,9 @@ in @scheme[(procedure-arity proc)], the @exnraise[exn:fail:contract].}
 
 Returns information about the keyword arguments required and accepted
 by a procedure. The first result is a list of keywords (sorted by
-@scheme[keyword<]) that are required when applying @scheme[proc]. The
+@scheme[keyword<?]) that are required when applying @scheme[proc]. The
 second result is a list of accepted keywords (sorted by
-@scheme[keyword<]), or @scheme[#f] to mean that any keyword is
+@scheme[keyword<?]), or @scheme[#f] to mean that any keyword is
 accepted. When the second result is a list, every element in the first
 list is also in the second list.
 
@@ -150,7 +150,7 @@ list is also in the second list.
 
 @defproc[(make-keyword-procedure
           [proc (((listof keyword?) list?) list? . ->* . any)]
-          [plain-proc procedure? (lambda args (apply proc null null args))])
+          [plain-proc procedure? (lambda args (keyword-apply proc null null args))])
          procedure?]{
 
 Returns a procedure that accepts all keyword arguments (without
@@ -158,7 +158,7 @@ requiring any keyword arguments).
 
 When the result is called with keyword arguments, then @scheme[proc]
 is called; the first argument is a list of keywords sorted by
-@scheme[keyword<], the second argument is a parallel list containing a
+@scheme[keyword<?], the second argument is a parallel list containing a
 value for each keyword, and the remaining arguments are the
 by-position arguments.
 
diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl
index 65187cbbf5..125abf1594 100644
--- a/collects/scribblings/scribble/basic.scrbl
+++ b/collects/scribblings/scribble/basic.scrbl
@@ -51,6 +51,7 @@ have @schememodname[scribble/manual]).
 
 @defproc[(title [#:tag tag (or/c false/c string?) #f]
                 [#:style style any/c #f]
+                [#:version vers (or/c string? false/c) #f]
                 [pre-content any/c] ...+)
          title-decl?]{
 
@@ -66,9 +67,12 @@ separate pages in multi-page HTML output. A style of @scheme['index]
 indicates an index section whose body is rendered in two columns for
 Latex output.
 
-The section title is automatically indexed. For the index key, a
-leading ``A'', ``An'', or ``The'' (followed by whitespace) is
-removed.}
+The @scheme[vers] argument is propagated to the @scheme[title-decl]
+structure.
+
+The section title is automatically indexed by
+@scheme[decode-part]. For the index key, a leading ``A'', ``An'', or
+``The'' (followed by whitespace) is removed.}
 
 
 @def-section-like[section part-start?]{ Like @scheme[title], but
diff --git a/collects/scribblings/scribble/decode.scrbl b/collects/scribblings/scribble/decode.scrbl
index a2af53a29b..f94a745935 100644
--- a/collects/scribblings/scribble/decode.scrbl
+++ b/collects/scribblings/scribble/decode.scrbl
@@ -45,14 +45,15 @@ then it is bolded.
 
 Decodes a document, producing a part. In @scheme[lst], instances of
 @scheme[splice] are inlined into the list. An instance of
-@scheme[title-decl] supplies the title for the part. Instances of
-@scheme[part-index-decl] (that precede any sub-part) add index entries
-that point to the section. Instances of @scheme[part-collect-decl] add
-elements to the part that are used only during the @techlink{collect
-pass}. Instances of @scheme[part-tag-decl] add hyperlink tags to the
-section title. Instances of @scheme[part-start] at level 0 trigger
-sub-part parsing. Instances of @scheme[section] trigger are used as-is
-as subsections, and instances of @scheme[paragraph] and other
+@scheme[title-decl] supplies the title for the part, plus tag, style
+and version information. Instances of @scheme[part-index-decl] (that
+precede any sub-part) add index entries that point to the
+section. Instances of @scheme[part-collect-decl] add elements to the
+part that are used only during the @techlink{collect pass}. Instances
+of @scheme[part-tag-decl] add hyperlink tags to the section
+title. Instances of @scheme[part-start] at level 0 trigger sub-part
+parsing. Instances of @scheme[section] trigger are used as-is as
+subsections, and instances of @scheme[paragraph] and other
 flow-element datatypes are used as-is in the enclosing flow.
 
 }
@@ -107,6 +108,7 @@ otherwise.
 
 @defstruct[title-decl ([tag-prefix (or/c false/c string?)]
                        [tags (listof string?)]
+                       [version (or/c string? false/c)]
                        [style any/c]
                        [content list?])]{
 
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
index f149da00cd..1ad0a1e421 100644
--- a/collects/scribblings/scribble/manual.scrbl
+++ b/collects/scribblings/scribble/manual.scrbl
@@ -110,6 +110,9 @@ module whose language is @scheme[lang].}
 a single line and wrapped with its enclosing paragraph, independent of
 the formatting of @scheme[datum].}
 
+@defform[(SCHEME datum ...)]{Like @scheme[scheme], but with the
+@scheme[UNSYNTAX] escape like @scheme[schemeblock].}
+
 @defform[(schemeresult datum ...)]{Like @scheme[scheme], but typeset
 as a REPL value (i.e., a single color with no hyperlinks).}
 
diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl
index 76c000eb1a..756767668e 100644
--- a/collects/scribblings/scribble/struct.scrbl
+++ b/collects/scribblings/scribble/struct.scrbl
@@ -30,10 +30,11 @@ A document is processed in three passes. The first pass is the
 A @deftech{part} is an instance of @scheme[part]; among other things,
  it has a title @techlink{content}, an initial @techlink{flow}, and a
  list of subsection @techlink{parts}. An @scheme[unnumbered-part] is
- the same as a @scheme[part], but it isn't numbered. There's no
- difference between a part and a full document; a particular source
- module just as easily defines a subsection (incorporated via
- @scheme[include-section]) as a document.
+ the same as a @scheme[part], but it isn't numbered. A
+ @scheme[versioned-part] is add a version field to
+ @scheme[part]. There's no difference between a part and a full
+ document; a particular source module just as easily defines a
+ subsection (incorporated via @scheme[include-section]) as a document.
 
 A @deftech{flow} is an instance of @scheme[flow]; it has a list of
  @techlink{flow elements}.
@@ -260,6 +261,18 @@ during the @techlink{collect pass}, the number is not rendered.
 }
 
 
+@defstruct[(versioned-part part) ([version (or/c string? false/c)])]{
+
+Supplies a version number for this part and its sub-parts (except as
+overridden). A @scheme[#f] version is the same as not supplying a
+version.
+
+The version number may be used when rendering a document. At a
+minimum, a version is rendered when it is attached to a part
+representing the whole document. The default version for a document is
+@scheme[(version)].}
+
+
 @defstruct[flow ([paragraphs (listof flow-element?)])]{
 
 A @techlink{flow} has a list of flow elements.
diff --git a/collects/scribblings/slideshow/code.scrbl b/collects/scribblings/slideshow/code.scrbl
new file mode 100644
index 0000000000..3844809986
--- /dev/null
+++ b/collects/scribblings/slideshow/code.scrbl
@@ -0,0 +1,293 @@
+#lang scribble/doc
+@(require "ss.ss"
+          (for-label slideshow/code
+                     scheme/gui/base))
+
+@(define stx-obj
+  (tech #:doc '(lib "scribblings/reference/reference.scrbl") "syntax object"))
+
+@title{Typesetting Scheme Code}
+
+@defmodule[slideshow/code]{The @scheme[slideshow/code] library
+provides utilities for typesetting Scheme code as a pict.}
+
+@defproc[(typeset-code [stx syntax?]) pict?]{
+
+Produces a pict for code in the given @|stx-obj|. The
+source-location information of the syntax object determines the line
+breaks, line indenting, and space within a row.  Empty rows are
+ignored. 
+
+Beware that if you use @scheme[read-syntax] on a file port, you may
+have to turn on line counting via @scheme[port-count-lines!] for the
+code to typeset properly. Also beware that when a source file
+containing a @scheme[syntax] or @scheme[quote-syntax] form is
+compiled, source location information is omitted from the compiled
+@|stx-obj|.
+
+Normally, @scheme[typeset-code] is used through the @scheme[code]
+syntactic form, which works properly with compilation, and that
+escapes to pict-producing code via @scheme[unsyntax]. See also
+@scheme[define-code].
+
+Embedded picts within @scheme[stx] are used directly. Row elements are
+combined using and operator like @scheme[htl-append], so use
+@scheme[code-align] (see below) as necessary to add an ascent to
+ascentless picts. More precisely, creation of a line of code uses
+@scheme[pict-last] to determine the end point of the element most
+recently added to a line; the main effect is that closing parentheses
+are attached in the right place when a multi-line pict is embedded in
+@scheme[stx].
+
+An identifier that starts with @litchar{_} is italicized in the pict,
+and the @litchar{_} is dropped, unless the
+@scheme[code-italic-underscore-enabled] parameter is set to
+@scheme[#f]. Also, unless @scheme[code-scripts-enabled] is set to
+@scheme[#f], @litchar{_} and @litchar{^} in the middle of a word
+create superscripts and subscripts, respectively (like TeX); for
+example @schemeidfont{foo^4_ok} is displayed as the identifier
+@schemeidfont{foo} with a @schemeidfont{4} superscript and an
+@schemeidfont{ok} subscript.
+
+Further, uses of certain identifiers in @scheme[stx] typeset
+specially:
+
+@itemize{
+
+ @item{@as-index{@schemeidfont{code:blank}} --- produces a space.}
+
+ @item{@scheme[(#,(as-index (schemeidfont "code:comment")) _s ...)]
+ --- produces a comment block, with each @scheme[_s] on its own line,
+ where each @scheme[_s] must be a string or a pict.}
+
+ @item{@scheme[(#,(as-index (schemeidfont "code:line")) _datum ...)]
+ --- typesets the @scheme[_datum] sequence, which is mostly useful for
+ the top-level sequence, since @scheme[typeset-code] accepts only one
+ argument.}
+
+ @item{@scheme[(#,(as-index (schemeidfont "code:contract")) _datum
+ ...)]  --- like @schemeidfont{code:line}, but every @scheme[_datum]
+ is colored as a comment, and a @litchar{;} is prefixed to every line.}
+
+ @item{@scheme[(#,(as-index (schemeidfont "code:template")) _datum
+ ...)]  --- like @schemeidfont{code:line}, but a @litchar{;} is
+ prefixed to every line.}
+
+ @item{@schemeidfont{$} --- typesets as a vertical bar (for no
+ particularly good reason).}
+
+}}
+
+
+@defform[(code datum ...)]{
+
+The macro form of @scheme[typeset-code]. Within a @scheme[datum],
+@scheme[unsyntax] can be used to escape to an expression.
+
+For more information, see @scheme[typeset-code] and
+@scheme[define-code], since @scheme[code] is defined as
+
+@schemeblock[
+(define-code code typeset-code)
+]}
+
+
+@defparam[current-code-font style text-style/c]{
+
+Parameter for a base font used to typeset text. The default is
+@scheme[`(bold . modern)]. For even more control, see
+@scheme[current-code-tt].}
+
+
+@defparam[current-code-tt proc (string? . -> . pict?)]{
+
+Parameter for a one-argument procedure to turn a
+  string into a pict, used to typeset text. The default is
+
+@schemeblock[
+(lambda (s) (text s (current-code-font) (current-font-size)))
+]
+
+This procedure is not used to typeset subscripts or other items that
+require font changes, where @scheme[current-code-font] is used
+directly.}
+
+
+@defparam[current-code-line-sep amt real?]{
+
+A parameter that determines the spacing between lines of typeset code.
+The default is @scheme[2].}
+
+
+@defparam[current-comment-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of comments.}
+
+
+@defparam[current-keyword-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of syntactic-form names. See
+@scheme[current-keyword-list].}
+
+
+@defparam[current-id-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of identifiers that are not syntactic form
+names or constants.}
+
+
+@defparam[current-literal-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of literal values, such as strings and
+numbers.  See also @scheme[current-literal-list]}
+
+
+@defparam[current-const-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of constant names. See
+@scheme[current-const-list].}
+
+
+@defparam[current-base-color color (or/c string? (is-a?/c color%))]{
+
+A parameter for the color of everything else.}
+
+
+@defparam[current-reader-forms syms (listof symbol?)]{
+
+Parameter for a list of symbols indicating which built-in reader forms
+should be used. The default is @scheme['(quote quasiquote unquote
+unquote-splicing syntax quasisyntax unsyntax unsyntax-splicing)].
+Remove a symbol to suppress the corresponding reader output.}
+
+
+@defproc[(code-align [pict pict?]) pict?]{
+
+Adjusts the ascent of @scheme[pict] so that its bottom aligns with the
+baseline for text; use this function when @scheme[pict] has no
+ascent.}
+
+
+@defparam[current-keyword-list names (listof string?)]{
+
+A list of strings to color as syntactic-form names. The default
+includes most of the forms provided by @scheme[scheme/base].}
+
+
+@defparam[current-const-list names (listof string?)]{
+
+A list of strings to color as constant names. The default is
+@scheme[null].}
+
+
+@defparam[current-literal-list names (listof string?)]{
+
+A list of strings to color as literals, in addition to literals such
+as strings. The default is @scheme[null].}
+
+@defthing[mzscheme-const-list (listof string?)]{
+
+A list of strings that could be used to initialize the
+@scheme[current-const-list] parameter.}
+
+@defboolparam[code-colorize-enabled on?]{
+
+A parameter to enable or disable all code coloring. The default is
+@scheme[#t].}
+
+
+@defboolparam[code-colorize-quote-enabled on?]{
+
+A parameter to control whether under a @scheme[quote] is colorized as
+a literal (as in this documentation). The default is @scheme[#t].}
+
+
+@defboolparam[code-italic-underscore-enabled on?]{
+
+A parameter to control whether @litchar{_}-prefixed identifiers are
+italicized (dropping the @litchar{_}). The default is @scheme[#t].}
+
+@defboolparam[code-scripts-enabled on?]{
+
+A parameter to control whether TeX-style subscripts and subscripts are
+recognized in an identifier.}
+
+@defform*[[(define-code code-id typeset-code-id) 
+           (define-code code-id typeset-code-id escape-id)]]{
+
+Defines @scheme[code-id] as a macro that uses
+@scheme[typeset-code-id], which is a function with the same input as
+@scheme[typeset-code]. The @scheme[escape-id] form defaults to
+@scheme[unsyntax].
+
+The resulting @scheme[code-id] syntactic form takes a sequence of
+@scheme[_datum]s:
+
+@schemeblock[
+(code-id _datum ...)
+]
+
+It produces a pict that typesets the sequence. Source-location
+information for the @scheme[_datum] determines the layout of code in
+the resulting pict. The @scheme[code-id] is expanded in such a way
+that source location is preserved during compilation (so
+@scheme[typeset-code-id] receives a syntax object with source
+locations intact).
+
+If a @scheme[_datum] contains @scheme[(escape-id _expr)]---perhaps as
+@SCHEME[#,_expr] when @scheme[escape-id] is @scheme[unsyntax]---then
+the @scheme[_expr] is evaluated and the result datum is spliced in
+place of the @scheme[escape-id] form in @scheme[_datum]. If the result
+is not a syntax object, it is given the source location of the
+@scheme[escape-id] form. A pict value intected this way as a
+@scheme[_datum] is rendered as itself.}
+
+
+@defform[(define-exec-code (pict-id runnable-id string-id)
+           datum ...)]{
+
+Binds @scheme[pict-id] to the result of @scheme[(code datum ...)],
+except that if an identifier @schemeidfont{_} appears anywhere in a
+@scheme[datum], then the identifier and the following expression are
+not included for @scheme[code].
+
+Meanwhile, @scheme[runnable-id] is bound to a @|stx-obj| that wraps
+the @scheme[datum]s in a @scheme[begin]. In this case,
+@schemeidfont{_}s are removed from the @scheme[datum]s, but not the
+following expression. Thus, an @schemeidfont{_} identifier is used to
+comment out an expression from the pict, but have it present in the
+@|stx-obj| for evaluation.
+
+The @scheme[string-id] is bound to a string representation of the code
+that is in the pict. This string is useful for copying to the
+clipboard with @scheme[(send the-clipboard set-clipboard-string
+string-id 0)].}
+
+
+@defform[(define-exec-code/scale scale-expr (pict-id runnable-id string-id)
+           datum ...)]{
+
+Like @scheme[define-exec-code], but with a scale to use via
+@scheme[scale/improve-new-text] when generating the pict.}
+
+
+@deftogether[(
+@defthing[comment-color (or/c string? (is-a?/c color%))]
+@defthing[keyword-color (or/c string? (is-a?/c color%))]
+@defthing[id-color (or/c string? (is-a?/c color%))]
+@defthing[literal-color (or/c string? (is-a?/c color%))]
+)]{
+
+For backward compatibility, the default values for
+@scheme[current-comment-color], etc.}
+
+@defproc[(code-pict-bottom-line-pict [pict pict?])
+         (or/c pict? false/c)]{
+
+The same as @scheme[pict-last], provided for backward compatibility.}
+
+@defproc[(pict->code-pict [pict pict?] [bl-pict (or/c pict? false/c)]) pict?]{
+
+Mainly for backward compatibility: returns @scheme[(if bl-pict
+(use-last pict (or (pict-last bl-pict) bl-pict)))].}
+
diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/scribblings/slideshow/picts.scrbl
index 055760f69e..d65c4fcc96 100644
--- a/collects/scribblings/slideshow/picts.scrbl
+++ b/collects/scribblings/slideshow/picts.scrbl
@@ -1,6 +1,7 @@
 #lang scribble/doc
 @(require "ss.ss"
           (for-label mred
+                     slideshow/code
                      slideshow/flash
                      slideshow/face
                      slideshow/balloon))
@@ -39,7 +40,7 @@ In addition to its drawing part, a pict has the following
        |                  | a  \
        |------------------|    |
        |                  |    | h
-       |------------------|    |
+       |----------last----|    |
        |                  | d  /
         ------------------     
 EOS
@@ -52,6 +53,12 @@ with a function like @scheme[vc-append]), @math{a} is the ascent of
 the top line, and @math{d} is the descent of the bottom line, so
 @math{a+d<h}. Many picts have @math{d=0} and @math{a=h}.
 
+In addition, a pict can have a @defterm{last} sub-pict that
+corresponds to the last item on the last line of text, so that extra
+lines can be added to the last line. In particular, the @defterm{last}
+element is useful for adding closing parentheses to a block of Scheme
+code, where the last line of code not the longest line in the block.
+
 The size information for a pict is computed when the pict is
 created. This strategy supports programs that create new picts though
 arbitrarily complex computations on the size and shape of existing
@@ -66,7 +73,8 @@ information from a pict.
                  [ascent real?]
                  [descent real?]
                  [children (listof child?)]
-                 [panbox (or/c false/c any/c)])]{
+                 [panbox (or/c false/c any/c)]
+                 [last (or/c false/c pict?)])]{
 
 A @scheme[pict] structure is normally not created directly with
 @scheme[make-pict]. Instead, functions like @scheme[text],
@@ -81,7 +89,12 @@ will be set for a suitable default drawing mode, and the
 @scheme[dc<%>] scale will be set to scale the resulting image.
 
 The @scheme[panbox] field is internal, and it should be ininitialized
-to @scheme[#f].}
+to @scheme[#f].
+
+The @scheme[last] field indicates a pict within the @scheme[children]
+list (transitively) that can be treated as the last element of the
+last line in the pict. A @scheme[#f] value means that the pict is its
+own last sub-pict.}
 
 
 @defstruct[child ([pict pict?]
@@ -89,6 +102,7 @@ to @scheme[#f].}
                   [dy real?]
                   [sx real?]
                   [sy real?])]{
+
 Records, for a pict constructed of other picts, the relative location
 and scale of one nested pict.
 
@@ -335,7 +349,10 @@ pictures.
 The descent of the result corresponds to baseline that is lowest in
 the result among all of the picts' descent-specified baselines;
 similarly, the ascent of the result corresponds to the highest
-ascent-specified baseline.}
+ascent-specified baseline. If at least one @scheme[pict] is supplied,
+then the last element (as reported by @scheme[pict-last]) for the
+result is @scheme[(or (pict-last pict) pict)] for the using last
+supplied @scheme[pict].}
 
 @defproc*[([(lt-superimpose [pict pict?] ...) pict?]
            [(ltl-superimpose [pict pict?] ...) pict?]
@@ -360,7 +377,11 @@ alignment.
 The descent of the result corresponds to baseline that is lowest in
 the result among all of the picts' descent-specified baselines;
 similarly, the ascent of the result corresponds to the highest
-ascent-specified baseline.}
+ascent-specified baseline. The last element (as reported by
+@scheme[pict-last]) for the result is the lowest, right-most among the
+last-element picts of the @scheme[pict] arguments, as determined by
+comparing the last-element bottom-right corners.}
+
 
 @defproc*[([(pin-over [base pict?] [dx real?] [dy real?] [pict pict?])
             pict?]
@@ -378,6 +399,7 @@ pict's corner is from the first pict's corner.  Alternately, the
 @scheme[base] for @scheme[find-pict]; the @scheme[find] procedure
 should be something like @scheme[lt-find].}
 
+
 @defproc*[([(pin-under [base pict?] [dx real?] [dy real?] [pict pict?])
             pict?]
            [(pin-under [base pict?] 
@@ -389,6 +411,7 @@ should be something like @scheme[lt-find].}
 Like @scheme[pin-over], but @scheme[pict] is drawn before
 @scheme[base] in the resulting combination.}
 
+
 @defproc[(table [ncols exact-positive-integer?]
                 [picts (listof pict?)]
                 [col-aligns (table-list-of (pict? pict? -> pict?))]
@@ -516,13 +539,20 @@ Makes the descent @scheme[0] and the ascent the same as the height.}
 
 Assuming that @scheme[sub-pict] can be found within @scheme[pict],
 shifts the overall bounding box to that of @scheme[sub-pict] (but
-preserving all the drawing of @scheme[pict]).}
+preserving all the drawing of @scheme[pict]). The last element, as
+reported by @scheme[pict-last] is also set to @scheme[(or (pict-last
+sub-pict) sub-pict)].}
 
 @defproc[(panorama [pict pict?]) pict?]{
 
 Shifts the given pict's bounding box to enclose the bounding boxes of
 all sub-picts (even @scheme[launder]ed picts).}
 
+@defproc[(use-last [pict pict?] [sub-pict pict?]) pict?]{
+
+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].}
 
 @; ------------------------------------------------------------------------
 
diff --git a/collects/scribblings/slideshow/slideshow.scrbl b/collects/scribblings/slideshow/slideshow.scrbl
index 09479c859b..988211f2d3 100644
--- a/collects/scribblings/slideshow/slideshow.scrbl
+++ b/collects/scribblings/slideshow/slideshow.scrbl
@@ -26,6 +26,7 @@ the manual are provided by the @schememodname[slideshow] language.}
 @include-section["guide.scrbl"]
 @include-section["picts.scrbl"]
 @include-section["slides.scrbl"]
+@include-section["code.scrbl"]
 
 @(bibliography
   (bib-entry #:key "Findler06" 
diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss
index 1e8eb6c33a..9b0b03fd95 100644
--- a/collects/setup/scribble.ss
+++ b/collects/setup/scribble.ss
@@ -219,13 +219,16 @@
             [tags (if (member '(part "top") (part-tags v))
                       (part-tags v)
                       (cons '(part "top") (part-tags v)))])
-        (make-part tag-prefix
-                   tags
-                   (part-title-content v)
-                   (part-style v)
-                   (part-to-collect v)
-                   (part-flow v)
-                   (part-parts v)))))
+        (make-versioned-part tag-prefix
+                             tags
+                             (part-title-content v)
+                             (part-style v)
+                             (part-to-collect v)
+                             (part-flow v)
+                             (part-parts v)
+                             (if (versioned-part? v)
+                                 (versioned-part-version v)
+                                 #f)))))
 
   (define ((get-doc-info only-dirs latex-dest) doc)
     (let ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")]
diff --git a/collects/slideshow/code.ss b/collects/slideshow/code.ss
index a2dc188dda..b5d7c4bdad 100644
--- a/collects/slideshow/code.ss
+++ b/collects/slideshow/code.ss
@@ -5,11 +5,15 @@
   (require-for-syntax (lib "to-string.ss" "syntax")
                       (lib "list.ss"))
 
+  (define current-code-line-sep (make-parameter line-sep))
+
   (define-values/invoke-unit/infer code@)
 
   (define-code code typeset-code)
 
-  (provide code)
+  (provide code
+           current-code-line-sep
+           define-code)
   (provide-signature-elements code^)
     
   (provide define-exec-code/scale
diff --git a/collects/texpict/code.ss b/collects/texpict/code.ss
index 4a1fa54c38..b4173312c3 100644
--- a/collects/texpict/code.ss
+++ b/collects/texpict/code.ss
@@ -7,20 +7,17 @@
 
   (provide define-code code^ code-params^ code@)
 
-  (define-struct (code-pict pict) (bottom-line))
-
-
   (define (to-code-pict p extension)
-    (make-code-pict (pict-draw p)
-		    (pict-width p)
-		    (pict-height p)
-		    (pict-ascent p)
-		    (pict-descent p)
-		    (pict-children p)
-		    (pict-panbox p)
-		    (if (code-pict? extension)
-			(code-pict-bottom-line extension)
-			extension)))
+    (let ([last (pict-last extension)])
+      (if last
+          (use-last p last)
+          (use-last p extension))))
+
+  (define (code-pict? p)
+    (and (pict-last p) #t))
+
+  (define (code-pict-bottom-line p)
+    (pict-last p))
 
   (define (make-code-append htl-append)
     (case-lambda
@@ -105,7 +102,7 @@
 
   (define-signature code-params^
     (current-font-size 
-     line-sep))
+     current-code-line-sep))
 
   (define-syntax (define-computed stx)
     (syntax-case stx ()
@@ -144,10 +141,8 @@
 	    (to-code-pict p bottom-line)
 	    p))
       
-      (define mzscheme-ns (let ([n (make-namespace 'empty)]
-				[orig (current-namespace)])
+      (define mzscheme-ns (let ([n (make-namespace)])
 			    (parameterize ([current-namespace n])
-			      (namespace-attach-module orig 'mzscheme)
 			      (namespace-require/copy 'mzscheme))
 			    n))
       (define mzscheme-bindings (namespace-mapped-symbols mzscheme-ns))
@@ -278,7 +273,7 @@
       (define (pad-bottom space p)
 	(if (= 0 space)
 	    p
-	    (code-vl-append line-sep (tt " ") (pad-bottom (sub1 space) p))))
+	    (code-vl-append (current-code-line-sep) (tt " ") (pad-bottom (sub1 space) p))))
 
       (define (colorize-id str mode)
 	(cond
@@ -347,7 +342,7 @@
       (define (add-semis p)
 	(let loop ([p p] [semis (color-semi-p)])
 	  (if ((pict-height p) . > . (+ (pict-height semis) 1))
-	      (loop p (vl-append line-sep (color-semi-p) semis))
+	      (loop p (vl-append (current-code-line-sep) (color-semi-p) semis))
 	      (htl-append semis p))))
 
       (define (add-unquote unquote-p loop x closes mode)
@@ -481,7 +476,7 @@
 		      [else
 		       ;; Start on next line:
 		       (code-vl-append
-			line-sep
+			(current-code-line-sep)
 			line-so-far
 			(let* ([space (max 0 (- (or (syntax-column (car stxs)) 0) left))]
 			       [p 
diff --git a/collects/texpict/private/common-sig.ss b/collects/texpict/private/common-sig.ss
index 71918223ad..cbf62aa3ef 100644
--- a/collects/texpict/private/common-sig.ss
+++ b/collects/texpict/private/common-sig.ss
@@ -3,7 +3,7 @@
 
   (provide texpict-common^)
   (define-signature texpict-common^
-    ((struct pict (draw width height ascent descent children panbox))
+    ((struct pict (draw width height ascent descent children panbox last))
      (struct child (pict dx dy sx sy))
 
      black-and-white
@@ -57,6 +57,8 @@
      refocus        ; pict pict -> pict
      panorama       ; pict -> pict
 
+     use-last       ; pict pict -> pict
+
      hline        ; w h -> pict
      dash-hline   ; w h seg-length -> pict ; default seg-length is 5
      vline        ; w h -> pict
diff --git a/collects/texpict/private/common-unit.ss b/collects/texpict/private/common-unit.ss
index 6ddde9f8b3..37ed8ade96 100644
--- a/collects/texpict/private/common-unit.ss
+++ b/collects/texpict/private/common-unit.ss
@@ -11,13 +11,14 @@
       (define default-seg 5)
       (define recordseplinespace 4)
 
-      (define-struct pict (draw     ; drawing instructions
-			   width    ; total width
-			   height   ; total height >= ascent + desecnt
-			   ascent   ; portion of height above top baseline
-			   descent  ; portion of height below bottom baseline
-			   children ; list of child records
-			   panbox)  ; panorama box
+      (define-struct pict (draw       ; drawing instructions
+			   width      ; total width
+			   height     ; total height >= ascent + desecnt
+			   ascent     ; portion of height above top baseline
+			   descent    ; portion of height below bottom baseline
+			   children   ; list of child records
+			   panbox     ; panorama box, computed on demand
+                           last)      ; a descendent for the bottom-right
         #:mutable)
       (define-struct child (pict dx dy sx sy))
       (define-struct bbox (x1 y1 x2 y2 ay dy))
@@ -32,8 +33,8 @@
 	 [() (blank 0 0 0)]
 	 [(s) (blank s s)]
 	 [(w h) (blank w h 0)]
-	 [(w a d) (make-pict `(picture ,w ,(+ a d)) w (+ a d) a d null #f)]
-	 [(w h a d) (make-pict `(picture ,w ,h) w h a d null #f)]))
+	 [(w a d) (make-pict `(picture ,w ,(+ a d)) w (+ a d) a d null #f #f)]
+	 [(w h a d) (make-pict `(picture ,w ,h) w h a d null #f #f)]))
 
       (define (extend-pict box dx dy dw da dd draw)
 	(let ([w (pict-width box)]
@@ -44,7 +45,8 @@
 		     (+ w dw) (+ h da dd) 
 		     (max 0 (+ a da)) (max 0 (+ d dd))
 		     (list (make-child box dx dy 1 1))
-		     #f)))
+		     #f
+                     (pict-last box))))
 
       (define (single-pict-offset pict subbox)
 	(let floop ([box pict]
@@ -168,6 +170,7 @@
 	(let ([b (extend-pict box 0 0 0 0 0 #f)])
 	  (set-pict-children! b null)
 	  (set-pict-panbox! b (pict-panbox box))
+          (set-pict-last! b #f)
 	  b))
 
       (define (lift p n)
@@ -189,7 +192,8 @@
 			     (+ dh (child-dy c))
 			     1 1))
 			  (pict-children p))
-		     #f)))
+		     #f
+                     (pict-last p))))
 
       (define (drop p n)
 	(let* ([dh (- (max 0 (- n (pict-ascent p))))]
@@ -204,7 +208,8 @@
 			 (- h2 a2)
 			 (pict-descent p))
 		     (pict-children p)
-		     #f)))
+		     #f
+                     (pict-last p))))
 
       (define (baseless p)
 	(let ([p (lift p (pict-descent p))])
@@ -220,7 +225,8 @@
 		       (pict-width c) (pict-height c)
 		       (pict-ascent c) (pict-descent c)
 		       (pict-children p)
-		       #f))))
+		       #f
+                       (or (pict-last c) c)))))
 
       (define (panorama-box! p)
 	(let ([bb (pict-panbox p)])
@@ -297,6 +303,22 @@
 	       ,w ,h
 	       (put ,l ,b ,(pict-draw box)))))]))
 
+      (define (use-last p sub-p)
+	(if (let floop ([p p])
+              (or (eq? p sub-p)
+                  (ormap (lambda (c) (floop (child-pict c)))
+                         (pict-children p))))
+            (make-pict (pict-draw p)
+		       (pict-width p) (pict-height p)
+		       (pict-ascent p) (pict-descent p)
+		       (list (make-child p 0 0 1 1))
+		       #f
+                       sub-p)
+            (error 'use-last
+                   "given new last pict: ~e not in the base pict: ~e"
+                   sub-p
+                   p)))
+
       (define dash-frame 
 	(case-lambda
 	 [(box) (dash-frame box default-seg)]
@@ -341,7 +363,8 @@
 	   (cadr (rotate width height))
 	   (cadr (rotate 0 height)) 0
 	   null
-	   #f)))
+	   #f
+           #f)))
 
       (define (rlist b a) (list a b))
 
@@ -459,7 +482,8 @@
                              (combine-descent fd2 rd2 fd1 rd1 fh rh h (- h dy1) (- h dy2))
                              (list (make-child first dx1 dy1 1 1)
                                    (make-child rest dx2 dy2 1 1))
-			     #f))])))))]
+			     #f
+                             (or (pict-last rest) rest)))])))))]
 	      [2max (lambda (a b c . rest) (max a b))]
 	      [zero (lambda (fw fh rw rh sep fd1 fd2 rd1 rd2 . args) 0)]
 	      [fv (lambda (a b . args) a)]
@@ -579,7 +603,25 @@
 				      (pict-width p) (pict-height p)
 				      min-a min-d
 				      (pict-children p)
-				      #f)))))))]
+				      #f
+                                      ;; Find bottomost, rightmost of old last picts to be the
+                                      ;;  new last pict.
+                                      (let ([subs (map (lambda (box)
+                                                         (let ([last (or (pict-last box)
+                                                                         box)])
+                                                           (let-values ([(x y) (rb-find p last)])
+                                                             (list last x y))))
+                                                       boxes)])
+                                        (if (null? subs)
+                                            #f
+                                            (caar (sort subs
+                                                        (lambda (a b)
+                                                          (let ([ay (caddr a)]
+                                                                [by (caddr b)])
+                                                            (cond
+                                                             [(ay . > . by) #t]
+                                                             [(= ay by) ((cadr a) . > . (cadr b))]
+                                                             [else #f]))))))))))))))]
 	      [norm (lambda (h a d ac dc) h)]
 	      [tbase (lambda (h a d ac dc) (+ a ac))] 
 	      [bbase (lambda (h a d ac dc) (+ d dc))] 
@@ -717,7 +759,8 @@
 	   (cons
 	    (make-child title 0 title-y 1 1)
 	    (map (lambda (child child-y) (make-child child 0 child-y 1 1)) fields field-ys))
-	   #f)))
+	   #f
+           #f)))
 
       (define (picture* w h a d commands)
 	(let loop ([commands commands][translated null][children null])
@@ -727,7 +770,8 @@
 			 ,@(reverse translated))
 	       w h a d
 	       children
-	       #f)
+	       #f
+               #f)
 	      (let ([c (car commands)]
 		    [rest (cdr commands)])
 		(unless (and (pair? c) (symbol? (car c)))
diff --git a/collects/texpict/private/mrpict-extra.ss b/collects/texpict/private/mrpict-extra.ss
index 777344a9b8..2a88996f5a 100644
--- a/collects/texpict/private/mrpict-extra.ss
+++ b/collects/texpict/private/mrpict-extra.ss
@@ -69,7 +69,7 @@
       (define dc 
 	(case-lambda
 	 [(f w h a d)
-	  (make-pict `(prog ,f ,h) w h a d null #f)]
+	  (make-pict `(prog ,f ,h) w h a d null #f #f)]
 	 [(f w h)
 	  (dc f w h h 0)]))
       (define prog-picture dc)
diff --git a/collects/texpict/private/texpict-extra.ss b/collects/texpict/private/texpict-extra.ss
index c53bb26c00..ecad2484c2 100644
--- a/collects/texpict/private/texpict-extra.ss
+++ b/collects/texpict/private/texpict-extra.ss
@@ -142,7 +142,8 @@
 		       (+ d h)
 		       h d
 		       null
-		       #f))]))
+		       #f
+                       #f))]))
 
       (define (text-line/phantom text phantom . args)
 	(apply tex (format "\\makebox[0pt]{\\vphantom{~a}}~a" phantom text) args))
diff --git a/collects/texpict/utils.ss b/collects/texpict/utils.ss
index 2b05571f6e..23939394b7 100644
--- a/collects/texpict/utils.ss
+++ b/collects/texpict/utils.ss
@@ -99,7 +99,8 @@
 		 w h
 		 a d
 		 (list (make-child box 0 0 1 1))
-		 #f)))
+		 #f
+                 (pict-last box))))
   
   (define cons-colorized-picture
     (lambda (p color cmds)
@@ -925,7 +926,8 @@
 		     (pict-ascent new)
 		     (pict-descent new)
 		     (list (make-child p 0 0 x-factor y-factor))
-		     #f)))]
+		     #f
+                     (pict-last new))))]
      [(p factor) (scale p factor factor)]))
 
   (define cellophane
@@ -955,7 +957,8 @@
                        (pict-ascent new)
                        (pict-descent new)
                        (list (make-child p 0 0 1 1))
-                       #f)))])]))
+                       #f
+                       (pict-last new))))])]))
 
   (define inset/clip
     (case-lambda
@@ -982,7 +985,8 @@
 		     (pict-ascent new)
 		     (pict-descent new)
 		     (list (make-child p 0 0 1 1))
-		     #f)))]
+		     #f
+                     (pict-last new))))]
      [(p h v) (inset/clip p h v h v)]
      [(p a) (inset/clip p a a a a)]))