146 lines
5.7 KiB
Scheme
146 lines
5.7 KiB
Scheme
|
|
(module run mzscheme
|
|
(require "struct.ss"
|
|
"base-render.ss"
|
|
"xref.ss"
|
|
mzlib/cmdline
|
|
mzlib/class
|
|
mzlib/file
|
|
(prefix text: "text-render.ss")
|
|
(prefix html: "html-render.ss")
|
|
(prefix latex: "latex-render.ss"))
|
|
|
|
(provide (all-defined)
|
|
html:render-mixin
|
|
latex:render-mixin
|
|
text:render-mixin)
|
|
|
|
(define multi-html:render-mixin
|
|
(lambda (%)
|
|
(html:render-multi-mixin
|
|
(html:render-mixin %))))
|
|
|
|
(define current-render-mixin
|
|
(make-parameter text:render-mixin))
|
|
(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-style-file
|
|
(make-parameter #f))
|
|
(define current-style-extra-files
|
|
(make-parameter null))
|
|
(define current-redirect
|
|
(make-parameter #f))
|
|
|
|
(define (read-one str)
|
|
(let ([i (open-input-string str)])
|
|
(with-handlers ([exn:fail:read? (lambda (x) #f)])
|
|
(let ([v (read i)])
|
|
(if (eof-object? (read i))
|
|
v
|
|
#f)))))
|
|
|
|
(define (get-command-line-files argv)
|
|
(command-line
|
|
"scribble"
|
|
argv
|
|
[once-any
|
|
[("--text") "generate text-format output (the default)"
|
|
(void)]
|
|
[("--html") "generate HTML-format output file"
|
|
(current-render-mixin html:render-mixin)]
|
|
[("--htmls") "generate HTML-format output directory"
|
|
(current-render-mixin multi-html:render-mixin)]
|
|
[("--latex") "generate LaTeX-format output"
|
|
(current-render-mixin latex: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)]
|
|
[("--style") file "use given base .css/.tex file"
|
|
(current-style-file file)]
|
|
[("--redirect") url "redirect external tag links to <url>"
|
|
(current-redirect url)]
|
|
[("--info-out") file "write format-specific link information to <file>"
|
|
(current-info-output-file file)]]
|
|
[multi
|
|
[("++info-in") file "load format-specific link information from <file>"
|
|
(current-info-input-files
|
|
(cons file (current-info-input-files)))]
|
|
[("++xref-in") module-path proc-id "load format-specific link information 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))))]
|
|
[("++style") file "add given .css/.tex file"
|
|
(current-style-extra-files (cons file (current-style-extra-files)))]]
|
|
[args (file . another-file) (cons file another-file)]))
|
|
|
|
(define (build-docs-files files)
|
|
(build-docs (map (lambda (file)
|
|
(dynamic-require `(file ,file) 'doc))
|
|
files)
|
|
files))
|
|
|
|
(define (build-docs docs files)
|
|
(let ([dir (current-dest-directory)])
|
|
(when dir
|
|
(make-directory* dir))
|
|
|
|
(let ([renderer (new ((current-render-mixin) render%)
|
|
[dest-dir dir]
|
|
[style-file (current-style-file)]
|
|
[style-extra-files (reverse (current-style-extra-files))])])
|
|
(when (current-redirect)
|
|
(send renderer set-external-tag-path (current-redirect)))
|
|
(send renderer report-output!)
|
|
(let* ([fns (map (lambda (fn)
|
|
(let-values ([(base name dir?) (split-path fn)])
|
|
(let ([fn (path-replace-suffix (or (current-dest-name) name)
|
|
(send renderer get-suffix))])
|
|
(if dir
|
|
(build-path dir fn)
|
|
fn))))
|
|
files)]
|
|
[info (send renderer collect docs fns)])
|
|
(for-each (lambda (file)
|
|
(let ([s (with-input-from-file file read)])
|
|
(send renderer deserialize-info s info)))
|
|
(reverse (current-info-input-files)))
|
|
(for-each (lambda (mod+id)
|
|
(let ([get-xref (dynamic-require (car mod+id) (cdr mod+id))])
|
|
(let ([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))
|
|
(xref-transfer-info renderer info xr))))
|
|
(reverse (current-xref-input-modules)))
|
|
(let ([r-info (send renderer resolve docs fns info)])
|
|
(send renderer render docs fns r-info)
|
|
(when (current-info-output-file)
|
|
(let ([s (send renderer serialize-info r-info)])
|
|
(with-output-to-file (current-info-output-file)
|
|
(lambda ()
|
|
(write s))
|
|
'truncate/replace)))))))))
|