-
Notifications
You must be signed in to change notification settings - Fork 18
/
Copy pathrun.rkt
201 lines (191 loc) · 8.71 KB
/
run.rkt
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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
#lang racket
;; adapted from
;; https://github.com/racket/scribble/blob/master/scribble-lib/scribble/run.rkt
;; and https://stackoverflow.com/a/37822868/718349
;; all code additions are annotated with ADDED ... END ADDED
(require scribble/xref
scribble/render
scheme/cmdline
raco/command-name
(prefix-in text: scribble/text-render)
(prefix-in markdown: scribble/markdown-render)
(prefix-in html: scribble/html-render)
(prefix-in latex: scribble/latex-render)
(prefix-in pdf: scribble/pdf-render))
(module test racket/base)
(define multi-html:render-mixin
(lambda (%) (html:render-multi-mixin (html:render-mixin %))))
;; ADDED
(define (multi-html-search:render-mixin %)
(class (multi-html:render-mixin %)
(init [search-box? #t])
(super-new [search-box? search-box?])))
;; END ADDED
(define current-render-mixin (make-parameter html:render-mixin))
(define current-html (make-parameter #t))
(define current-dest-directory (make-parameter #f))
(define current-dest-name (make-parameter #f))
(define current-info-output-file (make-parameter #f))
(define current-info-input-files (make-parameter null))
(define current-xref-input-modules (make-parameter null))
(define current-prefix-file (make-parameter #f))
(define current-style-file (make-parameter #f))
(define current-style-extra-files (make-parameter null))
(define current-extra-files (make-parameter null))
(define current-redirect (make-parameter #f))
(define current-redirect-main (make-parameter #f))
(define current-directory-depth (make-parameter 0))
(define current-quiet (make-parameter #f))
(define helper-file-prefix (make-parameter #f))
(define doc-command-line-arguments (make-parameter null))
(define current-image-prefs (make-parameter null)) ; reverse order
(define (read-one str)
(let ([i (open-input-string str)])
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)])
(and (eof-object? (read i)) v)))))
(define (run)
(command-line
#:program (short-program+command-name)
#:once-any
[("--html") "generate HTML-format output file (the default)"
(current-html #t)
(current-render-mixin html:render-mixin)]
[("--htmls") "generate HTML-format output directory"
(current-html #t)
(current-render-mixin multi-html:render-mixin)]
;; ADDED
[("--htmls-search") "generate HTML-format output directory with a search box"
(current-html #t)
(current-render-mixin multi-html-search:render-mixin)]
;; END ADDED
[("--html-tree") n "generate HTML-format output directories <n> deep"
(let ([nv (string->number n)])
(unless (exact-nonnegative-integer? nv)
(raise-user-error 'scribble
"invalid depth: ~a"
n))
(current-directory-depth nv)
(current-html #t)
(current-render-mixin (if (zero? nv)
html:render-mixin
multi-html:render-mixin)))]
[("--latex") "generate LaTeX-format output"
(current-html #f)
(current-render-mixin latex:render-mixin)]
[("--pdf") "generate PDF-format output (via PDFLaTeX)"
(current-html #f)
(current-render-mixin pdf:render-mixin)]
[("--dvipdf") "generate PDF-format output (via LaTeX, dvips, and pstopdf)"
(current-html #f)
(current-render-mixin pdf:dvi-render-mixin)]
[("--latex-section") n "generate LaTeX-format output for section depth <n>"
(current-html #f)
(let ([v (string->number n)])
(unless (exact-nonnegative-integer? v)
(raise-user-error 'scribble (format "bad section depth: ~a" n)))
(current-render-mixin (latex:make-render-part-mixin v)))]
[("--text") "generate text-format output"
(current-html #f)
(current-render-mixin text:render-mixin)]
[("--markdown") "generate markdown-format output"
(current-html #f)
(current-render-mixin markdown:render-mixin)]
#:once-each
[("--dest") dir "write output in <dir>"
(current-dest-directory dir)]
[("--dest-name") name "write output as <name>"
(current-dest-name name)]
[("--dest-base") prefix "start support-file names with <prefix>"
(helper-file-prefix prefix)]
#:multi
[("++convert") fmt ("prefer image conversion to <fmt> (in given order)"
" <fmt> as one of: ps pdf svg png gif")
(define sym (string->symbol fmt))
(unless (member sym '(ps pdf svg png gif))
(raise-user-error 'scribble "bad format for ++convert: ~s" fmt))
(current-image-prefs (cons sym (current-image-prefs)))]
[("++style") file "add given .css/.tex file after others"
(current-style-extra-files (cons file (current-style-extra-files)))]
#:once-each
[("--style") file "use given base .css/.tex file"
(current-style-file file)]
[("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)"
(current-prefix-file file)]
#:multi
[("++extra") file "add given file"
(current-extra-files (cons file (current-extra-files)))]
[("--redirect-main") url "redirect main doc links to <url>"
(current-redirect-main url)]
[("--redirect") url "redirect external links to tag search via <url>"
(current-redirect url)]
[("+m" "++main-xref-in") ("load format-specific cross-ref info for"
"all installed library collections")
(current-xref-input-modules
(cons (cons 'setup/xref 'load-collections-xref) (current-xref-input-modules)))]
[("++xref-in") module-path proc-id ("load format-specific cross-ref info by"
"calling <proc-id> as exported by <module-path>")
(let ([mod (read-one module-path)]
[id (read-one proc-id)])
(unless (module-path? mod)
(raise-user-error
'scribble "bad module path for ++ref-in: ~s" module-path))
(unless (symbol? id)
(raise-user-error
'scribble "bad procedure identifier for ++ref-in: ~s" proc-id))
(current-xref-input-modules
(cons (cons mod id) (current-xref-input-modules))))]
[("--info-out") file "write format-specific cross-ref info to <file>"
(current-info-output-file file)]
[("++info-in") file "load format-specific cross-ref info from <file>"
(current-info-input-files
(cons file (current-info-input-files)))]
[("++arg") arg "add <arg> to current-command-line-arguments"
(doc-command-line-arguments
(cons arg (doc-command-line-arguments)))]
#:once-each
[("--quiet") "suppress output-file and undefined-tag reporting"
(current-quiet #t)]
#:args (file . another-file)
(let ([files (cons file another-file)])
(parameterize ([current-command-line-arguments
(list->vector (reverse (doc-command-line-arguments)))])
(build-docs (map (lambda (file)
;; Try `doc' submodule, first:
(if (module-declared? `(submod (file ,file) doc) #t)
(dynamic-require `(submod (file ,file) doc) 'doc)
(dynamic-require `(file ,file) 'doc)))
files)
files)))))
(define (build-docs docs files)
(when (and (current-dest-name)
((length files) . > . 1))
(raise-user-error 'scribble "cannot supply a destination name with multiple inputs"))
(render docs
(map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])
(or (current-dest-name) name)))
files)
#:dest-dir (current-dest-directory)
#:render-mixin (current-render-mixin)
#:image-preferences (reverse (current-image-prefs))
#:prefix-file (current-prefix-file)
#:style-file (current-style-file)
#:style-extra-files (reverse (current-style-extra-files))
#:extra-files (reverse (current-extra-files))
#:helper-file-prefix (helper-file-prefix)
#:redirect (and (current-html) (current-redirect))
#:redirect-main (and (current-html) (current-redirect-main))
#:directory-depth (current-directory-depth)
#:quiet? (current-quiet)
#:info-in-files (reverse (current-info-input-files))
#:xrefs (for/list ([mod+id (in-list (reverse (current-xref-input-modules)))])
(let* ([get-xref (dynamic-require (car mod+id) (cdr mod+id))]
[xr (get-xref)])
(unless (xref? xr)
(raise-user-error
'scribble "result from `~s' of `~s' is not an xref: ~e"
(cdr mod+id) (car mod+id) xr))
xr))
#:info-out-file (current-info-output-file)))
(run)