more scribble configurability and latex back-end improvements

svn: r9120

original commit: f5268bed2a0bb1a4d548bb1f073432047455ced8
This commit is contained in:
Matthew Flatt 2008-03-31 15:27:12 +00:00
parent f6600f1320
commit ab02db1252
6 changed files with 76 additions and 60 deletions

View File

@ -189,7 +189,8 @@
quiet-table-of-contents) quiet-table-of-contents)
(init-field [css-path #f] (init-field [css-path #f]
[up-path #f]) [up-path #f]
[style-file #f])
(define/override (get-suffix) #".html") (define/override (get-suffix) #".html")
@ -449,37 +450,41 @@
(define/public (render-one-part d ri fn number) (define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn]) (parameterize ([current-output-file fn])
(let ([xpr `(html () (let* ([style-file (or style-file scribble-css)]
(head [xpr `(html ()
(meta ((http-equiv "content-type") (head
(content "text-html; charset=utf-8"))) (meta ((http-equiv "content-type")
,@(let ([c (part-title-content d)]) (content "text-html; charset=utf-8")))
(if c ,@(let ([c (part-title-content d)])
`((title ,@(format-number number '(nbsp)) (if c
,(content->string c this d ri))) `((title ,@(format-number number '(nbsp))
null)) ,(content->string c this d ri)))
,(if (eq? 'inline css-path) null))
`(style ([type "text/css"]) ,(if (eq? 'inline css-path)
"\n" `(style ([type "text/css"])
,(with-input-from-file scribble-css "\n"
(lambda () ,(with-input-from-file style-file
;; note: file-size can be bigger that the (lambda ()
;; string, but that's fine. ;; note: file-size can be bigger that the
(read-string (file-size scribble-css)))) ;; string, but that's fine.
"\n") (read-string (file-size style-file))))
`(link ((rel "stylesheet") "\n")
(type "text/css") `(link ((rel "stylesheet")
(href ,(or css-path "scribble.css")) (type "text/css")
(title "default"))))) (href ,(or css-path
(body ,@(render-toc-view d ri) (let-values ([(base name dir?)
(div ((class "maincolumn")) (split-path style-file)])
(div ((class "main")) (path->string name))))
,@(render-version d ri) (title "default")))))
,@(navigation d ri #f) (body ,@(render-toc-view d ri)
,@(render-part d ri) (div ((class "maincolumn"))
,@(navigation d ri #t)))))]) (div ((class "main"))
,@(render-version d ri)
,@(navigation d ri #f)
,@(render-part d ri)
,@(navigation d ri #t)))))])
(unless css-path (unless css-path
(install-file scribble-css)) (install-file style-file))
(printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n") (printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n")
(xml:write-xml/content (xml:xexpr->xml xpr))))) (xml:write-xml/content (xml:xexpr->xml xpr)))))

View File

@ -17,6 +17,8 @@
(define (render-mixin %) (define (render-mixin %)
(class % (class %
(init-field [style-file #f])
(define/override (get-suffix) #".tex") (define/override (get-suffix) #".tex")
(inherit render-flow (inherit render-flow
@ -26,20 +28,22 @@
format-number) format-number)
(define/override (render-one d ri fn) (define/override (render-one d ri fn)
(with-input-from-file scribble-tex (let ([style-file (or style-file
(lambda () scribble-tex)])
(copy-port (current-input-port) (with-input-from-file style-file
(current-output-port)))) (lambda ()
(printf "\\begin{document}\n\\preDoc\n") (copy-port (current-input-port)
(when (part-title-content d) (current-output-port))))
(printf "\\titleAndVersion{") (printf "\\begin{document}\n\\preDoc\n")
(render-content (part-title-content d) d ri) (when (part-title-content d)
(printf "}{~a}\n" (printf "\\titleAndVersion{")
(or (and (versioned-part? d) (render-content (part-title-content d) d ri)
(versioned-part-version d)) (printf "}{~a}\n"
(version)))) (or (and (versioned-part? d)
(render-part d ri) (versioned-part-version d))
(printf "\\postDoc\n\\end{document}\n")) (version))))
(render-part d ri)
(printf "\\postDoc\n\\end{document}\n")))
(define/override (render-part d ri) (define/override (render-part d ri)
(let ([number (collected-info-number (part-collected-info d ri))]) (let ([number (collected-info-number (part-collected-info d ri))])
@ -49,7 +53,7 @@
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n")) (printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
(printf "\\~a~a{" (printf "\\~a~a{"
(case (length number) (case (length number)
[(0 1) "newpage\n\n\\section"] [(0 1) "sectionNewpage\n\n\\section"]
[(2) "subsection"] [(2) "subsection"]
[(3) "subsubsection"] [(3) "subsubsection"]
[else "subsubsection*"]) [else "subsubsection*"])
@ -186,16 +190,16 @@
(= 1 (length (car (table-flowss t))))) (= 1 (length (car (table-flowss t)))))
(let ([m (current-table-mode)]) (let ([m (current-table-mode)])
(and m (and m
(equal? "longtable" (car m)) (equal? "supertabular" (car m))
(= 1 (length (car (table-flowss (cadr m))))))))] (= 1 (length (car (table-flowss (cadr m))))))))]
[tableform (cond [tableform (cond
[index? "list"] [index? "list"]
[(and (not (current-table-mode)) [(and (not (current-table-mode))
(not inline-table?)) (not inline-table?))
"longtable"] "supertabular"]
[else "tabular"])] [else "tabular"])]
[opt (cond [opt (cond
[(equal? tableform "longtable") "[l]"] [(equal? tableform "supertabular") "[l]"]
[(equal? tableform "tabular") "[t]"] [(equal? tableform "tabular") "[t]"]
[else ""])] [else ""])]
[flowss (if index? [flowss (if index?
@ -216,9 +220,7 @@
(if boxed? (if boxed?
(format "{~a\\begin{picture}(1,0)\\put(0,0){\\line(1,0){1}}\\end{picture}}~a\n\\nopagebreak\n" (format "{~a\\begin{picture}(1,0)\\put(0,0){\\line(1,0){1}}\\end{picture}}~a\n\\nopagebreak\n"
"\\setlength{\\unitlength}{\\linewidth}" "\\setlength{\\unitlength}{\\linewidth}"
(if (equal? tableform "longtable") "\n\n")
"\\vspace{-5ex}"
"\n\n"))
"") "")
tableform tableform
opt opt
@ -266,11 +268,11 @@
(unless (null? (cdr flowss)) (unless (null? (cdr flowss))
(loop (cdr flowss) (cdr row-styles))))) (loop (cdr flowss) (cdr row-styles)))))
(unless inline? (unless inline?
(printf "\n\n\\end{~a}~a\n" (printf "~a\n\n\\end{~a}\n"
tableform (if (equal? tableform "supertabular")
(if (equal? tableform "longtable") "\n\\\\"
"\\vspace{-3ex}" ;; counteracts mysterious space added after longtable "")
"")))))) tableform)))))
null) null)
(define/override (render-itemization t part ri) (define/override (render-itemization t part ri)

View File

@ -1880,7 +1880,7 @@
(make-link-element #f (make-link-element #f
content content
(or (find-scheme-tag p ri stx-id #f) (or (find-scheme-tag p ri stx-id #f)
(format "--UNDEFINED:~a--" (syntax-e stx-id)))))) `(undef ,(format "--UNDEFINED:~a--" (syntax-e stx-id)))))))
(lambda () content) (lambda () content)
(lambda () content)))) (lambda () content))))

View File

@ -29,6 +29,8 @@
(make-parameter #f)) (make-parameter #f))
(define current-info-input-files (define current-info-input-files
(make-parameter null)) (make-parameter null))
(define current-style-file
(make-parameter #f))
(define (get-command-line-files argv) (define (get-command-line-files argv)
(command-line (command-line
@ -48,6 +50,8 @@
(current-dest-directory dir)] (current-dest-directory dir)]
[("--dest-name") name "write output as <name>" [("--dest-name") name "write output as <name>"
(current-dest-name name)] (current-dest-name name)]
[("--style") file "use given .css/.tex file"
(current-style-file file)]
[("--info-out") file "write format-specific link information to <file>" [("--info-out") file "write format-specific link information to <file>"
(current-info-output-file file)]] (current-info-output-file file)]]
[multi [multi
@ -68,7 +72,8 @@
(make-directory* dir)) (make-directory* dir))
(let ([renderer (new ((current-render-mixin) render%) (let ([renderer (new ((current-render-mixin) render%)
[dest-dir dir])]) [dest-dir dir]
[style-file (current-style-file)])])
(send renderer report-output!) (send renderer report-output!)
(let* ([fns (map (lambda (fn) (let* ([fns (map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)]) (let-values ([(base name dir?) (split-path fn)])

View File

@ -14,7 +14,7 @@
\usepackage{graphicx} \usepackage{graphicx}
\usepackage{hyperref} \usepackage{hyperref}
\renewcommand{\rmdefault}{ptm} \renewcommand{\rmdefault}{ptm}
\usepackage{longtable} \usepackage{supertabular}
\usepackage[htt]{hyphenat} \usepackage[htt]{hyphenat}
\usepackage[usenames,dvipsnames]{color} \usepackage[usenames,dvipsnames]{color}
\hypersetup{bookmarks=true,bookmarksopen=true,bookmarksnumbered=true} \hypersetup{bookmarks=true,bookmarksopen=true,bookmarksnumbered=true}
@ -69,6 +69,8 @@
\newcommand{\titleAndVersion}[2]{\title{#1\\{\normalsize Version #2}}\maketitle} \newcommand{\titleAndVersion}[2]{\title{#1\\{\normalsize Version #2}}\maketitle}
\newcommand{\sectionNewpage}{\newpage}
\newcommand{\preDoc}{\sloppy} \newcommand{\preDoc}{\sloppy}
\newcommand{\postDoc}{} \newcommand{\postDoc}{}

View File

@ -6,6 +6,8 @@
(define (render-mixin %) (define (render-mixin %)
(class % (class %
(init [style-file #f])
(define/override (get-substitutions) (define/override (get-substitutions)
'((#rx"---" "\U2014") '((#rx"---" "\U2014")
(#rx"--" "\U2013") (#rx"--" "\U2013")