scribble: fix duplicate call to `render-element' callback

This change should cut the time to generate the search index
roughly in half.

original commit: 00e1ed9369d8401ef349f9c9fb9475d30ab2cda1
This commit is contained in:
Matthew Flatt 2012-06-08 15:10:40 +08:00
parent 8f6b31924c
commit 3ac30a1f35
2 changed files with 20 additions and 9 deletions

View File

@ -1136,8 +1136,6 @@
`(,(format "~s" (tag-key (link-element-tag e) ri))) `(,(format "~s" (tag-key (link-element-tag e) ri)))
(render-plain-content e part ri))))))))] (render-plain-content e part ri))))))))]
[else [else
(when (render-element? e)
((render-element-render e) this part ri))
(render-plain-content e part ri)])) (render-plain-content e part ri)]))
(define/private (render-plain-content e part ri) (define/private (render-plain-content e part ri)
@ -1173,13 +1171,18 @@
[else null])) [else null]))
properties)) properties))
(attribs))] (attribs))]
[newline? (eq? name 'newline)]) [newline? (eq? name 'newline)]
[check-render
(lambda ()
(when (render-element? e)
((render-element-render e) this part ri)))])
(let-values ([(content) (cond (let-values ([(content) (cond
[link? [link?
(parameterize ([current-no-links #t]) (parameterize ([current-no-links #t])
(super render-content e part ri))] (super render-content e part ri))]
[newline? null] [newline? (check-render) null]
[(eq? 'hspace name) [(eq? 'hspace name)
(check-render)
(let ([str (content->string e)]) (let ([str (content->string e)])
(map (lambda (c) 'nbsp) (string->list str)))] (map (lambda (c) 'nbsp) (string->list str)))]
[else [else

View File

@ -243,8 +243,6 @@
(super render-intrapara-block p part ri first? last? starting-item?)) (super render-intrapara-block p part ri first? last? starting-item?))
(define/override (render-content e part ri) (define/override (render-content e part ri)
(when (render-element? e)
((render-element-render e) this part ri))
(let ([part-label? (and (link-element? e) (let ([part-label? (and (link-element? e)
(pair? (link-element-tag e)) (pair? (link-element-tag e))
(eq? 'part (car (link-element-tag e))) (eq? 'part (car (link-element-tag e)))
@ -285,10 +283,15 @@
(style-name es) (style-name es)
es)] es)]
[style (and (style? es) es)] [style (and (style? es) es)]
[check-render
(lambda ()
(when (render-element? e)
((render-element-render e) this part ri)))]
[core-render (lambda (e tt?) [core-render (lambda (e tt?)
(cond (cond
[(and (image-element? e) [(and (image-element? e)
(not (disable-images))) (not (disable-images)))
(check-render)
(let ([fn (install-file (let ([fn (install-file
(select-suffix (select-suffix
(main-collects-relative->path (main-collects-relative->path
@ -306,6 +309,7 @@
(ftag (xlist (convert e 'eps-bytes)) ".ps") (ftag (xlist (convert e 'eps-bytes)) ".ps")
(ftag (xlist (convert e 'png-bytes)) ".png")))) (ftag (xlist (convert e 'png-bytes)) ".png"))))
=> (lambda (bstr+info+suffix) => (lambda (bstr+info+suffix)
(check-render)
(let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)] (let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)]
[suffix (list-ref bstr+info+suffix 1)] [suffix (list-ref bstr+info+suffix 1)]
[width (list-ref (list-ref bstr+info+suffix 0) 1)] [width (list-ref (list-ref bstr+info+suffix 0) 1)]
@ -342,13 +346,16 @@
[(smaller) (wrap e "Smaller" #f)] [(smaller) (wrap e "Smaller" #f)]
[(larger) (wrap e "Larger" #f)] [(larger) (wrap e "Larger" #f)]
[(hspace) [(hspace)
(check-render)
(let ([s (content->string e)]) (let ([s (content->string e)])
(case (string-length s) (case (string-length s)
[(0) (void)] [(0) (void)]
[else [else
(printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}" (printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
(regexp-replace* #rx"." s "x"))]))] (regexp-replace* #rx"." s "x"))]))]
[(newline) (unless (suppress-newline-content) [(newline)
(check-render)
(unless (suppress-newline-content)
(printf "\\\\"))] (printf "\\\\"))]
[else (error 'latex-render [else (error 'latex-render
"unrecognzied style symbol: ~s" style)])] "unrecognzied style symbol: ~s" style)])]
@ -360,6 +367,7 @@
[else tt?])]) [else tt?])])
(cond (cond
[(multiarg-element? e) [(multiarg-element? e)
(check-render)
(printf "\\~a" style-name) (printf "\\~a" style-name)
(if (null? (multiarg-element-contents e)) (if (null? (multiarg-element-contents e))
(printf "{}") (printf "{}")