run.rkt (8802B)
1 #lang racket/base 2 (require "xref.rkt" 3 "render.rkt" 4 scheme/cmdline 5 raco/command-name 6 (prefix-in text: "text-render.rkt") 7 (prefix-in markdown: "markdown-render.rkt") 8 (prefix-in html: "html-render.rkt") 9 (prefix-in latex: "latex-render.rkt") 10 (prefix-in pdf: "pdf-render.rkt")) 11 12 (module test racket/base) 13 14 (define multi-html:render-mixin 15 (lambda (%) (html:render-multi-mixin (html:render-mixin %)))) 16 17 (define current-render-mixin (make-parameter html:render-mixin)) 18 (define current-html (make-parameter #t)) 19 (define current-dest-directory (make-parameter #f)) 20 (define current-dest-name (make-parameter #f)) 21 (define current-info-output-file (make-parameter #f)) 22 (define current-info-input-files (make-parameter null)) 23 (define current-xref-input-modules (make-parameter null)) 24 (define current-prefix-file (make-parameter #f)) 25 (define current-style-file (make-parameter #f)) 26 (define current-style-extra-files (make-parameter null)) 27 (define current-extra-files (make-parameter null)) 28 (define current-redirect (make-parameter #f)) 29 (define current-redirect-main (make-parameter #f)) 30 (define current-directory-depth (make-parameter 0)) 31 (define current-quiet (make-parameter #f)) 32 (define helper-file-prefix (make-parameter #f)) 33 (define doc-command-line-arguments (make-parameter null)) 34 (define current-image-prefs (make-parameter null)) ; reverse order 35 36 (define (read-one str) 37 (let ([i (open-input-string str)]) 38 (with-handlers ([exn:fail:read? (lambda (x) #f)]) 39 (let ([v (read i)]) 40 (and (eof-object? (read i)) v))))) 41 42 (define (run) 43 (define doc-binding 'doc) 44 (command-line 45 #:program (short-program+command-name) 46 #:once-any 47 [("--html") "generate HTML-format output file (the default)" 48 (current-html #t) 49 (current-render-mixin html:render-mixin)] 50 [("--htmls") "generate HTML-format output directory" 51 (current-html #t) 52 (current-render-mixin multi-html:render-mixin)] 53 [("--html-tree") n "generate HTML-format output directories <n> deep" 54 (let ([nv (string->number n)]) 55 (unless (exact-nonnegative-integer? nv) 56 (raise-user-error 'scribble 57 "invalid depth: ~a" 58 n)) 59 (current-directory-depth nv) 60 (current-html #t) 61 (current-render-mixin (if (zero? nv) 62 html:render-mixin 63 multi-html:render-mixin)))] 64 [("--latex") "generate LaTeX-format output" 65 (current-html #f) 66 (current-render-mixin latex:render-mixin)] 67 [("--pdf") "generate PDF-format output (via PDFLaTeX)" 68 (current-html #f) 69 (current-render-mixin pdf:render-mixin)] 70 [("--xelatex") "generate PDF-format output (via XeLaTeX)" 71 (current-html #f) 72 (current-render-mixin pdf:xelatex-render-mixin)] 73 [("--dvipdf") "generate PDF-format output (via LaTeX, dvips, and pstopdf)" 74 (current-html #f) 75 (current-render-mixin pdf:dvi-render-mixin)] 76 [("--latex-section") n "generate LaTeX-format output for section depth <n>" 77 (current-html #f) 78 (let ([v (string->number n)]) 79 (unless (exact-nonnegative-integer? v) 80 (raise-user-error 'scribble (format "bad section depth: ~a" n))) 81 (current-render-mixin (latex:make-render-part-mixin v)))] 82 [("--text") "generate text-format output" 83 (current-html #f) 84 (current-render-mixin text:render-mixin)] 85 [("--markdown") "generate markdown-format output" 86 (current-html #f) 87 (current-render-mixin markdown:render-mixin)] 88 #:once-each 89 [("--dest") dir "write output in <dir>" 90 (current-dest-directory dir)] 91 [("--dest-name") name "write output as <name>" 92 (current-dest-name name)] 93 [("--dest-base") prefix "start support-file names with <prefix>" 94 (helper-file-prefix prefix)] 95 #:multi 96 [("++convert") fmt ("prefer image conversion to <fmt> (in given order)" 97 " <fmt> as one of: ps pdf svg png gif") 98 (define sym (string->symbol fmt)) 99 (unless (member sym '(ps pdf svg png gif)) 100 (raise-user-error 'scribble "bad format for ++convert: ~s" fmt)) 101 (current-image-prefs (cons sym (current-image-prefs)))] 102 [("++style") file "add given .css/.tex file after others" 103 (current-style-extra-files (cons file (current-style-extra-files)))] 104 #:once-each 105 [("--style") file "use given base .css/.tex file" 106 (current-style-file file)] 107 [("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)" 108 (current-prefix-file file)] 109 [("--link-section") "support section links for markdown" 110 (markdown:current-markdown-link-sections #t)] 111 #:multi 112 [("++extra") file "add given file" 113 (current-extra-files (cons file (current-extra-files)))] 114 [("--redirect-main") url "redirect main doc links to <url>" 115 (current-redirect-main url)] 116 [("--redirect") url "redirect external links to tag search via <url>" 117 (current-redirect url)] 118 [("+m" "++main-xref-in") ("load format-specific cross-ref info for" 119 "all installed library collections") 120 (current-xref-input-modules 121 (cons (cons 'setup/xref 'load-collections-xref) (current-xref-input-modules)))] 122 [("++xref-in") module-path proc-id ("load format-specific cross-ref info by" 123 "calling <proc-id> as exported by <module-path>") 124 (let ([mod (read-one module-path)] 125 [id (read-one proc-id)]) 126 (unless (module-path? mod) 127 (raise-user-error 128 'scribble "bad module path for ++ref-in: ~s" module-path)) 129 (unless (symbol? id) 130 (raise-user-error 131 'scribble "bad procedure identifier for ++ref-in: ~s" proc-id)) 132 (current-xref-input-modules 133 (cons (cons mod id) (current-xref-input-modules))))] 134 [("--info-out") file "write format-specific cross-ref info to <file>" 135 (current-info-output-file file)] 136 [("++info-in") file "load format-specific cross-ref info from <file>" 137 (current-info-input-files 138 (cons file (current-info-input-files)))] 139 [("++arg") arg "add <arg> to current-command-line-arguments" 140 (doc-command-line-arguments 141 (cons arg (doc-command-line-arguments)))] 142 #:once-each 143 [("--quiet") "suppress output-file and undefined-tag reporting" 144 (current-quiet #t)] 145 [("--doc-binding") id 146 "render document provided as <id> instead of `doc`" 147 (set! doc-binding (string->symbol id))] 148 #:args (file . another-file) 149 (let ([files (cons file another-file)]) 150 (parameterize ([current-command-line-arguments 151 (list->vector (reverse (doc-command-line-arguments)))]) 152 (build-docs (map (lambda (file) 153 ;; Try `doc' submodule, first: 154 (if (module-declared? `(submod (file ,file) ,doc-binding) #t) 155 (dynamic-require `(submod (file ,file) ,doc-binding) 156 doc-binding) 157 (dynamic-require `(file ,file) doc-binding))) 158 files) 159 files))))) 160 161 (define (build-docs docs files) 162 (when (and (current-dest-name) 163 ((length files) . > . 1)) 164 (raise-user-error 'scribble "cannot supply a destination name with multiple inputs")) 165 (render docs 166 (map (lambda (fn) 167 (let-values ([(base name dir?) (split-path fn)]) 168 (or (current-dest-name) name))) 169 files) 170 #:dest-dir (current-dest-directory) 171 #:render-mixin (current-render-mixin) 172 #:image-preferences (reverse (current-image-prefs)) 173 #:prefix-file (current-prefix-file) 174 #:style-file (current-style-file) 175 #:style-extra-files (reverse (current-style-extra-files)) 176 #:extra-files (reverse (current-extra-files)) 177 #:helper-file-prefix (helper-file-prefix) 178 #:redirect (and (current-html) (current-redirect)) 179 #:redirect-main (and (current-html) (current-redirect-main)) 180 #:directory-depth (current-directory-depth) 181 #:quiet? (current-quiet) 182 #:info-in-files (reverse (current-info-input-files)) 183 #:xrefs (for/list ([mod+id (in-list (reverse (current-xref-input-modules)))]) 184 (let* ([get-xref (dynamic-require (car mod+id) (cdr mod+id))] 185 [xr (get-xref)]) 186 (unless (xref? xr) 187 (raise-user-error 188 'scribble "result from `~s' of `~s' is not an xref: ~e" 189 (cdr mod+id) (car mod+id) xr)) 190 xr)) 191 #:info-out-file (current-info-output-file))) 192 193 (run)