add render-element structure, and use it in the search doc

svn: r10782

collects/scribble/base-render.ss

@@ -387,6 +387,8 @@
              (render-content (strip-aux (car v)) part ri)
              (render-content (list "[missing]") part ri)))]
         [(element? i)
+         (when (render-element? i)
+           ((render-element-render i) this part ri))
          (render-content (element-content i) part ri)]
         [(delayed-element? i)
          (render-content (delayed-element-content i ri) part ri)]

collects/scribble/html-render.ss

@@ -816,7 +816,10 @@
                      ,@(if (null? (element-content e))
                          `(,(format "~s" (tag-key (link-element-tag e) ri)))
                          (render-plain-element e part ri))))))))]
-        [else (render-plain-element e part ri)]))
+        [else 
+         (when (render-element? e)
+           ((render-element-render e) this part ri))
+         (render-plain-element e part ri)]))
 
     (define/private (render-plain-element e part ri)
       (let* ([raw-style (flatten-style (and (element? e) (element-style e)))]

collects/scribble/latex-render.ss

@@ -91,6 +91,8 @@
       null)
 
     (define/override (render-element e part ri)
+      (when (render-element? e)
+        ((render-element-render e) this part ri))
       (let ([part-label? (and (link-element? e)
                               (pair? (link-element-tag e))
                               (eq? 'part (car (link-element-tag e)))

collects/scribble/struct.ss

@@ -309,7 +309,9 @@
   prop:serializable
   (make-serialize-info
    (lambda (d)
-     (vector (collect-element-collect d)))
+     (vector (make-element
+              (element-style d)
+              (element-content d))))
    #'deserialize-collect-element
    #f
    (or (current-load-relative-directory) (current-directory))))
@@ -325,6 +327,29 @@
 
 ;; ----------------------------------------
 
+(define-struct (render-element element) (render)
+  #:property
+  prop:serializable
+  (make-serialize-info
+   (lambda (d)
+     (vector (make-element
+              (element-style d)
+              (element-content d))))
+   #'deserialize-render-element
+   #f
+   (or (current-load-relative-directory) (current-directory))))
+
+(provide deserialize-render-element)
+(define deserialize-render-element
+  (make-deserialize-info values values))
+
+(provide/contract
+ [struct render-element ([style any/c]
+                         [content list?]
+                         [render (any/c part? resolve-info? . -> . any)])])
+
+;; ----------------------------------------
+
 (define-struct generated-tag ()
   #:property
   prop:serializable

collects/scribblings/main/private/make-search.ss

@@ -24,7 +24,7 @@
 ;; this file is used as a trampoline to set a context (a pre-filter cookie) and
 ;; then hop over to the search page (the search page can do it itself, but it's
 ;; to heavy to load twice).
-(define-runtime-path search-context-page "search-context.htm")
+(define-runtime-path search-context-page "search-context.html")
 
 (define (quote-string str)
   (define (hex4 ch)
@@ -175,15 +175,15 @@
   (for ([src (list search-script search-context-page)])
     (define dest (build-path dest-dir (file-name-from-path src)))
     (when (file-exists? dest) (delete-file dest))
-    (copy-file src dest))
-
-  (list
-   (script-ref "plt-index.js"
-     #:noscript @list{Sorry, you must have JavaScript to use this page.})
-   (script-ref "search.js")
-   (make-element (make-with-attributes #f '((id . "plt_search_container")))
-                 null)))
+    (copy-file src dest)))
 
 (define (make-search user-dir?)
-  (make-delayed-block (lambda (r s i)
-                        (make-paragraph (make-script user-dir? r s i)))))
+  (make-paragraph
+   (list
+    (script-ref "plt-index.js"
+                #:noscript @list{Sorry, you must have JavaScript to use this page.})
+    (script-ref "search.js")
+    (make-render-element (make-with-attributes #f '((id . "plt_search_container")))
+                         null
+                         (lambda (r s i)
+                           (make-script user-dir? r s i))))))

collects/scribblings/scribble/struct.scrbl

@@ -155,6 +155,11 @@ A @deftech{block} is either a @techlink{table}, an
                          the browser, or for rendering to other
                          formats.}
 
+                   @item{An instance of @scheme[render-element] has a
+                         procedure that is called in the
+                         @techlink{render pass} of document
+                         processing.}
+
              }}}}
 
        @item{A @deftech{delayed block} is an instance of
@@ -546,6 +551,16 @@ element remains intact (i.e., it is not replaced) by either the
 
 }
 
+@defstruct[(render-element element) ([render (any/c part? resolve-info? . -> . any)])]{
+
+Like @scheme[delayed-element], but the @scheme[render] procedure is called
+during the @techlink{render pass}.
+
+If a @scheme[render-element] instance is serialized (such as when
+saving collected info), it is reduced to a @scheme[element] instance.
+
+}
+
 @defstruct[with-attributes ([style any/c]
                             [assoc (listof (cons/c symbol? string?))])]{
 

collects/setup/scribble.ss

@@ -554,7 +554,7 @@
              (let ([dir (doc-dest-dir doc)])
                (unless (directory-exists? dir) (make-directory dir))
                (for ([f (directory-list dir)]
-                     #:when (regexp-match? #"[.]html$" (path-element->bytes f)))
+                     #:when (regexp-match? #"[.](?:html|png|js)$" (path-element->bytes f)))
                  (delete-file (build-path dir f)))))
            (render-time
             "render"

collects/setup/setup-unit.ss

@@ -519,6 +519,7 @@
                     [else (void)])))))))
 
   (when (clean)
+    (setup-printf #f "--- cleaning collections ---")    
     (let ([dependencies (make-hash)])
       ;; Main deletion:
       (for ([cc ccs-to-compile]) (clean-collection cc dependencies))
@@ -555,6 +556,11 @@
 
   (define (do-install-part part)
     (when (if (eq? part 'post) (call-post-install) (call-install))
+      (setup-printf #f (format "--- ~ainstalling collections ---"
+                               (case part
+                                 [(pre) "pre-"]
+                                 [(general) ""]
+                                 [(post) "post-"])))
       (for ([cc ccs-to-compile])
         (let/ec k
           (begin-record-error cc (case part
@@ -659,6 +665,7 @@
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (when (make-zo)
+    (setup-printf #f "--- compiling collections ---")
     (with-specified-mode
      (lambda ()
        (make-it ".zos"
@@ -871,6 +878,7 @@
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (when (make-launchers)
+    (setup-printf #f "--- creating launchers ---")
     (let ([name-list
            (lambda (l)
              (unless (list-of relative-path-string? l)