68c4557968
Also, adjust help text for `--doc-binding` to make it fit in 80 columns, and clean up related documentation text.
192 lines
8.5 KiB
Racket
192 lines
8.5 KiB
Racket
#lang racket/base
|
|
(require "xref.rkt"
|
|
"render.rkt"
|
|
scheme/cmdline
|
|
raco/command-name
|
|
(prefix-in text: "text-render.rkt")
|
|
(prefix-in markdown: "markdown-render.rkt")
|
|
(prefix-in html: "html-render.rkt")
|
|
(prefix-in latex: "latex-render.rkt")
|
|
(prefix-in pdf: "pdf-render.rkt"))
|
|
|
|
(module test racket/base)
|
|
|
|
(define multi-html:render-mixin
|
|
(lambda (%) (html:render-multi-mixin (html:render-mixin %))))
|
|
|
|
(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)
|
|
(define doc-binding 'doc)
|
|
(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)]
|
|
[("--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)]
|
|
[("--xelatex") "generate PDF-format output (via XeLaTeX)"
|
|
(current-html #f)
|
|
(current-render-mixin pdf:xelatex-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)]
|
|
[("--doc-binding") id
|
|
"render document provided as <id> instead of `doc`"
|
|
(set! doc-binding (string->symbol id))]
|
|
#: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-binding) #t)
|
|
(dynamic-require `(submod (file ,file) ,doc-binding)
|
|
doc-binding)
|
|
(dynamic-require `(file ,file) doc-binding)))
|
|
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)
|