1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;;; file-split-info-c/as
;;; add split-info for chapters and appendices
(define (file-split-info-c/as files)
(lambda (s)
(let ((ids (gen-ns "Subfile ID's"))
(idx (gen-ns "Subfile Index ID's"))
(get-val (lambda (ids from)
(let*
((v1 (if
(pair? from)
(cdr from)
; (error "file info, get" "can't resolve" from)
"<nowhere>"))
(v2 (ids 'lookup v1)))
(if (pair? v2)
(cons (cdr v2) v1)
(error "file info, get" "no file bound to" v1)
;`("<nofile>" . ,v1)
))))
(xcadr (lambda n (cadr n)))
(xcadr-tail (lambda n (tail (cadr n))))
(gt-no (lambda (t old) (xatv t 'NO))))
(letrec
((g (rdp-cond*
`((#(ENDTAG (XREF INDEX FIGURE
SECT SECT1 SECT2 SECTN
APPDX APPDX1 APPDX2 APPDXN PART CHAPT
APPDXS
BOOK DOCUMENT REPORT)))
(#(STARTTAG CHAPT)
,(rdp-let-fetch
`((FILES ,xcadr ,xcadr-tail))
(rdp-repll
`((,(lambda (t f)
(let* ((ida (xatv t 'NO))
(cf (head f)))
(ids 'bind cf ida)
`#(STARTTAG CHAPT
(#(FILE TOKEN ,cf) . ,(token-args t)))))
FILES)
,identity)
(rdp-call g))))
(#(STARTTAG APPDXS)
,(rdp-repll
`((,(lambda (t f)
`#(STARTTAG
,(token-gi t)
(#(FILE TOKEN ,(head f)) . ,(token-args t))))
FILES)
,identity)
(rdp-call g)))
(#(STARTTAG XREF)
,(rdp-repll
`(,(lambda (t)
(let* ((ma (xat t 'MARK))
(mav (arg-val ma)))
`#(STARTTAG XREF
(,(if
(eq? (arg-type ma) 'PROMISE)
`#(MARK PROMISE
,(delay (get-val ids (force mav))))
`#(MARK TOKEN ,(get-val ids mav)))
. ,(token-args t)))))
,identity)
(rdp-call g)))
(#(STARTTAG INDEX)
,(rdp-repll
`((,(lambda (t f division)
(let* ((mark (xatv t 'MARK))
(cf (head f)))
(idx 'bind `(,cf . ,division) mark)
;`#(STARTTAG INDEX
; (#(FILE TOKEN ,cf)
; #(DIVISION TOKEN ,division)
; . ,(token-args t)))
t
))
FILES DIVISION)
,identity)
(rdp-call g)))
(#(STARTTAG (SECT SECT1 SECT2 SECTN
APPDX APPDX1 APPDX2 APPDXN PART))
,(rdp-let-fetch
`((DIVISION ,gt-no ,xcadr))
(rdp-repll
`((,(lambda (t f)
(let ((ma (xatv t 'NO))
(cf (head f)))
(ids 'bind cf ma)
`#(STARTTAG
,(token-gi t)
(#(FILE TOKEN ,cf) . ,(token-args t)))))
FILES)
,identity)
(rdp-call g))))
(#(STARTTAG FIGURE)
,(rdp-repll
`((,(lambda (t f)
(let ((ma (xatv t 'NO))
(cf (head f)))
(ids 'bind cf ma)
`#(STARTTAG
,(token-gi t)
(#(FILE TOKEN ,cf) . ,(token-args t)))))
FILES)
,identity)
(rdp-call g)))
(#(PLACE INDEX)
,(rdp-map
(lambda (i)
(stream `#(PLACE INDEX (,(token-args (head i))
,idx))))
pass-token-action))
(#(INDEXDB)
,(rdp-map
(lambda (i)
(stream `#(INDEXDB (,(data-token-data (head i))
,idx))))
pass-token-action))
(#() ,pass-token-action))))
(no-filenames (lambda () (cons-stream "" (no-filenames)))))
(rdp-parse
(rdp-cond
`((#(STARTTAG BOOK)
,(rdp-let `((FILES ,(lambda i files) ,identity))
(rdpp-keep g)))
(#(STARTTAG)
,(rdpp-keep g))))
s
`(FILES ,(no-filenames))
`(DIVISION "")
)))))
|
