suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

* run.ss is used for he scribble command-line tool

Browse Source 
* scribble.ss is gone (ot was doing the running, which run.ss defined)
* converted run.ss to scheme/base
* added private/indirect-renderer which can be used to build renderers
  that are based on conversion from the result of an existing
  renderer, obviously useful with the latex renderer
* added pdf-render using this and private/run-pdflatex
* added a --pdf option to run.ss

svn: r13946

original commit: d952b144c2b47f64b675ace0f25877f5a4e5c3f5
This commit is contained in:
Eli Barzilay 2009-03-04 16:35:41 +00:00
parent bd2dd5c43a
commit 7f0900073b
4 changed files with 171 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scribble/info.ss
View File

@ -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"))

10
collects/scribble/pdf-render.ss Normal file
View File

@ -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))

40
collects/scribble/private/indirect-renderer.ss Normal file
View File

@ -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)))

269
collects/scribble/run.ss
View File

@ -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 <dir>"
(current-dest-directory dir)]
[("--dest-name") name "write output as <name>"
(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 <url>"
(current-redirect url)]
[("--redirect-main") url "redirect main doc links to <url>"
(current-redirect-main 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)
(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 <dir>"
(current-dest-directory dir)]
[("--dest-name") name "write output as <name>"
(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 <url>"
(current-redirect url)]
[("--redirect-main") url "redirect main doc links to <url>"
(current-redirect-main 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 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)