suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

latex output, especially margin notes

Browse Source 
svn: r6496

original commit: 0b9493032b3a6d55d85c291ad54e84a513d6fb80
This commit is contained in:
Matthew Flatt 2007-06-06 01:20:49 +00:00
parent c049ea87f0
commit 5a0cc3d55f
1 changed files with 55 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
collects/scribble/latex-render.ss
View File

@ -88,56 +88,65 @@
(define/override (render-paragraph p part ht)
(printf "\n\n")
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ht))
(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 ht))
(when margin?
(printf "}")))
(printf "\n\n")
null)
(define/override (render-element e part ht)
(when (and (link-element? e)
(pair? (link-element-tag e))
(eq? 'part (car (link-element-tag e)))
(null? (element-content e)))
(printf "\\S")
(render-content (let ([dest (lookup part ht (link-element-tag e))])
(if dest
(format-number (cadr dest) null)
(list "???")))
part
ht)
(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 ht))
(printf "}}"))])
(cond
[(symbol? style)
(case style
[(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "texttt" #t)]
[(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)]
[(1) (printf "{\\texttt{ }}")] ; allows a line break to replace the space
[else
(printf "{\\texttt{~a}}"
(regexp-replace* #rx"." s "~"))]))]
[else (error 'latex-render "unrecognzied style symbol: ~s" style)])]
[(string? style)
(wrap e style (regexp-match? #px"^scheme(?!error)" style))]
[(image-file? style)
(let ([fn (install-file (image-file-path style))])
(printf "\\includegraphics{~a}" fn))]
[else (super render-element e part ht)]))
(let ([part-label? (and (link-element? e)
(pair? (link-element-tag e))
(eq? 'part (car (link-element-tag e)))
(null? (element-content e)))])
(when part-label?
(printf "\\S")
(render-content (let ([dest (lookup part ht (link-element-tag e))])
(if dest
(format-number (cadr dest) null)
(list "???")))
part
ht)
(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 ht))
(printf "}}"))])
(cond
[(symbol? style)
(case style
[(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "texttt" #t)]
[(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)]
[(1) (printf "{\\texttt{ }}")] ; allows a line break to replace the space
[else
(printf "{\\texttt{~a}}"
(regexp-replace* #rx"." s "~"))]))]
[else (error 'latex-render "unrecognzied style symbol: ~s" style)])]
[(string? style)
(wrap e style (regexp-match? #px"^scheme(?!error)" style))]
[(image-file? style)
(let ([fn (install-file (image-file-path style))])
(printf "\\includegraphics{~a}" fn))]
[else (super render-element e part ht)]))
(when part-label?
(printf "''")))
null)
(define/override (render-table t part ht)