From 1c6281111b21b6f38c356f7e3b4ea0343e683cef Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 15 Jul 2008 22:03:36 +0000 Subject: [PATCH] add render-element structure, and use it in the search doc svn: r10782 --- collects/scribble/base-render.ss | 2 ++ collects/scribble/html-render.ss | 5 +++- collects/scribble/latex-render.ss | 2 ++ collects/scribble/struct.ss | 27 ++++++++++++++++++- .../scribblings/main/private/make-search.ss | 22 +++++++-------- ...search-context.htm => search-context.html} | 0 collects/scribblings/scribble/struct.scrbl | 15 +++++++++++ collects/setup/scribble.ss | 2 +- collects/setup/setup-unit.ss | 8 ++++++ 9 files changed, 69 insertions(+), 14 deletions(-) rename collects/scribblings/main/private/{search-context.htm => search-context.html} (100%) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 491b581f71..e9d41647a4 100644 --- a/collects/scribble/base-render.ss +++ b/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)] diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index aaaf6a2d30..4b8e0650f3 100644 --- a/collects/scribble/html-render.ss +++ b/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)))] diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index b9ce918d5b..26542cbfe6 100644 --- a/collects/scribble/latex-render.ss +++ b/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))) diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index dcad36256e..a6ae47e157 100644 --- a/collects/scribble/struct.ss +++ b/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 diff --git a/collects/scribblings/main/private/make-search.ss b/collects/scribblings/main/private/make-search.ss index b30e77b60a..eab3042e42 100644 --- a/collects/scribblings/main/private/make-search.ss +++ b/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)))))) diff --git a/collects/scribblings/main/private/search-context.htm b/collects/scribblings/main/private/search-context.html similarity index 100% rename from collects/scribblings/main/private/search-context.htm rename to collects/scribblings/main/private/search-context.html diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index cd0031f7cd..6a83cb4316 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/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?))])]{ diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss index 79b30ff076..cbca2cfa3a 100644 --- a/collects/setup/scribble.ss +++ b/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" diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index e917bdeff7..a93446abf2 100644 --- a/collects/setup/setup-unit.ss +++ b/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)