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

doc edits and rendering improvements

Browse Source 
svn: r6260

original commit: 51e52cea8776edde8712ae09aaffb5794f7ba771
This commit is contained in:
Matthew Flatt 2007-05-24 09:35:34 +00:00
parent c16e2c54d8
commit 9567880910
2 changed files with 57 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,6 +5,7 @@
(provide render-mixin) (provide render-mixin)
(define current-table-depth (make-parameter 0)) (define current-table-depth (make-parameter 0))
(define rendering-tt (make-parameter #f))
(define-struct (toc-paragraph paragraph) ()) (define-struct (toc-paragraph paragraph) ())
@ -24,7 +25,7 @@
(printf "\\parskip=10pt%\n") (printf "\\parskip=10pt%\n")
(printf "\\parindent=0pt%\n") (printf "\\parindent=0pt%\n")
(printf "\\usepackage{graphicx}\n") (printf "\\usepackage{graphicx}\n")
(printf "\\usepackage{times}\n") (printf "\\renewcommand{\\rmdefault}{ptm}\n")
;; (printf "\\usepackage{fullpage}\n") ;; (printf "\\usepackage{fullpage}\n")
(printf "\\usepackage{longtable}\n") (printf "\\usepackage{longtable}\n")
(printf "\\usepackage[usenames,dvipsnames]{color}\n") (printf "\\usepackage[usenames,dvipsnames]{color}\n")
@ -37,17 +38,17 @@
(define-color "schemesymbol" "NavyBlue") (define-color "schemesymbol" "NavyBlue")
(define-color "schemevalue" "ForestGreen") (define-color "schemevalue" "ForestGreen")
(define-color "schemevaluelink" "blue") (define-color "schemevaluelink" "blue")
(define-color "schemeresult" "blue") (define-color "schemeresult" "NavyBlue")
(define-color "schemestdout" "Purple") (define-color "schemestdout" "Purple")
(define-color "schemevariablecol" "NavyBlue") (define-color "schemevariablecol" "NavyBlue")
(printf "\\newcommand{\\schemevariable}[1]{{\\schemevariablecol{\\textsl{#1}}}}\n") (printf "\\newcommand{\\schemevariable}[1]{{\\schemevariablecol{\\textsl{#1}}}}\n")
(define-color "schemeerrorcol" "red") (define-color "schemeerrorcol" "red")
(printf "\\newcommand{\\schemeerror}[1]{{\\schemeerrorcol{\\textit{#1}}}}\n") (printf "\\newcommand{\\schemeerror}[1]{{\\schemeerrorcol{\\textrm{\\textit{#1}}}}}\n")
(printf "\\newcommand{\\schemeopt}[1]{#1}\n") (printf "\\newcommand{\\schemeopt}[1]{#1}\n")
(printf "\\newcommand{\\textsub}[1]{$_{#1}$}\n") (printf "\\newcommand{\\textsub}[1]{$_{#1}$}\n")
(printf "\\newcommand{\\textsuper}[1]{$^{#1}$}\n") (printf "\\newcommand{\\textsuper}[1]{$^{#1}$}\n")
(printf "\\definecolor{LightGray}{rgb}{0.85,0.85,0.85}\n") (printf "\\definecolor{LightGray}{rgb}{0.90,0.90,0.90}\n")
(printf "\\newcommand{\\schemeinput}[1]{\\colorbox{LightGray}{\\schemeinputcol{#1}}}\n") (printf "\\newcommand{\\schemeinput}[1]{\\colorbox{LightGray}{\\hspace{-0.5ex}\\schemeinputcol{#1}\\hspace{-0.5ex}}}\n")
(printf "\\begin{document}\n") (printf "\\begin{document}\n")
(when (part-title-content d) (when (part-title-content d)
(printf "\\title{") (printf "\\title{")
@ -82,7 +83,7 @@
(define/override (render-paragraph p part ht) (define/override (render-paragraph p part ht)
(printf "\n\n") (printf "\n\n")
(if (toc-paragraph? p) (if (toc-paragraph? p)
(printf "\\tableofcontents") (printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ht)) (super render-paragraph p part ht))
(printf "\n\n") (printf "\n\n")
null) null)
@ -90,30 +91,36 @@
(define/override (render-element e part ht) (define/override (render-element e part ht)
(when (and (link-element? e) (when (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)))
(printf "\\S\\ref{section:~a} " (cadr (link-element-tag e)))) (printf "\\S\\ref{section:~a} " (cadr (link-element-tag e))))
(let ([style (and (element? e) (let ([style (and (element? e)
(element-style e))] (element-style e))]
[wrap (lambda (e s) [wrap (lambda (e s tt?)
(printf "{\\~a{" s) (printf "{\\~a{" s)
(super render-element e part ht) (parameterize ([rendering-tt (or tt?
(rendering-tt))])
(super render-element e part ht))
(printf "}}"))]) (printf "}}"))])
(cond (cond
[(symbol? style) [(symbol? style)
(case style (case style
[(italic) (wrap e "textit")] [(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf")] [(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "texttt")] [(tt) (wrap e "texttt" #t)]
[(sf) (wrap e "textsf")] [(sf) (wrap e "textsf" #f)]
[(subscript) (wrap e "textsub")] [(subscript) (wrap e "textsub" #f)]
[(superscript) (wrap e "textsuper")] [(superscript) (wrap e "textsuper" #f)]
[(hspace) (let ([s (content->string (element-content e))]) [(hspace) (let ([s (content->string (element-content e))])
(unless (zero? (string-length s)) (case (string-length s)
(printf "{\\texttt ~a}" [(0) (void)]
(regexp-replace* #rx"." s "~"))))] [(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)])] [else (error 'latex-render "unrecognzied style symbol: ~s" style)])]
[(string? style) [(string? style)
(wrap e style)] (wrap e style (regexp-match? #px"^scheme(?!error)" style))]
[(image-file? style) [(image-file? style)
(let ([fn (install-file (image-file-path style))]) (let ([fn (install-file (image-file-path style))])
(printf "\\includegraphics{~a}" fn))] (printf "\\includegraphics{~a}" fn))]
@ -135,11 +142,13 @@
(parameterize ([current-table-depth (add1 (current-table-depth))]) (parameterize ([current-table-depth (add1 (current-table-depth))])
(if index? (if index?
(printf "\n\n\\begin{theindex}\n") (printf "\n\n\\begin{theindex}\n")
(printf "\n\n~a\\begin{~a}~a{@{}~a@{}}\n" (printf "\n\n~a\\begin{~a}~a{@{}~a}\n"
(if boxed? "\\vspace{4ex}\\hrule\n\\vspace{-2ex}\n" "") (if boxed? "\\vspace{4ex}\\hrule\n\\vspace{-2ex}\n" "")
tableform tableform
opt opt
(make-string (length (car (table-flowss t))) #\l))) (apply string-append
(map (lambda (i) "l@{}")
(car (table-flowss t))))))
(for-each (lambda (flows) (for-each (lambda (flows)
(let loop ([flows flows]) (let loop ([flows flows])
(unless (null? flows) (unless (null? flows)
@ -150,7 +159,11 @@
(unless index? (unless index?
(printf " \\\\\n"))) (printf " \\\\\n")))
(table-flowss t)) (table-flowss t))
(printf "\n\n\\end{~a}\n" tableform)))) (printf "\n\n\\end{~a}~a\n"
tableform
(if (equal? tableform "longtable")
"\\vspace{-3ex}" ;; counteracts mysterious space added after longtable
"")))))
null) null)
(define/override (render-itemization t part ht) (define/override (render-itemization t part ht)
@ -185,16 +198,28 @@
(case c (case c
[(#\\) (display "$\\backslash$")] [(#\\) (display "$\\backslash$")]
[(#\_) (display "$\\_$")] [(#\_) (display "$\\_$")]
[(#\>) (display "{\\texttt >}")] [(#\>) (if (rendering-tt)
[(#\<) (display "{\\texttt <}")] (display "{\\texttt >}")
(display "$>$"))]
[(#\<) (if (rendering-tt)
(display "{\\texttt <}")
(display "$<$"))]
[(#\? #\! #\. #\:) (if (rendering-tt)
(printf "{\\hbox{\\texttt{~a}}}" c)
(display c))]
[(#\~) (display "$\\sim$")] [(#\~) (display "$\\sim$")]
[(#\{ #\} #\# #\% #\&) (display "\\") (display c)] [(#\{ #\} #\# #\% #\&) (display "\\") (display c)]
[(#\uDF) (display "{\\ss}")] [(#\uDF) (display "{\\ss}")]
[(#\u039A #\u0391 #\u039F #\u03A3 [(#\u039A) (display "K")] ; kappa
#\u03BA #\u03b1 #\u03BF #\u03C3) [(#\u0391) (display "A")] ; alpha
(printf "$\\backslash$u~a" [(#\u039F) (display "O")] ; omicron
(let ([s (format "0000~x" (char->integer c))]) [(#\u03A3) (display "$\\Sigma$")]
(substring s (- (string-length s) 4))))] [(#\u03BA) (display "$\\kappa$")]
[(#\u03B1) (display "$\\alpha$")]
[(#\u03BF) (display "o")] ; omicron
[(#\u03C3) (display "$\\sigma$")]
[(#\u03BB) (display "$\\lambda$")]
[(#\u03BC) (display "$\\mu$")]
[else (display c)])) [else (display c)]))
(loop (add1 i)))))) (loop (add1 i))))))

6
collects/scribble/scheme.ss
View File

@ -81,7 +81,7 @@
(let ([amt (+ (- c src-col) (- d-col dest-col))]) (let ([amt (+ (- c src-col) (- d-col dest-col))])
(when (positive? amt) (when (positive? amt)
(let ([old-dest-col dest-col]) (let ([old-dest-col dest-col])
(out (make-element 'hspace (list (make-string amt #\space))) no-color) (out (make-element 'hspace (list (make-string amt #\space))) #f)
(set! dest-col (+ old-dest-col amt)))))) (set! dest-col (+ old-dest-col amt))))))
(set! src-col (+ c (or span 1)))))) (set! src-col (+ c (or span 1))))))
(define (convert-infix c quote-depth) (define (convert-infix c quote-depth)
@ -240,7 +240,7 @@
(values (substring s 1) #t #f) (values (substring s 1) #t #f)
(values s #f #f))))]) (values s #f #f))))])
(if (element? (syntax-e c)) (if (element? (syntax-e c))
(out (syntax-e c) no-color) (out (syntax-e c) #f)
(out (if (and (identifier? c) (out (if (and (identifier? c)
color? color?
(quote-depth . <= . 0) (quote-depth . <= . 0)
@ -278,7 +278,7 @@
[else paren-color]))) [else paren-color])))
(hash-table-put! col-map src-col dest-col))]))) (hash-table-put! col-map src-col dest-col))])))
(hash-table-put! col-map src-col dest-col) (hash-table-put! col-map src-col dest-col)
(out prefix1 no-color) (out prefix1 #f)
((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0) c) ((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0) c)
(unless (null? content) (unless (null? content)
(finish-line!)) (finish-line!))