373 lines
16 KiB
Scheme
373 lines
16 KiB
Scheme
|
|
(module latex-render scheme/base
|
|
(require "struct.ss"
|
|
mzlib/class
|
|
scheme/runtime-path
|
|
scheme/port
|
|
(for-syntax scheme/base))
|
|
(provide render-mixin)
|
|
|
|
(define current-table-mode (make-parameter #f))
|
|
(define rendering-tt (make-parameter #f))
|
|
(define show-link-page-numbers (make-parameter #f))
|
|
|
|
(define-struct (toc-paragraph paragraph) ())
|
|
|
|
(define-runtime-path scribble-tex "scribble.tex")
|
|
|
|
(define (render-mixin %)
|
|
(class %
|
|
(init-field [style-file #f])
|
|
|
|
(define/override (get-suffix) #".tex")
|
|
|
|
(inherit render-flow
|
|
render-flow-element
|
|
render-content
|
|
install-file
|
|
format-number)
|
|
|
|
(define/override (render-one d ri fn)
|
|
(let ([style-file (or style-file
|
|
scribble-tex)])
|
|
(with-input-from-file style-file
|
|
(lambda ()
|
|
(copy-port (current-input-port)
|
|
(current-output-port))))
|
|
(printf "\\begin{document}\n\\preDoc\n")
|
|
(when (part-title-content d)
|
|
(printf "\\titleAndVersion{")
|
|
(render-content (part-title-content d) d ri)
|
|
(printf "}{~a}\n"
|
|
(or (and (versioned-part? d)
|
|
(versioned-part-version d))
|
|
(version))))
|
|
(render-part d ri)
|
|
(printf "\\postDoc\n\\end{document}\n")))
|
|
|
|
(define/override (render-part d ri)
|
|
(let ([number (collected-info-number (part-collected-info d ri))])
|
|
(when (and (part-title-content d)
|
|
(pair? number))
|
|
(when (part-style? d 'index)
|
|
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
|
|
(printf "\\~a~a~a{"
|
|
(case (length number)
|
|
[(0 1) "sectionNewpage\n\n\\section"]
|
|
[(2) "subsection"]
|
|
[(3) "subsubsection"]
|
|
[else "subsubsection*"])
|
|
(if (part-style? d 'hidden)
|
|
"hidden"
|
|
"")
|
|
(if (and (pair? number)
|
|
(not (car number)))
|
|
"*"
|
|
""))
|
|
(render-content (part-title-content d) d ri)
|
|
(printf "}")
|
|
(when (part-style? d 'index)
|
|
(printf "\n\n")))
|
|
(for-each (lambda (t)
|
|
(printf "\\label{t:~a}" (t-encode (tag-key t ri))))
|
|
(part-tags d))
|
|
(render-flow (part-flow d) d ri #f)
|
|
(for-each (lambda (sec) (render-part sec ri))
|
|
(part-parts d))
|
|
null))
|
|
|
|
(define/override (render-paragraph p part ri)
|
|
(printf "\n\n")
|
|
(let ([margin? (and (styled-paragraph? p)
|
|
(equal? "refpara" (styled-paragraph-style p)))])
|
|
(when margin?
|
|
(printf "\\marginpar{\\footnotesize "))
|
|
(if (toc-paragraph? p)
|
|
(printf "\\newpage \\tableofcontents \\newpage")
|
|
(super render-paragraph p part ri))
|
|
(when margin?
|
|
(printf "}")))
|
|
(printf "\n\n")
|
|
null)
|
|
|
|
(define/override (render-element e part ri)
|
|
(let ([part-label? (and (link-element? e)
|
|
(pair? (link-element-tag e))
|
|
(eq? 'part (car (link-element-tag e)))
|
|
(null? (element-content e)))])
|
|
(parameterize ([show-link-page-numbers #f])
|
|
(when (target-element? e)
|
|
(printf "\\label{t:~a}" (t-encode (tag-key (target-element-tag e) ri))))
|
|
(when part-label?
|
|
(printf "\\S")
|
|
(render-content (let ([dest (resolve-get part ri (link-element-tag e))])
|
|
(if dest
|
|
(if (list? (cadr dest))
|
|
(format-number (cadr dest) null)
|
|
(begin
|
|
(fprintf (current-error-port)
|
|
"Internal tag error: ~s -> ~s\n"
|
|
(link-element-tag e)
|
|
dest)
|
|
'("!!!")))
|
|
(list "???")))
|
|
part
|
|
ri)
|
|
(printf " ``"))
|
|
(let ([style (and (element? e)
|
|
(element-style e))]
|
|
[wrap (lambda (e s tt?)
|
|
(printf "{\\~a{" s)
|
|
(parameterize ([rendering-tt (or tt?
|
|
(rendering-tt))])
|
|
(super render-element e part ri))
|
|
(printf "}}"))])
|
|
(cond
|
|
[(symbol? style)
|
|
(case style
|
|
[(italic) (wrap e "textit" #f)]
|
|
[(bold) (wrap e "textbf" #f)]
|
|
[(tt) (wrap e "mytexttt" #t)]
|
|
[(no-break) (super render-element e part ri)]
|
|
[(sf) (wrap e "textsf" #f)]
|
|
[(subscript) (wrap e "textsub" #f)]
|
|
[(superscript) (wrap e "textsuper" #f)]
|
|
[(hspace) (let ([s (content->string (element-content e))])
|
|
(case (string-length s)
|
|
[(0) (void)]
|
|
[else
|
|
(printf "{\\mytexttt{~a}}"
|
|
(regexp-replace* #rx"." s "~"))]))]
|
|
[(newline) (printf "\\\\")]
|
|
[else (error 'latex-render "unrecognzied style symbol: ~s" style)])]
|
|
[(string? style)
|
|
(wrap e style (regexp-match? #px"^scheme(?!error)" style))]
|
|
[(and (pair? style)
|
|
(or (eq? (car style) 'bg-color)
|
|
(eq? (car style) 'color)))
|
|
(wrap e (format "~a{~a}"
|
|
(format (if (eq? (car style) 'bg-color)
|
|
"in~acolorbox"
|
|
"intext~acolor")
|
|
(if (= (length style) 2)
|
|
""
|
|
"rgb"))
|
|
(if (= (length style) 2)
|
|
(cadr style)
|
|
(format "~a,~a,~a"
|
|
(/ (cadr style) 255.0)
|
|
(/ (caddr style) 255.0)
|
|
(/ (cadddr style) 255.0))))
|
|
#f)]
|
|
[(image-file? style)
|
|
(let ([fn (install-file (image-file-path style))])
|
|
(printf "\\includegraphics{~a}" fn))]
|
|
[else (super render-element e part ri)])))
|
|
(when part-label?
|
|
(printf "''"))
|
|
(when (and (link-element? e)
|
|
(show-link-page-numbers))
|
|
(printf ", \\pageref{t:~a}" (t-encode (tag-key (link-element-tag e) ri))))
|
|
null))
|
|
|
|
(define/private (t-encode s)
|
|
(apply
|
|
string-append
|
|
(map (lambda (c)
|
|
(cond
|
|
[(and (or (char-alphabetic? c)
|
|
(char-numeric? c))
|
|
((char->integer c) . < . 128))
|
|
(string c)]
|
|
[(char=? c #\space) "_"]
|
|
[else
|
|
(format "x~x" (char->integer c))]))
|
|
(string->list (format "~s" s)))))
|
|
|
|
(define/override (render-table t part ri inline-table?)
|
|
(let* ([boxed? (eq? 'boxed (table-style t))]
|
|
[index? (eq? 'index (table-style t))]
|
|
[inline? (and (not boxed?)
|
|
(not index?)
|
|
(or (null? (table-flowss t))
|
|
(= 1 (length (car (table-flowss t)))))
|
|
(let ([m (current-table-mode)])
|
|
(and m
|
|
(equal? "supertabular" (car m))
|
|
(= 1 (length (car (table-flowss (cadr m))))))))]
|
|
[tableform (cond
|
|
[index? "list"]
|
|
[(and (not (current-table-mode))
|
|
(not inline-table?))
|
|
"supertabular"]
|
|
[else "tabular"])]
|
|
[opt (cond
|
|
[(equal? tableform "supertabular") "[l]"]
|
|
[(equal? tableform "tabular") "[t]"]
|
|
[else ""])]
|
|
[flowss (if index?
|
|
(cddr (table-flowss t))
|
|
(table-flowss t))])
|
|
(unless (or (null? flowss)
|
|
(null? (car flowss)))
|
|
(parameterize ([current-table-mode (if inline?
|
|
(current-table-mode)
|
|
(list tableform t))]
|
|
[show-link-page-numbers (or index?
|
|
(show-link-page-numbers))])
|
|
(cond
|
|
[index? (printf "\\begin{list}{}{\\parsep=0pt \\itemsep=1pt \\leftmargin=2ex \\itemindent=-2ex}\n")]
|
|
[inline? (void)]
|
|
[else
|
|
(printf "\n\n~a\\begin{~a}~a{@{}~a}\n"
|
|
(if boxed?
|
|
(format "{~a\\begin{picture}(1,0)\\put(0,0){\\line(1,0){1}}\\end{picture}}~a\n\\nopagebreak\n"
|
|
"\\setlength{\\unitlength}{\\linewidth}"
|
|
(if (equal? tableform "supertabular")
|
|
"\\supertabline"
|
|
"\n\n"))
|
|
"")
|
|
tableform
|
|
opt
|
|
(apply string-append
|
|
(map (lambda (i align)
|
|
(format "~a@{}"
|
|
(case align
|
|
[(center) "c"]
|
|
[(right) "r"]
|
|
[else "l"])))
|
|
(car flowss)
|
|
(cdr (or (and (list? (table-style t))
|
|
(assoc 'alignment (or (table-style t) null)))
|
|
(cons #f (map (lambda (x) #f) (car flowss))))))))])
|
|
(let loop ([flowss flowss]
|
|
[row-styles (cdr (or (and (list? (table-style t))
|
|
(assoc 'row-styles (table-style t)))
|
|
(cons #f (map (lambda (x) #f) flowss))))])
|
|
(let ([flows (car flowss)]
|
|
[row-style (car row-styles)])
|
|
(let loop ([flows flows])
|
|
(unless (null? flows)
|
|
(when index?
|
|
(printf "\\item "))
|
|
(unless (eq? 'cont (car flows))
|
|
(let ([cnt (let loop ([flows (cdr flows)][n 1])
|
|
(cond
|
|
[(null? flows) n]
|
|
[(eq? (car flows) 'cont) (loop (cdr flows) (add1 n))]
|
|
[else n]))])
|
|
(unless (= cnt 1)
|
|
(printf "\\multicolumn{~a}{l}{" cnt))
|
|
(render-flow (car flows) part ri #f)
|
|
(unless (= cnt 1)
|
|
(printf "}"))
|
|
(unless (null? (list-tail flows cnt))
|
|
(printf " &\n"))))
|
|
(unless (null? (cdr flows))
|
|
(loop (cdr flows)))))
|
|
(unless (or index?
|
|
(null? (cdr flowss)))
|
|
(printf " \\\\\n")
|
|
(when (equal? row-style "inferencetop")
|
|
(printf "\\hline\n")))
|
|
(unless (null? (cdr flowss))
|
|
(loop (cdr flowss) (cdr row-styles)))))
|
|
(unless inline?
|
|
(printf "~a\n\n\\end{~a}\n"
|
|
(if (equal? tableform "supertabular")
|
|
"\n\\\\"
|
|
"")
|
|
tableform)))))
|
|
null)
|
|
|
|
(define/override (render-itemization t part ri)
|
|
(printf "\n\n\\begin{itemize}\n")
|
|
(for-each (lambda (flow)
|
|
(printf "\n\n\\item ")
|
|
(render-flow flow part ri #t))
|
|
(itemization-flows t))
|
|
(printf "\n\n\\end{itemize}\n")
|
|
null)
|
|
|
|
(define/override (render-blockquote t part ri)
|
|
(let ([kind (or (blockquote-style t)
|
|
"quote")])
|
|
(printf "\n\n\\begin{~a}\n" kind)
|
|
(parameterize ([current-table-mode (list "blockquote" t)])
|
|
(for-each (lambda (e)
|
|
(render-flow-element e part ri #f))
|
|
(blockquote-paragraphs t)))
|
|
(printf "\n\n\\end{~a}\n" kind)
|
|
null))
|
|
|
|
(define/override (render-other i part ri)
|
|
(cond
|
|
[(string? i) (display-protected i)]
|
|
[(symbol? i) (display
|
|
(case i
|
|
[(nbsp) "~"]
|
|
[(mdash) "---"]
|
|
[(ndash) "--"]
|
|
[(ldquo) "``"]
|
|
[(rdquo) "''"]
|
|
[(rsquo) "'"]
|
|
[(prime) "$'$"]
|
|
[(rarr) "$\\rightarrow$"]
|
|
[(alpha) "$\\alpha$"]
|
|
[(infin) "$\\infty$"]
|
|
[else (error 'render "unknown symbol element: ~e" i)]))]
|
|
[else (display-protected (format "~s" i))])
|
|
null)
|
|
|
|
(define/private (display-protected s)
|
|
(let ([len (string-length s)])
|
|
(let loop ([i 0])
|
|
(unless (= i len)
|
|
(let ([c (string-ref s i)])
|
|
(case c
|
|
[(#\\) (display "$\\backslash$")]
|
|
[(#\_) (display "$\\_$")]
|
|
[(#\^) (display "{\\char'136}")]
|
|
[(#\>) (if (rendering-tt)
|
|
(display "{\\texttt >}")
|
|
(display "$>$"))]
|
|
[(#\<) (if (rendering-tt)
|
|
(display "{\\texttt <}")
|
|
(display "$<$"))]
|
|
[(#\|) (if (rendering-tt)
|
|
(display "{\\texttt |}")
|
|
(display "$|$"))]
|
|
[(#\? #\! #\. #\:) (if (rendering-tt)
|
|
(printf "{\\hbox{\\texttt{~a}}}" c)
|
|
(display c))]
|
|
[(#\~) (display "$\\sim$")]
|
|
[(#\{ #\} #\# #\% #\& #\$) (display "\\") (display c)]
|
|
[(#\uDF) (display "{\\ss}")]
|
|
[(#\u039A) (display "K")] ; kappa
|
|
[(#\u0391) (display "A")] ; alpha
|
|
[(#\u039F) (display "O")] ; omicron
|
|
[(#\u03A3) (display "$\\Sigma$")]
|
|
[(#\u03BA) (display "$\\kappa$")]
|
|
[(#\u03B1) (display "$\\alpha$")]
|
|
[(#\u03BF) (display "o")] ; omicron
|
|
[(#\u03C3) (display "$\\sigma$")]
|
|
[(#\u03C2) (display "$\\varsigma$")]
|
|
[(#\u03BB) (display "$\\lambda$")]
|
|
[(#\u039B) (display "$\\Lambda$")]
|
|
[(#\u03BC) (display "$\\mu$")]
|
|
[else (display c)]))
|
|
(loop (add1 i))))))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define/override (table-of-contents sec ri)
|
|
;; FIXME: isn't local to the section
|
|
(make-toc-paragraph null))
|
|
|
|
(define/override (local-table-of-contents part ri)
|
|
(make-paragraph null))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(super-new))))
|