diff --git a/collects/scribble/info.ss b/collects/scribble/info.ss index 88f25d81..a135983a 100644 --- a/collects/scribble/info.ss +++ b/collects/scribble/info.ss @@ -1,5 +1,5 @@ #lang setup/infotab (define mzscheme-launcher-names '("scribble")) -(define mzscheme-launcher-libraries '("scribble.ss")) +(define mzscheme-launcher-libraries '("run.ss")) (define compile-omit-paths '("test-reader.ss")) diff --git a/collects/scribble/pdf-render.ss b/collects/scribble/pdf-render.ss new file mode 100644 index 00000000..e83e6be8 --- /dev/null +++ b/collects/scribble/pdf-render.ss @@ -0,0 +1,10 @@ +#lang scheme/base + +(require "private/indirect-renderer.ss" "private/run-pdflatex.ss" + (prefix-in latex: "latex-render.ss")) + +(provide render-mixin) + +(define render-mixin + (make-indirect-renderer-mixin + latex:render-mixin #".tex" #".pdf" run-pdflatex)) diff --git a/collects/scribble/private/indirect-renderer.ss b/collects/scribble/private/indirect-renderer.ss new file mode 100644 index 00000000..5a1de536 --- /dev/null +++ b/collects/scribble/private/indirect-renderer.ss @@ -0,0 +1,40 @@ +#lang scheme/base + +(require scheme/class scheme/file scheme/path) + +(provide make-indirect-renderer-mixin) + +(define (dotless bytes) (regexp-replace #rx#"[.]" bytes #"")) + +(define ((make-indirect-renderer-mixin + base-renderer base-suffix target-suffix convert) + %renderer) + (class (base-renderer %renderer) + (define tmp-dest-dir #f) + (define/override (get-dest-directory create?) + (or tmp-dest-dir (super get-dest-directory create?))) + (define/override (get-suffix) target-suffix) + (define/override (render srcs dests ri) + (define tmp-dir + (make-temporary-file + (format "scribble-~a-to-~a-~~a" + (dotless base-suffix) (dotless target-suffix)) + 'directory)) + (define (cleanup) + (when (directory-exists? tmp-dir) (delete-directory/files tmp-dir))) + (with-handlers ([void (lambda (e) (cleanup) (raise e))]) + (define tmp-dests + (map (lambda (dest) + (build-path tmp-dir + (path-replace-suffix (file-name-from-path dest) + base-suffix))) + dests)) + (set! tmp-dest-dir tmp-dir) + ;; it would be better if it's ok to change current-directory for this + (super render srcs tmp-dests ri) + (for ([tmp tmp-dests] [dst dests]) + (parameterize ([current-directory tmp-dir]) + (convert (file-name-from-path tmp))) + (copy-file (build-path tmp-dir(file-name-from-path dst)) dst)) + (cleanup))) + (super-new))) diff --git a/collects/scribble/run.ss b/collects/scribble/run.ss index 12650f8c..b32c9fc7 100644 --- a/collects/scribble/run.ss +++ b/collects/scribble/run.ss @@ -1,156 +1,127 @@ +#lang scheme/base -(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")) +(require "struct.ss" + "base-render.ss" + "xref.ss" + scheme/cmdline + scheme/file + scheme/class + (prefix-in text: "text-render.ss") + (prefix-in html: "html-render.ss") + (prefix-in latex: "latex-render.ss") + (prefix-in pdf: "pdf-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 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-prefix-file (make-parameter #f)) +(define current-style-file (make-parameter #f)) +(define current-style-extra-files (make-parameter null)) +(define current-redirect (make-parameter #f)) +(define current-redirect-main (make-parameter #f)) - (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-prefix-file - (make-parameter #f)) - (define current-style-file - (make-parameter #f)) - (define current-style-extra-files - (make-parameter null)) - (define current-redirect - (make-parameter #f)) - (define current-redirect-main - (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)]) + (and (eof-object? (read i)) v))))) - (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 (run) + (command-line + #: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)] + [("--pdf") "generate PDF-format output (with PDFLaTeX)" + (current-render-mixin pdf:render-mixin)] + #:once-each + [("--dest") dir "write output in " + (current-dest-directory dir)] + [("--dest-name") name "write output as " + (current-dest-name name)] + [("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)" + (current-prefix-file file)] + [("--style") file "use given base .css/.tex file" + (current-style-file file)] + [("--redirect") url "redirect external links to tag search via " + (current-redirect url)] + [("--redirect-main") url "redirect main doc links to " + (current-redirect-main url)] + [("--info-out") file "write format-specific link information to " + (current-info-output-file file)] + #:multi + [("++info-in") file "load format-specific link information from " + (current-info-input-files + (cons file (current-info-input-files)))] + [("++xref-in") module-path proc-id "load format-specific link information by" + "calling as exported by " + (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) + (let ([files (cons file another-file)]) + (build-docs (map (lambda (file) (dynamic-require `(file ,file) 'doc)) + files) + files)))) - (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 " - (current-dest-directory dir)] - [("--dest-name") name "write output as " - (current-dest-name name)] - [("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)" - (current-prefix-file file)] - [("--style") file "use given base .css/.tex file" - (current-style-file file)] - [("--redirect") url "redirect external links to tag search via " - (current-redirect url)] - [("--redirect-main") url "redirect main doc links to " - (current-redirect-main url)] - [("--info-out") file "write format-specific link information to " - (current-info-output-file file)]] - [multi - [("++info-in") file "load format-specific link information from " - (current-info-input-files - (cons file (current-info-input-files)))] - [("++xref-in") module-path proc-id "load format-specific link information by" - "calling as exported by " - (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 docs files) + (define dir (current-dest-directory)) + (when dir (make-directory* dir)) + (let ([renderer (new ((current-render-mixin) render%) + [dest-dir dir] + [prefix-file (current-prefix-file)] + [style-file (current-style-file)] + [style-extra-files (reverse (current-style-extra-files))])]) + (when (current-redirect) + (send renderer set-external-tag-path (current-redirect))) + (when (current-redirect-main) + (send renderer set-external-root-url (current-redirect-main))) + (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 ([file (in-list (reverse (current-info-input-files)))]) + (let ([s (with-input-from-file file read)]) + (send renderer deserialize-info s info))) + (for ([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)) + (xref-transfer-info renderer info xr))) + (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))))))) - (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] - [prefix-file (current-prefix-file)] - [style-file (current-style-file)] - [style-extra-files (reverse (current-style-extra-files))])]) - (when (current-redirect) - (send renderer set-external-tag-path (current-redirect))) - (when (current-redirect-main) - (send renderer set-external-root-url (current-redirect-main))) - (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))))))))) +(run)