suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

minor

Browse Source 
svn: r8430

original commit: ec75cb5a9f57f27d138aa12a3d61db9711c12200
This commit is contained in:
Eli Barzilay 2008-01-27 07:00:07 +00:00
parent 81179a7eea
commit 40116e1d00
3 changed files with 394 additions and 443 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

806
collects/scribble/base-render.ss
View File

@ -1,303 +1,264 @@
(module base-render scheme/base #lang scheme/base
(require "struct.ss"
mzlib/class
mzlib/serialize
scheme/file
scheme/path
setup/main-collects)
(provide render%) (require "struct.ss"
mzlib/class
mzlib/serialize
scheme/file
scheme/path
setup/main-collects)
(define render% (provide render%)
(class object%
(init-field dest-dir) (define render%
(class object%
(define/public (get-dest-directory) (init-field dest-dir)
dest-dir)
(define/public (get-substitutions) null) (define/public (get-dest-directory) dest-dir)
(define/public (get-suffix) #".txt") (define/public (get-substitutions) null)
(define/public (format-number number sep) (define/public (get-suffix) #".txt")
(if (or (null? number)
(andmap not number))
null
(cons
(let ([s (apply
string-append
(map (lambda (n)
(if n
(format "~s." n)
""))
(reverse number)))])
(substring s 0 (sub1 (string-length s))))
sep)))
(field [report-output? #f]) (define/public (format-number number sep)
(define/public (report-output!) (if (or (null? number)
(set! report-output? #t)) (andmap not number))
null
(cons (let ([s (apply
string-append
(map (lambda (n) (if n (format "~s." n) ""))
(reverse number)))])
(substring s 0 (sub1 (string-length s))))
sep)))
;; ---------------------------------------- (field [report-output? #f])
;; marshal info (define/public (report-output!)
(set! report-output? #t))
(define/public (get-serialize-version) ;; ----------------------------------------
1) ;; marshal info
(define/public (serialize-info ri) (define/public (get-serialize-version)
(parameterize ([current-serialize-resolve-info ri]) 1)
(serialize (collect-info-ht (resolve-info-ci ri)))))
(define/public (deserialize-info v ci) (define/public (serialize-info ri)
(let ([ht (deserialize v)] (parameterize ([current-serialize-resolve-info ri])
[in-ht (collect-info-ext-ht ci)]) (serialize (collect-info-ht (resolve-info-ci ri)))))
(hash-table-for-each ht (lambda (k v)
(hash-table-put! in-ht k v)))))
(define/public (get-defined ci)
(hash-table-map (collect-info-ht ci) (lambda (k v) k)))
(define/public (get-undefined ri) (define/public (deserialize-info v ci)
(hash-table-map (resolve-info-undef ri) (lambda (k v) k))) (let ([ht (deserialize v)]
[in-ht (collect-info-ext-ht ci)])
(for ([(k v) ht])
(hash-table-put! in-ht k v))))
(define/public (get-defined ci)
(hash-table-map (collect-info-ht ci) (lambda (k v) k)))
(define/public (transfer-info ci src-ci) (define/public (get-undefined ri)
(let ([in-ht (collect-info-ext-ht ci)]) (hash-table-map (resolve-info-undef ri) (lambda (k v) k)))
(hash-table-for-each (collect-info-ext-ht src-ci)
(lambda (k v)
(hash-table-put! in-ht k v)))))
;; ---------------------------------------- (define/public (transfer-info ci src-ci)
;; global-info collection (let ([in-ht (collect-info-ext-ht ci)])
(for ([(k v) (collect-info-ext-ht src-ci)])
(hash-table-put! in-ht k v))))
(define/public (collect ds fns) ;; ----------------------------------------
(let ([ci (make-collect-info (make-hash-table 'equal) ;; global-info collection
(make-hash-table 'equal)
(make-hash-table)
(make-hash-table)
""
(make-hash-table)
null)])
(start-collect ds fns ci)
ci))
(define/public (start-collect ds fns ci) (define/public (collect ds fns)
(map (lambda (d) (let ([ci (make-collect-info (make-hash-table 'equal)
(collect-part d #f ci null)) (make-hash-table 'equal)
ds)) (make-hash-table)
(make-hash-table)
""
(make-hash-table)
null)])
(start-collect ds fns ci)
ci))
(define/public (collect-part d parent ci number) (define/public (start-collect ds fns ci)
(let ([p-ci (make-collect-info (make-hash-table 'equal) (map (lambda (d) (collect-part d #f ci null))
(collect-info-ext-ht ci) ds))
(collect-info-parts ci)
(collect-info-tags ci)
(if (part-tag-prefix d)
(string-append (collect-info-gen-prefix ci)
(part-tag-prefix d)
":")
(collect-info-gen-prefix ci))
(collect-info-relatives ci)
(cons d (collect-info-parents ci)))])
(when (part-title-content d)
(collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number)
(collect-content (part-to-collect d) p-ci)
(collect-flow (part-flow d) p-ci)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
(cons (if (unnumbered-part? s)
#f
pos)
number))
(loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos))))))
(hash-table-put! (collect-info-parts ci)
d
(make-collected-info
number
parent
(collect-info-ht p-ci)))
(let ([prefix (part-tag-prefix d)])
(hash-table-for-each (collect-info-ht p-ci)
(lambda (k v)
(when (cadr k)
(collect-put! ci
(if prefix
(convert-key prefix k)
k)
v)))))))
(define/private (convert-key prefix k) (define/public (collect-part d parent ci number)
(case (car k) (let ([p-ci (make-collect-info
[(part tech) (make-hash-table 'equal)
(if (string? (cadr k)) (collect-info-ext-ht ci)
(list (car k) (string-append prefix ":" (cadr k))) (collect-info-parts ci)
k)] (collect-info-tags ci)
[(index-entry) (if (part-tag-prefix d)
(let ([v (convert-key prefix (cadr k))]) (string-append (collect-info-gen-prefix ci)
(if (eq? v (cadr k)) (part-tag-prefix d)
k ":")
(list 'index-entry v)))] (collect-info-gen-prefix ci))
[else k])) (collect-info-relatives ci)
(cons d (collect-info-parents ci)))])
(define/public (collect-part-tags d ci number)
(for-each (lambda (t)
(hash-table-put! (collect-info-ht ci)
(generate-tag t ci)
(list (or (part-title-content d) '("???"))
number)))
(part-tags d)))
(define/public (collect-content c ci)
(for-each (lambda (i)
(collect-element i ci))
c))
(define/public (collect-paragraph p ci)
(collect-content (paragraph-content p) ci))
(define/public (collect-flow p ci)
(for-each (lambda (p)
(collect-flow-element p ci))
(flow-paragraphs p)))
(define/public (collect-flow-element p ci)
(cond
[(table? p) (collect-table p ci)]
[(itemization? p) (collect-itemization p ci)]
[(blockquote? p) (collect-blockquote p ci)]
[(delayed-flow-element? p) (void)]
[else (collect-paragraph p ci)]))
(define/public (collect-table i ci)
(for-each (lambda (d) (when (flow? d)
(collect-flow d ci)))
(apply append (table-flowss i))))
(define/public (collect-itemization i ci)
(for-each (lambda (d) (collect-flow d ci))
(itemization-flows i)))
(define/public (collect-blockquote i ci)
(for-each (lambda (d) (collect-flow-element d ci))
(blockquote-paragraphs i)))
(define/public (collect-element i ci)
(if (part-relative-element? i)
(let ([content
(or (hash-table-get (collect-info-relatives ci)
i
#f)
(let ([v ((part-relative-element-collect i) ci)])
(hash-table-put! (collect-info-relatives ci)
i
v)
v))])
(collect-content content ci))
(begin
(when (target-element? i)
(collect-target-element i ci))
(when (index-element? i)
(collect-index-element i ci))
(when (collect-element? i)
((collect-element-collect i) ci))
(when (element? i)
(for-each (lambda (e)
(collect-element e ci))
(element-content i))))))
(define/public (collect-target-element i ci)
(collect-put! ci
(generate-tag (target-element-tag i) ci)
(list i)))
(define/public (collect-index-element i ci)
(collect-put! ci
`(index-entry ,(generate-tag (index-element-tag i) ci))
(list (index-element-plain-seq i)
(index-element-entry-seq i)
(index-element-desc i))))
;; ----------------------------------------
;; global-info resolution
(define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci
(make-hash-table)
(make-hash-table 'equal)
(make-hash-table 'equal))])
(start-resolve ds fns ri)
ri))
(define/public (start-resolve ds fns ri)
(map (lambda (d)
(resolve-part d ri))
ds))
(define/public (resolve-part d ri)
(when (part-title-content d) (when (part-title-content d)
(resolve-content (part-title-content d) d ri)) (collect-content (part-title-content d) p-ci))
(resolve-flow (part-flow d) d ri) (collect-part-tags d p-ci number)
(for-each (lambda (p) (collect-content (part-to-collect d) p-ci)
(resolve-part p ri)) (collect-flow (part-flow d) p-ci)
(part-parts d))) (let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
(cons (if (unnumbered-part? s) #f pos)
number))
(loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos))))))
(hash-table-put! (collect-info-parts ci)
d
(make-collected-info number
parent
(collect-info-ht p-ci)))
(let ([prefix (part-tag-prefix d)])
(for ([(k v) (collect-info-ht p-ci)])
(when (cadr k)
(collect-put! ci (if prefix (convert-key prefix k) k) v))))))
(define/public (resolve-content c d ri) (define/private (convert-key prefix k)
(for-each (lambda (i) (case (car k)
(resolve-element i d ri)) [(part tech)
c)) (if (string? (cadr k))
(list (car k) (string-append prefix ":" (cadr k)))
k)]
[(index-entry)
(let ([v (convert-key prefix (cadr k))])
(if (eq? v (cadr k)) k (list 'index-entry v)))]
[else k]))
(define/public (resolve-paragraph p d ri) (define/public (collect-part-tags d ci number)
(resolve-content (paragraph-content p) d ri)) (for ([t (part-tags d)])
(hash-table-put! (collect-info-ht ci)
(generate-tag t ci)
(list (or (part-title-content d) '("???")) number))))
(define/public (resolve-flow p d ri) (define/public (collect-content c ci)
(for-each (lambda (p) (for ([i c]) (collect-element i ci)))
(resolve-flow-element p d ri))
(flow-paragraphs p)))
(define/public (resolve-flow-element p d ri) (define/public (collect-paragraph p ci)
(cond (collect-content (paragraph-content p) ci))
[(table? p) (resolve-table p d ri)]
[(itemization? p) (resolve-itemization p d ri)]
[(blockquote? p) (resolve-blockquote p d ri)]
[(delayed-flow-element? p)
(let ([v ((delayed-flow-element-resolve p) this d ri)])
(hash-table-put! (resolve-info-delays ri) p v)
(resolve-flow-element v d ri))]
[else (resolve-paragraph p d ri)]))
(define/public (resolve-table i d ri) (define/public (collect-flow p ci)
(for-each (lambda (f) (when (flow? f) (for ([p (flow-paragraphs p)])
(resolve-flow f d ri))) (collect-flow-element p ci)))
(apply append (table-flowss i))))
(define/public (resolve-itemization i d ri) (define/public (collect-flow-element p ci)
(for-each (lambda (f) (resolve-flow f d ri)) (cond
(itemization-flows i))) [(table? p) (collect-table p ci)]
[(itemization? p) (collect-itemization p ci)]
[(blockquote? p) (collect-blockquote p ci)]
[(delayed-flow-element? p) (void)]
[else (collect-paragraph p ci)]))
(define/public (resolve-blockquote i d ri) (define/public (collect-table i ci)
(for-each (lambda (f) (resolve-flow-element f d ri)) (for ([d (apply append (table-flowss i))])
(blockquote-paragraphs i))) (when (flow? d) (collect-flow d ci))))
(define/public (resolve-element i d ri) (define/public (collect-itemization i ci)
(cond (for ([d (itemization-flows i)])
[(part-relative-element? i) (collect-flow d ci)))
(resolve-content (part-relative-element-content i ri) d ri)]
[(delayed-element? i) (define/public (collect-blockquote i ci)
(resolve-content (or (hash-table-get (resolve-info-delays ri) (for ([d (blockquote-paragraphs i)])
i (collect-flow-element d ci)))
#f)
(let ([v ((delayed-element-resolve i) this d ri)]) (define/public (collect-element i ci)
(hash-table-put! (resolve-info-delays ri) (if (part-relative-element? i)
i (let ([content
v) (or (hash-table-get (collect-info-relatives ci) i #f)
v)) (let ([v ((part-relative-element-collect i) ci)])
d ri)] (hash-table-put! (collect-info-relatives ci) i v)
[(element? i) v))])
(cond (collect-content content ci))
(begin
(when (target-element? i) (collect-target-element i ci))
(when (index-element? i) (collect-index-element i ci))
(when (collect-element? i) ((collect-element-collect i) ci))
(when (element? i)
(for ([e (element-content i)])
(collect-element e ci))))))
(define/public (collect-target-element i ci)
(collect-put! ci
(generate-tag (target-element-tag i) ci)
(list i)))
(define/public (collect-index-element i ci)
(collect-put! ci
`(index-entry ,(generate-tag (index-element-tag i) ci))
(list (index-element-plain-seq i)
(index-element-entry-seq i)
(index-element-desc i))))
;; ----------------------------------------
;; global-info resolution
(define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci
(make-hash-table)
(make-hash-table 'equal)
(make-hash-table 'equal))])
(start-resolve ds fns ri)
ri))
(define/public (start-resolve ds fns ri)
(map (lambda (d) (resolve-part d ri)) ds))
(define/public (resolve-part d ri)
(when (part-title-content d)
(resolve-content (part-title-content d) d ri))
(resolve-flow (part-flow d) d ri)
(for ([p (part-parts d)])
(resolve-part p ri)))
(define/public (resolve-content c d ri)
(for ([i c])
(resolve-element i d ri)))
(define/public (resolve-paragraph p d ri)
(resolve-content (paragraph-content p) d ri))
(define/public (resolve-flow p d ri)
(for ([p (flow-paragraphs p)])
(resolve-flow-element p d ri)))
(define/public (resolve-flow-element p d ri)
(cond
[(table? p) (resolve-table p d ri)]
[(itemization? p) (resolve-itemization p d ri)]
[(blockquote? p) (resolve-blockquote p d ri)]
[(delayed-flow-element? p)
(let ([v ((delayed-flow-element-resolve p) this d ri)])
(hash-table-put! (resolve-info-delays ri) p v)
(resolve-flow-element v d ri))]
[else (resolve-paragraph p d ri)]))
(define/public (resolve-table i d ri)
(for ([f (apply append (table-flowss i))])
(when (flow? f) (resolve-flow f d ri))))
(define/public (resolve-itemization i d ri)
(for ([f (itemization-flows i)])
(resolve-flow f d ri)))
(define/public (resolve-blockquote i d ri)
(for ([f (blockquote-paragraphs i)])
(resolve-flow-element f d ri)))
(define/public (resolve-element i d ri)
(cond
[(part-relative-element? i)
(resolve-content (part-relative-element-content i ri) d ri)]
[(delayed-element? i)
(resolve-content (or (hash-table-get (resolve-info-delays ri) i #f)
(let ([v ((delayed-element-resolve i) this d ri)])
(hash-table-put! (resolve-info-delays ri) i v)
v))
d ri)]
[(element? i)
(cond
[(index-element? i) [(index-element? i)
(let ([e (index-element-desc i)]) (let ([e (index-element-desc i)])
(when (delayed-index-desc? e) (when (delayed-index-desc? e)
@ -305,184 +266,173 @@
(hash-table-put! (resolve-info-delays ri) e v))))] (hash-table-put! (resolve-info-delays ri) e v))))]
[(link-element? i) [(link-element? i)
(resolve-get d ri (link-element-tag i))]) (resolve-get d ri (link-element-tag i))])
(for-each (lambda (e) (for ([e (element-content i)])
(resolve-element e d ri)) (resolve-element e d ri))]))
(element-content i))]))
;; ---------------------------------------- ;; ----------------------------------------
;; render methods ;; render methods
(define/public (render ds fns ri) (define/public (render ds fns ri)
(map (lambda (d fn) (map (lambda (d fn)
(when report-output? (when report-output? (printf " [Output to ~a]\n" fn))
(printf " [Output to ~a]\n" fn)) (with-output-to-file fn #:exists 'truncate/replace
(with-output-to-file fn (lambda () (render-one d ri fn))))
#:exists 'truncate/replace ds
(lambda () fns))
(render-one d ri fn))))
ds
fns))
(define/public (render-one d ri fn) (define/public (render-one d ri fn)
(render-part d ri)) (render-part d ri))
(define/public (render-part d ri) (define/public (render-part d ri)
(list (list
(when (part-title-content d) (when (part-title-content d)
(render-content (part-title-content d) d ri)) (render-content (part-title-content d) d ri))
(render-flow (part-flow d) d ri) (render-flow (part-flow d) d ri)
(map (lambda (s) (render-part s ri)) (map (lambda (s) (render-part s ri))
(part-parts d)))) (part-parts d))))
(define/public (render-content c part ri) (define/public (render-content c part ri)
(apply append (apply append (map (lambda (i) (render-element i part ri)) c)))
(map (lambda (i)
(render-element i part ri))
c)))
(define/public (render-paragraph p part ri) (define/public (render-paragraph p part ri)
(render-content (paragraph-content p) part ri)) (render-content (paragraph-content p) part ri))
(define/public (render-flow p part ri) (define/public (render-flow p part ri)
(apply append (apply append
(map (lambda (p) (map (lambda (p)
(render-flow-element p part ri)) (render-flow-element p part ri))
(flow-paragraphs p)))) (flow-paragraphs p))))
(define/public (render-flow-element p part ri) (define/public (render-flow-element p part ri)
(cond (cond
[(table? p) (if (auxiliary-table? p) [(table? p) (if (auxiliary-table? p)
(render-auxiliary-table p part ri) (render-auxiliary-table p part ri)
(render-table p part ri))] (render-table p part ri))]
[(itemization? p) (render-itemization p part ri)] [(itemization? p) (render-itemization p part ri)]
[(blockquote? p) (render-blockquote p part ri)] [(blockquote? p) (render-blockquote p part ri)]
[(delayed-flow-element? p) [(delayed-flow-element? p)
(render-flow-element (delayed-flow-element-flow-elements p ri) part ri)] (render-flow-element (delayed-flow-element-flow-elements p ri) part ri)]
[else (render-paragraph p part ri)])) [else (render-paragraph p part ri)]))
(define/public (render-auxiliary-table i part ri) (define/public (render-auxiliary-table i part ri)
null) null)
(define/public (render-table i part ri) (define/public (render-table i part ri)
(map (lambda (d) (if (flow? i) (map (lambda (d) (if (flow? i) (render-flow d part ri) null))
(render-flow d part ri) (apply append (table-flowss i))))
null))
(apply append (table-flowss i))))
(define/public (render-itemization i part ri) (define/public (render-itemization i part ri)
(map (lambda (d) (render-flow d part ri)) (map (lambda (d) (render-flow d part ri))
(itemization-flows i))) (itemization-flows i)))
(define/public (render-blockquote i part ri) (define/public (render-blockquote i part ri)
(map (lambda (d) (render-flow-element d part ri)) (map (lambda (d) (render-flow-element d part ri))
(blockquote-paragraphs i))) (blockquote-paragraphs i)))
(define/public (render-element i part ri) (define/public (render-element i part ri)
(cond (cond
[(and (link-element? i) [(and (link-element? i)
(null? (element-content i))) (null? (element-content i)))
(let ([v (resolve-get part ri (link-element-tag i))]) (let ([v (resolve-get part ri (link-element-tag i))])
(if v (if v
(render-content (strip-aux (car v)) part ri) (render-content (strip-aux (car v)) part ri)
(render-content (list "[missing]") part ri)))] (render-content (list "[missing]") part ri)))]
[(element? i) [(element? i)
(render-content (element-content i) part ri)] (render-content (element-content i) part ri)]
[(delayed-element? i) [(delayed-element? i)
(render-content (delayed-element-content i ri) part ri)] (render-content (delayed-element-content i ri) part ri)]
[(part-relative-element? i) [(part-relative-element? i)
(render-content (part-relative-element-content i ri) part ri)] (render-content (part-relative-element-content i ri) part ri)]
[else [else (render-other i part ri)]))
(render-other i part ri)]))
(define/public (render-other i part ri) (define/public (render-other i part ri)
(list i)) (list i))
;; ---------------------------------------- ;; ----------------------------------------
(define/public (install-file fn) (define/public (install-file fn)
(let ([src-dir (path-only fn)] (let ([src-dir (path-only fn)]
[dest-dir (get-dest-directory)] [dest-dir (get-dest-directory)]
[fn (file-name-from-path fn)]) [fn (file-name-from-path fn)])
(let ([src-file (build-path (or src-dir (current-directory)) (let ([src-file (build-path (or src-dir (current-directory)) fn)]
fn)] [dest-file (build-path (or dest-dir (current-directory)) fn)])
[dest-file (build-path (or dest-dir (current-directory)) (unless (and (file-exists? dest-file)
fn)]) (call-with-input-file*
(unless (and (file-exists? dest-file) src-file
(call-with-input-file* (lambda (src)
src-file (call-with-input-file*
(lambda (src) dest-file
(call-with-input-file* (lambda (dest)
dest-file (or (equal? (port-file-identity src)
(lambda (dest) (port-file-identity dest))
(or (equal? (port-file-identity src) (let loop ()
(port-file-identity dest)) (let ([s (read-bytes 4096 src)]
(let loop () [d (read-bytes 4096 dest)])
(let ([s (read-bytes 4096 src)] (and (equal? s d)
[d (read-bytes 4096 dest)]) (or (eof-object? s) (loop)))))))))))
(and (equal? s d) (when (file-exists? dest-file) (delete-file dest-file))
(if (eof-object? s) (make-directory* (path-only dest-file))
#t (copy-file src-file dest-file))
(loop))))))))))) (path->string fn))))
(when (file-exists? dest-file) (delete-file dest-file))
(make-directory* (path-only dest-file))
(copy-file src-file dest-file))
(path->string fn))))
;; ---------------------------------------- ;; ----------------------------------------
(define/private (do-table-of-contents part ri delta quiet) (define/private (do-table-of-contents part ri delta quiet)
(make-table #f (generate-toc part (make-table #f (generate-toc part
ri ri
(+ delta (+ delta
(length (collected-info-number (length (collected-info-number
(part-collected-info part ri)))) (part-collected-info part ri))))
#t #t
quiet))) quiet)))
(define/public (table-of-contents part ri) (define/public (table-of-contents part ri)
(do-table-of-contents part ri -1 not)) (do-table-of-contents part ri -1 not))
(define/public (local-table-of-contents part ri) (define/public (local-table-of-contents part ri)
(table-of-contents part ri)) (table-of-contents part ri))
(define/public (quiet-table-of-contents part ri) (define/public (quiet-table-of-contents part ri)
(do-table-of-contents part ri 1 (lambda (x) #t))) (do-table-of-contents part ri 1 (lambda (x) #t)))
(define/private (generate-toc part ri base-len skip? quiet) (define/private (generate-toc part ri base-len skip? quiet)
(let ([number (collected-info-number (part-collected-info part ri))]) (let* ([number (collected-info-number (part-collected-info part ri))]
(let ([subs [subs
(if (quiet (and (part-style? part 'quiet) (if (quiet (and (part-style? part 'quiet)
(not (= base-len (sub1 (length number)))))) (not (= base-len (sub1 (length number))))))
(apply (apply append (map (lambda (p)
append (generate-toc p ri base-len #f quiet))
(map (lambda (p) (generate-toc p ri base-len #f quiet)) (part-parts part))) (part-parts part)))
null)]) null)])
(if skip? (if skip?
subs subs
(let ([l (cons (let ([l (cons
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (list
(make-element 'hspace (list (make-string (* 2 (- (length number) base-len)) #\space))) (make-element
(make-link-element (if (= 1 (length number)) 'hspace
"toptoclink" (list (make-string (* 2 (- (length number)
"toclink") base-len))
(append #\space)))
(format-number number (make-link-element
(list (if (= 1 (length number)) "toptoclink" "toclink")
(make-element 'hspace '(" ")))) (append
(or (part-title-content part) '("???"))) (format-number
(car (part-tags part)))))))) number
subs)]) (list (make-element 'hspace '(" "))))
(if (and (= 1 (length number)) (or (part-title-content part) '("???")))
(or (not (car number)) (car (part-tags part))))))))
((car number) . > . 1))) subs)])
(cons (list (make-flow (list (make-paragraph (list (if (and (= 1 (length number))
(make-element 'hspace (list ""))))))) (or (not (car number)) ((car number) . > . 1)))
l) (cons (list (make-flow
l)))))) (list (make-paragraph
(list (make-element 'hspace (list "")))))))
l)
l)))))
;; ---------------------------------------- ;; ----------------------------------------
(super-new)))) (super-new)))

5
collects/scribble/html-render.ss
View File

@ -503,10 +503,11 @@
(define/override (render-table t part ri) (define/override (render-table t part ri)
`((table ((cellspacing "0") `((table ((cellspacing "0")
,@(case (table-style t) ,@(case (table-style t)
[(boxed) '((class "boxed"))] [(boxed) '((class "boxed"))]
[(centered) '((align "center"))] [(centered) '((align "center"))]
[(at-right) '((align "right"))] [(at-right) '((align "right"))]
[(at-left) '((align "left"))] [(at-left) '((align "left"))]
[(index) '((align "right"))]
[else null]) [else null])
,@(let ([a (and (list? (table-style t)) ,@(let ([a (and (list? (table-style t))
(assoc 'style (table-style t)))]) (assoc 'style (table-style t)))])