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