minor
svn: r8430 original commit: ec75cb5a9f57f27d138aa12a3d61db9711c12200
This commit is contained in:
Eli Barzilay
parent
81179a7eea
commit
40116e1d00
|
|
@ -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 (format-number number sep)
|
(define/public (get-substitutions) null)
|
||||||
(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 (get-suffix) #".txt")
|
||||||
(define/public (report-output!)
|
|
||||||
(set! report-output? #t))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define/public (format-number number sep)
|
||||||
;; marshal info
|
(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)))
|
||||||
|
|
||||||
(define/public (get-serialize-version)
|
(field [report-output? #f])
|
||||||
1)
|
(define/public (report-output!)
|
||||||
|
(set! report-output? #t))
|
||||||
(define/public (serialize-info ri)
|
|
||||||
(parameterize ([current-serialize-resolve-info ri])
|
|
||||||
(serialize (collect-info-ht (resolve-info-ci ri)))))
|
|
||||||
|
|
||||||
(define/public (deserialize-info v ci)
|
;; ----------------------------------------
|
||||||
(let ([ht (deserialize v)]
|
;; marshal info
|
||||||
[in-ht (collect-info-ext-ht ci)])
|
|
||||||
(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 (get-serialize-version)
|
||||||
(hash-table-map (resolve-info-undef ri) (lambda (k v) k)))
|
1)
|
||||||
|
|
||||||
(define/public (transfer-info ci src-ci)
|
(define/public (serialize-info ri)
|
||||||
(let ([in-ht (collect-info-ext-ht ci)])
|
(parameterize ([current-serialize-resolve-info ri])
|
||||||
(hash-table-for-each (collect-info-ext-ht src-ci)
|
(serialize (collect-info-ht (resolve-info-ci ri)))))
|
||||||
(lambda (k v)
|
|
||||||
(hash-table-put! in-ht k v)))))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
|
||||||
;; global-info collection
|
|
||||||
|
|
||||||
(define/public (collect ds fns)
|
(define/public (deserialize-info v ci)
|
||||||
(let ([ci (make-collect-info (make-hash-table 'equal)
|
(let ([ht (deserialize v)]
|
||||||
(make-hash-table 'equal)
|
[in-ht (collect-info-ext-ht ci)])
|
||||||
(make-hash-table)
|
(for ([(k v) ht])
|
||||||
(make-hash-table)
|
(hash-table-put! in-ht k v))))
|
||||||
""
|
(define/public (get-defined ci)
|
||||||
(make-hash-table)
|
(hash-table-map (collect-info-ht ci) (lambda (k v) k)))
|
||||||
null)])
|
|
||||||
(start-collect ds fns ci)
|
|
||||||
ci))
|
|
||||||
|
|
||||||
(define/public (start-collect ds fns ci)
|
(define/public (get-undefined ri)
|
||||||
(map (lambda (d)
|
(hash-table-map (resolve-info-undef ri) (lambda (k v) k)))
|
||||||
(collect-part d #f ci null))
|
|
||||||
ds))
|
|
||||||
|
|
||||||
(define/public (collect-part d parent ci number)
|
(define/public (transfer-info ci src-ci)
|
||||||
(let ([p-ci (make-collect-info (make-hash-table 'equal)
|
(let ([in-ht (collect-info-ext-ht ci)])
|
||||||
(collect-info-ext-ht ci)
|
(for ([(k v) (collect-info-ext-ht src-ci)])
|
||||||
(collect-info-parts ci)
|
(hash-table-put! in-ht k v))))
|
||||||
(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)
|
;; ----------------------------------------
|
||||||
(case (car k)
|
;; global-info collection
|
||||||
[(part tech)
|
|
||||||
(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 (collect-part-tags d ci number)
|
(define/public (collect ds fns)
|
||||||
(for-each (lambda (t)
|
(let ([ci (make-collect-info (make-hash-table 'equal)
|
||||||
(hash-table-put! (collect-info-ht ci)
|
(make-hash-table 'equal)
|
||||||
(generate-tag t ci)
|
(make-hash-table)
|
||||||
(list (or (part-title-content d) '("???"))
|
(make-hash-table)
|
||||||
number)))
|
""
|
||||||
(part-tags d)))
|
(make-hash-table)
|
||||||
|
null)])
|
||||||
(define/public (collect-content c ci)
|
(start-collect ds fns ci)
|
||||||
(for-each (lambda (i)
|
ci))
|
||||||
(collect-element i ci))
|
|
||||||
c))
|
|
||||||
|
|
||||||
(define/public (collect-paragraph p ci)
|
(define/public (start-collect ds fns ci)
|
||||||
(collect-content (paragraph-content p) ci))
|
(map (lambda (d) (collect-part d #f ci null))
|
||||||
|
ds))
|
||||||
|
|
||||||
(define/public (collect-flow p ci)
|
(define/public (collect-part d parent ci number)
|
||||||
(for-each (lambda (p)
|
(let ([p-ci (make-collect-info
|
||||||
(collect-flow-element p ci))
|
(make-hash-table 'equal)
|
||||||
(flow-paragraphs p)))
|
(collect-info-ext-ht ci)
|
||||||
|
(collect-info-parts ci)
|
||||||
(define/public (collect-flow-element p ci)
|
(collect-info-tags ci)
|
||||||
(cond
|
(if (part-tag-prefix d)
|
||||||
[(table? p) (collect-table p ci)]
|
(string-append (collect-info-gen-prefix ci)
|
||||||
[(itemization? p) (collect-itemization p ci)]
|
(part-tag-prefix d)
|
||||||
[(blockquote? p) (collect-blockquote p ci)]
|
":")
|
||||||
[(delayed-flow-element? p) (void)]
|
(collect-info-gen-prefix ci))
|
||||||
[else (collect-paragraph p ci)]))
|
(collect-info-relatives ci)
|
||||||
|
(cons d (collect-info-parents 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])
|
||||||
(define/public (resolve-content c d ri)
|
(unless (null? parts)
|
||||||
(for-each (lambda (i)
|
(let ([s (car parts)])
|
||||||
(resolve-element i d ri))
|
(collect-part s d p-ci
|
||||||
c))
|
(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-paragraph p d ri)
|
(define/private (convert-key prefix k)
|
||||||
(resolve-content (paragraph-content p) d ri))
|
(case (car k)
|
||||||
|
[(part tech)
|
||||||
|
(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-flow p d ri)
|
(define/public (collect-part-tags d ci number)
|
||||||
(for-each (lambda (p)
|
(for ([t (part-tags d)])
|
||||||
(resolve-flow-element p d ri))
|
(hash-table-put! (collect-info-ht ci)
|
||||||
(flow-paragraphs p)))
|
(generate-tag t ci)
|
||||||
|
(list (or (part-title-content d) '("???")) number))))
|
||||||
|
|
||||||
(define/public (resolve-flow-element p d ri)
|
(define/public (collect-content c ci)
|
||||||
(cond
|
(for ([i c]) (collect-element i 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)
|
|
||||||
(for-each (lambda (f) (when (flow? f)
|
|
||||||
(resolve-flow f d ri)))
|
|
||||||
(apply append (table-flowss i))))
|
|
||||||
|
|
||||||
(define/public (resolve-itemization i d ri)
|
|
||||||
(for-each (lambda (f) (resolve-flow f d ri))
|
|
||||||
(itemization-flows i)))
|
|
||||||
|
|
||||||
(define/public (resolve-blockquote i d ri)
|
(define/public (collect-paragraph p ci)
|
||||||
(for-each (lambda (f) (resolve-flow-element f d ri))
|
(collect-content (paragraph-content p) ci))
|
||||||
(blockquote-paragraphs i)))
|
|
||||||
|
|
||||||
(define/public (resolve-element i d ri)
|
(define/public (collect-flow p ci)
|
||||||
(cond
|
(for ([p (flow-paragraphs p)])
|
||||||
[(part-relative-element? i)
|
(collect-flow-element p ci)))
|
||||||
(resolve-content (part-relative-element-content i ri) d ri)]
|
|
||||||
[(delayed-element? i)
|
(define/public (collect-flow-element p ci)
|
||||||
(resolve-content (or (hash-table-get (resolve-info-delays ri)
|
(cond
|
||||||
i
|
[(table? p) (collect-table p ci)]
|
||||||
#f)
|
[(itemization? p) (collect-itemization p ci)]
|
||||||
(let ([v ((delayed-element-resolve i) this d ri)])
|
[(blockquote? p) (collect-blockquote p ci)]
|
||||||
(hash-table-put! (resolve-info-delays ri)
|
[(delayed-flow-element? p) (void)]
|
||||||
i
|
[else (collect-paragraph p ci)]))
|
||||||
v)
|
|
||||||
v))
|
(define/public (collect-table i ci)
|
||||||
d ri)]
|
(for ([d (apply append (table-flowss i))])
|
||||||
[(element? i)
|
(when (flow? d) (collect-flow d ci))))
|
||||||
(cond
|
|
||||||
|
(define/public (collect-itemization i ci)
|
||||||
|
(for ([d (itemization-flows i)])
|
||||||
|
(collect-flow d ci)))
|
||||||
|
|
||||||
|
(define/public (collect-blockquote i ci)
|
||||||
|
(for ([d (blockquote-paragraphs i)])
|
||||||
|
(collect-flow-element d ci)))
|
||||||
|
|
||||||
|
(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 ([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)
|
|
||||||
(render-part d ri))
|
|
||||||
|
|
||||||
(define/public (render-part d ri)
|
(define/public (render-one d ri fn)
|
||||||
(list
|
(render-part d ri))
|
||||||
(when (part-title-content d)
|
|
||||||
(render-content (part-title-content d) d ri))
|
|
||||||
(render-flow (part-flow d) d ri)
|
|
||||||
(map (lambda (s) (render-part s ri))
|
|
||||||
(part-parts d))))
|
|
||||||
|
|
||||||
(define/public (render-content c part ri)
|
|
||||||
(apply append
|
|
||||||
(map (lambda (i)
|
|
||||||
(render-element i part ri))
|
|
||||||
c)))
|
|
||||||
|
|
||||||
(define/public (render-paragraph p part ri)
|
(define/public (render-part d ri)
|
||||||
(render-content (paragraph-content p) part ri))
|
(list
|
||||||
|
(when (part-title-content d)
|
||||||
|
(render-content (part-title-content d) d ri))
|
||||||
|
(render-flow (part-flow d) d ri)
|
||||||
|
(map (lambda (s) (render-part s ri))
|
||||||
|
(part-parts d))))
|
||||||
|
|
||||||
(define/public (render-flow p part ri)
|
(define/public (render-content c part ri)
|
||||||
(apply append
|
(apply append (map (lambda (i) (render-element i part ri)) c)))
|
||||||
(map (lambda (p)
|
|
||||||
(render-flow-element p part ri))
|
|
||||||
(flow-paragraphs p))))
|
|
||||||
|
|
||||||
(define/public (render-flow-element p part ri)
|
(define/public (render-paragraph p part ri)
|
||||||
(cond
|
(render-content (paragraph-content p) part ri))
|
||||||
[(table? p) (if (auxiliary-table? p)
|
|
||||||
(render-auxiliary-table p part ri)
|
|
||||||
(render-table p part ri))]
|
|
||||||
[(itemization? p) (render-itemization p part ri)]
|
|
||||||
[(blockquote? p) (render-blockquote p part ri)]
|
|
||||||
[(delayed-flow-element? p)
|
|
||||||
(render-flow-element (delayed-flow-element-flow-elements p ri) part ri)]
|
|
||||||
[else (render-paragraph p part ri)]))
|
|
||||||
|
|
||||||
(define/public (render-auxiliary-table i part ri)
|
|
||||||
null)
|
|
||||||
|
|
||||||
(define/public (render-table i part ri)
|
(define/public (render-flow p part ri)
|
||||||
(map (lambda (d) (if (flow? i)
|
(apply append
|
||||||
(render-flow d part ri)
|
(map (lambda (p)
|
||||||
null))
|
(render-flow-element p part ri))
|
||||||
(apply append (table-flowss i))))
|
(flow-paragraphs p))))
|
||||||
|
|
||||||
(define/public (render-itemization i part ri)
|
|
||||||
(map (lambda (d) (render-flow d part ri))
|
|
||||||
(itemization-flows i)))
|
|
||||||
|
|
||||||
(define/public (render-blockquote i part ri)
|
|
||||||
(map (lambda (d) (render-flow-element d part ri))
|
|
||||||
(blockquote-paragraphs i)))
|
|
||||||
|
|
||||||
(define/public (render-element i part ri)
|
|
||||||
(cond
|
|
||||||
[(and (link-element? i)
|
|
||||||
(null? (element-content i)))
|
|
||||||
(let ([v (resolve-get part ri (link-element-tag i))])
|
|
||||||
(if v
|
|
||||||
(render-content (strip-aux (car v)) part ri)
|
|
||||||
(render-content (list "[missing]") part ri)))]
|
|
||||||
[(element? i)
|
|
||||||
(render-content (element-content i) part ri)]
|
|
||||||
[(delayed-element? i)
|
|
||||||
(render-content (delayed-element-content i ri) part ri)]
|
|
||||||
[(part-relative-element? i)
|
|
||||||
(render-content (part-relative-element-content i ri) part ri)]
|
|
||||||
[else
|
|
||||||
(render-other i part ri)]))
|
|
||||||
|
|
||||||
(define/public (render-other i part ri)
|
(define/public (render-flow-element p part ri)
|
||||||
(list i))
|
(cond
|
||||||
|
[(table? p) (if (auxiliary-table? p)
|
||||||
|
(render-auxiliary-table p part ri)
|
||||||
|
(render-table p part ri))]
|
||||||
|
[(itemization? p) (render-itemization p part ri)]
|
||||||
|
[(blockquote? p) (render-blockquote p part ri)]
|
||||||
|
[(delayed-flow-element? p)
|
||||||
|
(render-flow-element (delayed-flow-element-flow-elements p ri) part ri)]
|
||||||
|
[else (render-paragraph p part ri)]))
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define/public (render-auxiliary-table i part ri)
|
||||||
|
null)
|
||||||
|
|
||||||
(define/public (install-file fn)
|
(define/public (render-table i part ri)
|
||||||
(let ([src-dir (path-only fn)]
|
(map (lambda (d) (if (flow? i) (render-flow d part ri) null))
|
||||||
[dest-dir (get-dest-directory)]
|
(apply append (table-flowss i))))
|
||||||
[fn (file-name-from-path fn)])
|
|
||||||
(let ([src-file (build-path (or src-dir (current-directory))
|
|
||||||
fn)]
|
|
||||||
[dest-file (build-path (or dest-dir (current-directory))
|
|
||||||
fn)])
|
|
||||||
(unless (and (file-exists? dest-file)
|
|
||||||
(call-with-input-file*
|
|
||||||
src-file
|
|
||||||
(lambda (src)
|
|
||||||
(call-with-input-file*
|
|
||||||
dest-file
|
|
||||||
(lambda (dest)
|
|
||||||
(or (equal? (port-file-identity src)
|
|
||||||
(port-file-identity dest))
|
|
||||||
(let loop ()
|
|
||||||
(let ([s (read-bytes 4096 src)]
|
|
||||||
[d (read-bytes 4096 dest)])
|
|
||||||
(and (equal? s d)
|
|
||||||
(if (eof-object? s)
|
|
||||||
#t
|
|
||||||
(loop)))))))))))
|
|
||||||
(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/public (render-itemization i part ri)
|
||||||
|
(map (lambda (d) (render-flow d part ri))
|
||||||
|
(itemization-flows i)))
|
||||||
|
|
||||||
(define/private (do-table-of-contents part ri delta quiet)
|
(define/public (render-blockquote i part ri)
|
||||||
(make-table #f (generate-toc part
|
(map (lambda (d) (render-flow-element d part ri))
|
||||||
ri
|
(blockquote-paragraphs i)))
|
||||||
(+ delta
|
|
||||||
(length (collected-info-number
|
|
||||||
(part-collected-info part ri))))
|
|
||||||
#t
|
|
||||||
quiet)))
|
|
||||||
|
|
||||||
(define/public (table-of-contents part ri)
|
(define/public (render-element i part ri)
|
||||||
(do-table-of-contents part ri -1 not))
|
(cond
|
||||||
|
[(and (link-element? i)
|
||||||
|
(null? (element-content i)))
|
||||||
|
(let ([v (resolve-get part ri (link-element-tag i))])
|
||||||
|
(if v
|
||||||
|
(render-content (strip-aux (car v)) part ri)
|
||||||
|
(render-content (list "[missing]") part ri)))]
|
||||||
|
[(element? i)
|
||||||
|
(render-content (element-content i) part ri)]
|
||||||
|
[(delayed-element? i)
|
||||||
|
(render-content (delayed-element-content i ri) part ri)]
|
||||||
|
[(part-relative-element? i)
|
||||||
|
(render-content (part-relative-element-content i ri) part ri)]
|
||||||
|
[else (render-other i part ri)]))
|
||||||
|
|
||||||
(define/public (local-table-of-contents part ri)
|
(define/public (render-other i part ri)
|
||||||
(table-of-contents part ri))
|
(list i))
|
||||||
|
|
||||||
(define/public (quiet-table-of-contents part ri)
|
;; ----------------------------------------
|
||||||
(do-table-of-contents part ri 1 (lambda (x) #t)))
|
|
||||||
|
|
||||||
(define/private (generate-toc part ri base-len skip? quiet)
|
(define/public (install-file fn)
|
||||||
(let ([number (collected-info-number (part-collected-info part ri))])
|
(let ([src-dir (path-only fn)]
|
||||||
(let ([subs
|
[dest-dir (get-dest-directory)]
|
||||||
(if (quiet (and (part-style? part 'quiet)
|
[fn (file-name-from-path fn)])
|
||||||
(not (= base-len (sub1 (length number))))))
|
(let ([src-file (build-path (or src-dir (current-directory)) fn)]
|
||||||
(apply
|
[dest-file (build-path (or dest-dir (current-directory)) fn)])
|
||||||
append
|
(unless (and (file-exists? dest-file)
|
||||||
(map (lambda (p) (generate-toc p ri base-len #f quiet)) (part-parts part)))
|
(call-with-input-file*
|
||||||
null)])
|
src-file
|
||||||
(if skip?
|
(lambda (src)
|
||||||
subs
|
(call-with-input-file*
|
||||||
(let ([l (cons
|
dest-file
|
||||||
(list (make-flow
|
(lambda (dest)
|
||||||
(list
|
(or (equal? (port-file-identity src)
|
||||||
(make-paragraph
|
(port-file-identity dest))
|
||||||
(list
|
(let loop ()
|
||||||
(make-element 'hspace (list (make-string (* 2 (- (length number) base-len)) #\space)))
|
(let ([s (read-bytes 4096 src)]
|
||||||
(make-link-element (if (= 1 (length number))
|
[d (read-bytes 4096 dest)])
|
||||||
"toptoclink"
|
(and (equal? s d)
|
||||||
"toclink")
|
(or (eof-object? s) (loop)))))))))))
|
||||||
(append
|
(when (file-exists? dest-file) (delete-file dest-file))
|
||||||
(format-number number
|
(make-directory* (path-only dest-file))
|
||||||
(list
|
(copy-file src-file dest-file))
|
||||||
(make-element 'hspace '(" "))))
|
(path->string fn))))
|
||||||
(or (part-title-content part) '("???")))
|
|
||||||
(car (part-tags part))))))))
|
;; ----------------------------------------
|
||||||
subs)])
|
|
||||||
(if (and (= 1 (length number))
|
(define/private (do-table-of-contents part ri delta quiet)
|
||||||
(or (not (car number))
|
(make-table #f (generate-toc part
|
||||||
((car number) . > . 1)))
|
ri
|
||||||
(cons (list (make-flow (list (make-paragraph (list
|
(+ delta
|
||||||
(make-element 'hspace (list "")))))))
|
(length (collected-info-number
|
||||||
l)
|
(part-collected-info part ri))))
|
||||||
l))))))
|
#t
|
||||||
|
quiet)))
|
||||||
;; ----------------------------------------
|
|
||||||
|
(define/public (table-of-contents part ri)
|
||||||
(super-new))))
|
(do-table-of-contents part ri -1 not))
|
||||||
|
|
||||||
|
(define/public (local-table-of-contents part ri)
|
||||||
|
(table-of-contents part ri))
|
||||||
|
|
||||||
|
(define/public (quiet-table-of-contents part ri)
|
||||||
|
(do-table-of-contents part ri 1 (lambda (x) #t)))
|
||||||
|
|
||||||
|
(define/private (generate-toc part ri base-len skip? quiet)
|
||||||
|
(let* ([number (collected-info-number (part-collected-info part ri))]
|
||||||
|
[subs
|
||||||
|
(if (quiet (and (part-style? part 'quiet)
|
||||||
|
(not (= base-len (sub1 (length number))))))
|
||||||
|
(apply append (map (lambda (p)
|
||||||
|
(generate-toc p ri base-len #f quiet))
|
||||||
|
(part-parts part)))
|
||||||
|
null)])
|
||||||
|
(if skip?
|
||||||
|
subs
|
||||||
|
(let ([l (cons
|
||||||
|
(list (make-flow
|
||||||
|
(list
|
||||||
|
(make-paragraph
|
||||||
|
(list
|
||||||
|
(make-element
|
||||||
|
'hspace
|
||||||
|
(list (make-string (* 2 (- (length number)
|
||||||
|
base-len))
|
||||||
|
#\space)))
|
||||||
|
(make-link-element
|
||||||
|
(if (= 1 (length number)) "toptoclink" "toclink")
|
||||||
|
(append
|
||||||
|
(format-number
|
||||||
|
number
|
||||||
|
(list (make-element 'hspace '(" "))))
|
||||||
|
(or (part-title-content part) '("???")))
|
||||||
|
(car (part-tags part))))))))
|
||||||
|
subs)])
|
||||||
|
(if (and (= 1 (length number))
|
||||||
|
(or (not (car number)) ((car number) . > . 1)))
|
||||||
|
(cons (list (make-flow
|
||||||
|
(list (make-paragraph
|
||||||
|
(list (make-element 'hspace (list "")))))))
|
||||||
|
l)
|
||||||
|
l)))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
(super-new)))
|
||||||
|
|
|
||||||
|
|
@ -501,12 +501,13 @@
|
||||||
[else (super render-element e part ri)])))
|
[else (super render-element e part ri)])))
|
||||||
|
|
||||||
(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)))])
|
||||||
|
|
|
||||||
|
|
@ -396,7 +396,7 @@
|
||||||
[(#\u03BC) (display "$\\mu$")]
|
[(#\u03BC) (display "$\\mu$")]
|
||||||
[else (display c)]))
|
[else (display c)]))
|
||||||
(loop (add1 i))))))
|
(loop (add1 i))))))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(define/override (table-of-contents sec ri)
|
(define/override (table-of-contents sec ri)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user