7278568040
Add a `link-render-style` syntax property to control the rendering of section links --- so that HTML output can say "section <number>", and so that Latex/PDF output can have just the section number hperlinked (as in acmart). It seems unfortunate that the link rendering is so hardwired into each rendering back-end, but maybe this can be made even more configurable in the future. Meanwhile, Latex macros already provide an additional layer of rendering control (but not enough, it turns out, to easily perform the same adjustments as the 'number mode that matches acmart). For `scriblib/figure` make `figure-ref` and `Figure-ref` similarly sensitive to the link-rendering style. For `scriblib/autobib`, change the hyperlinking of references so that the color can be overridden, and make `scribble/acmart` override it.
1454 lines
70 KiB
Racket
1454 lines
70 KiB
Racket
#lang at-exp racket/base
|
||
(require "core.rkt"
|
||
"latex-properties.rkt"
|
||
"private/render-utils.rkt"
|
||
racket/class
|
||
racket/runtime-path
|
||
racket/port
|
||
racket/string
|
||
racket/path
|
||
racket/list
|
||
setup/collects
|
||
file/convertible)
|
||
(provide render-mixin
|
||
make-render-part-mixin
|
||
extra-character-conversions)
|
||
|
||
(define current-table-mode (make-parameter #f))
|
||
(define rendering-tt (make-parameter #f))
|
||
(define show-link-page-numbers (make-parameter #f))
|
||
(define done-link-page-numbers (make-parameter #f))
|
||
(define disable-images (make-parameter #f))
|
||
(define escape-brackets (make-parameter #f))
|
||
(define suppress-newline-content (make-parameter #f))
|
||
(define disable-hyperref (make-parameter #f))
|
||
|
||
(define-struct (toc-paragraph paragraph) ())
|
||
|
||
(define-runtime-path scribble-prefix-tex "scribble-prefix.tex")
|
||
(define-runtime-path scribble-packages-tex "scribble-packages.tex")
|
||
(define-runtime-path scribble-load-tex "scribble-load.tex")
|
||
(define-runtime-path scribble-tex "scribble.tex")
|
||
(define-runtime-path scribble-style-tex "scribble-style.tex")
|
||
(define-runtime-path scribble-load-replace-tex "scribble-load-replace.tex")
|
||
|
||
(define (color->string c)
|
||
(if (string? c)
|
||
c
|
||
(format "~a,~a,~a"
|
||
(/ (car c) 255.0)
|
||
(/ (cadr c) 255.0)
|
||
(/ (caddr c) 255.0))))
|
||
|
||
(define (make-render-part-mixin n)
|
||
(lambda (%)
|
||
(class (render-mixin %)
|
||
(define/override (render-part-depth) n)
|
||
(super-new))))
|
||
|
||
(define-runtime-path skull-tex "scribble-skull.tex")
|
||
(define skull-style (make-style #f (list (tex-addition skull-tex))))
|
||
|
||
(define extra-character-conversions (make-parameter (λ (c) #f)))
|
||
|
||
(define (render-mixin % #:image-mode [image-mode #f])
|
||
(class %
|
||
(super-new)
|
||
|
||
(inherit-field prefix-file style-file style-extra-files image-preferences)
|
||
|
||
(define/override (current-render-mode)
|
||
'(latex))
|
||
|
||
(inherit sort-image-requests)
|
||
(define image-reqs
|
||
(sort-image-requests (cond
|
||
[(eq? image-mode 'pdf)
|
||
'(pdf-bytes png@2x-bytes png-bytes)]
|
||
[(eq? image-mode 'ps)
|
||
'(eps-bytes)]
|
||
[else
|
||
'(pdf-bytes png@2x-bytes png-bytes eps-bytes)])
|
||
image-preferences))
|
||
|
||
(define/override (get-suffix) #".tex")
|
||
|
||
(inherit render-block
|
||
render-part
|
||
install-file
|
||
format-number
|
||
number-depth
|
||
extract-part-style-files
|
||
extract-version
|
||
extract-date
|
||
extract-authors
|
||
extract-pretitle-content
|
||
link-render-style-at-element)
|
||
|
||
(define/public (extract-short-title d)
|
||
(ormap (lambda (v)
|
||
(and (short-title? v)
|
||
(short-title-text v)))
|
||
(style-properties (part-style d))))
|
||
|
||
(define/override (auto-extra-files? v) (latex-defaults? v))
|
||
(define/override (auto-extra-files-paths v) (latex-defaults-extra-files v))
|
||
|
||
(define/public (render-part-depth) #f)
|
||
|
||
(define/override (render-one d ri fn)
|
||
(define (maybe-replace file defaults)
|
||
(cond [(and defaults
|
||
(latex-defaults+replacements? defaults)
|
||
(hash-ref (latex-defaults+replacements-replacements defaults)
|
||
(path->string (file-name-from-path file))
|
||
#f)) =>
|
||
(lambda (v)
|
||
(cond
|
||
[(bytes? v) v]
|
||
[else (collects-relative->path v)]))]
|
||
[else file]))
|
||
(let* ([defaults (ormap (lambda (v) (and (latex-defaults? v) v))
|
||
(style-properties (part-style d)))]
|
||
[prefix-file (or prefix-file
|
||
(and defaults
|
||
(let ([v (latex-defaults-prefix defaults)])
|
||
(cond
|
||
[(bytes? v) v]
|
||
[else (collects-relative->path v)])))
|
||
scribble-prefix-tex)]
|
||
[style-file (or style-file
|
||
(and defaults
|
||
(let ([v (latex-defaults-style defaults)])
|
||
(cond
|
||
[(bytes? v) v]
|
||
[else (collects-relative->path v)])))
|
||
scribble-style-tex)]
|
||
[all-style-files (list* scribble-load-tex
|
||
(maybe-replace scribble-load-replace-tex defaults)
|
||
scribble-tex
|
||
(append (extract-part-style-files
|
||
d
|
||
ri
|
||
(lambda (p) #f)
|
||
tex-addition?
|
||
tex-addition-path)
|
||
(list style-file)
|
||
style-extra-files))]
|
||
[whole-doc? (not (render-part-depth))])
|
||
(if whole-doc?
|
||
(for ([style-file (in-list (cons prefix-file all-style-files))])
|
||
(if (bytes? style-file)
|
||
(display style-file)
|
||
(with-input-from-file style-file
|
||
(lambda ()
|
||
(copy-port (current-input-port) (current-output-port))))))
|
||
(for ([style-file (in-list all-style-files)])
|
||
(if (bytes? style-file)
|
||
(display style-file)
|
||
(install-file style-file))))
|
||
(when whole-doc?
|
||
(printf "\\begin{document}\n\\preDoc\n")
|
||
(when (part-title-content d)
|
||
(let ([vers (extract-version d)]
|
||
[date (extract-date d)]
|
||
[pres (extract-pretitle-content d)]
|
||
[auths (extract-authors d)]
|
||
[short (extract-short-title d)])
|
||
(for ([pre (in-list pres)])
|
||
(printf "\n\n")
|
||
(cond
|
||
[(paragraph? pre)
|
||
(do-render-paragraph pre d ri #t #f)]
|
||
[(nested-flow? pre)
|
||
(do-render-nested-flow pre d ri #t #f #t)]))
|
||
(when date (printf "\\date{~a}\n" date))
|
||
(printf "\\titleAnd~aVersionAnd~aAuthors~a{"
|
||
|
||
(if (equal? vers "") "Empty" "")
|
||
(if (null? auths) "Empty" "")
|
||
(if short "AndShort" ""))
|
||
(render-content (part-title-content d) d ri)
|
||
(printf "}{~a}{" vers)
|
||
(unless (null? auths)
|
||
(printf "\\SNumberOfAuthors{~a}" (length auths)))
|
||
(for/fold ([first? #t]) ([auth (in-list auths)])
|
||
(unless first? (printf "\\SAuthorSep{}"))
|
||
(do-render-paragraph auth d ri #t #f)
|
||
#f)
|
||
(if short
|
||
(printf "}{~a}\n" short)
|
||
(printf "}\n")))))
|
||
(render-part d ri)
|
||
(when whole-doc?
|
||
(printf "\n\n\\postDoc\n\\end{document}\n"))))
|
||
|
||
(define/override (render-part-content d ri)
|
||
(let ([number (collected-info-number (part-collected-info d ri))]
|
||
[completely-hidden?
|
||
(and (part-style? d 'hidden)
|
||
(equal? "" (content->string (part-title-content d))))])
|
||
(when (and (part-title-content d)
|
||
(or (pair? number)
|
||
(let ([d (render-part-depth)])
|
||
(and d (positive? d)))))
|
||
(when (eq? (style-name (part-style d)) 'index)
|
||
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
|
||
(let ([pres (extract-pretitle-content d)])
|
||
(for ([pre (in-list pres)])
|
||
(printf "\n\n")
|
||
(do-render-paragraph pre d ri #t #f)))
|
||
(define depth (+ (number-depth number) (or (render-part-depth) 0)))
|
||
(define grouper? (part-style? d 'grouper))
|
||
(define (inc-section-number)
|
||
(printf "\\Sinc~a" (case depth
|
||
[(0 1) (if grouper? "part" "section")]
|
||
[(2) "subsection"]
|
||
[(3) "subsubsection"]
|
||
[(4) "subsubsubsection"]
|
||
[else "subsubsubsubsection"])))
|
||
(cond
|
||
[completely-hidden?
|
||
(printf "\n\n\\notitlesection")
|
||
(unless (part-style? d 'unnumbered)
|
||
(inc-section-number))]
|
||
[else
|
||
(define no-number? (and (pair? number)
|
||
(or (not (car number))
|
||
(equal? "" (car number))
|
||
((length number) . > . 3))))
|
||
(define no-toc? (part-style? d 'toc-hidden))
|
||
(define (show-number)
|
||
(when (and (part-style? d 'grouper)
|
||
(depth . > . 1)
|
||
(not no-number?))
|
||
(printf "~a\\quad{}" (car (format-number number null)))))
|
||
(printf "\n\n\\~a~a~a"
|
||
(case depth
|
||
[(0 1) (if grouper?
|
||
"partNewpage\n\n\\Spart"
|
||
"sectionNewpage\n\n\\Ssection")]
|
||
[(2) "Ssubsection"]
|
||
[(3) "Ssubsubsection"]
|
||
[(4) "Ssubsubsubsection"]
|
||
[else "Ssubsubsubsubsection"])
|
||
(if (and grouper?
|
||
(depth . > . 1))
|
||
"grouper"
|
||
"")
|
||
(if no-number?
|
||
(if no-toc?
|
||
"star"
|
||
"starx")
|
||
""))
|
||
(unless (and no-number? no-toc?)
|
||
(printf "{")
|
||
(show-number)
|
||
(parameterize ([disable-images #t]
|
||
[escape-brackets #t]
|
||
[disable-hyperref #t])
|
||
(render-content (part-title-content d) d ri))
|
||
(printf "}"))
|
||
(printf "{")
|
||
(show-number)
|
||
(parameterize ([disable-hyperref #t])
|
||
(render-content (part-title-content d) d ri))
|
||
(printf "}")
|
||
(when (and (part-style? d 'hidden-number)
|
||
(not (part-style? d 'unnumbered)))
|
||
(inc-section-number))
|
||
(when (eq? (style-name (part-style d)) 'index) (printf "\n\n"))]))
|
||
(for ([t (part-tags d)])
|
||
(printf "\\label{t:~a}~a" (t-encode (add-current-tag-prefix (tag-key t ri)))
|
||
(if completely-hidden? "" "\n\n")))
|
||
(render-flow (part-blocks d) d ri #f)
|
||
(for ([sec (part-parts d)]) (render-part sec ri))
|
||
(when (eq? (style-name (part-style d)) 'index) (printf "\\onecolumn\n\n"))
|
||
null))
|
||
|
||
(define/override (render-paragraph p part ri)
|
||
(do-render-paragraph p part ri #f #f))
|
||
|
||
(define/private (do-render-paragraph p part ri show-pre? as-box-mode)
|
||
(let* ([sn (style-name (paragraph-style p))]
|
||
[style (cond
|
||
[as-box-mode
|
||
(or
|
||
(ormap (lambda (a)
|
||
(and (box-mode? a)
|
||
((box-mode-selector as-box-mode) a)))
|
||
(style-properties
|
||
(paragraph-style p)))
|
||
"hbox")]
|
||
[(eq? sn 'author) "SAuthor"]
|
||
[(eq? sn 'pretitle) #f]
|
||
[(eq? sn 'wraps) #f]
|
||
[else sn])])
|
||
(unless (and (not show-pre?)
|
||
(or (eq? sn 'author)
|
||
(eq? sn 'pretitle)))
|
||
(let ([use-style? (string? style)])
|
||
(when use-style?
|
||
(printf "\\~a{" style))
|
||
(if (toc-paragraph? p)
|
||
(printf "\\newpage \\tableofcontents \\newpage")
|
||
(if as-box-mode
|
||
(parameterize ([suppress-newline-content #t])
|
||
(super render-paragraph p part ri))
|
||
(super render-paragraph p part ri)))
|
||
(when use-style? (printf "}")))))
|
||
null)
|
||
|
||
(define/private (no-noindent? p ri)
|
||
(cond
|
||
[(delayed-block? p)
|
||
(no-noindent? (delayed-block-blocks p ri) ri)]
|
||
[(traverse-block? p)
|
||
(no-noindent? (traverse-block-block p ri) ri)]
|
||
[else
|
||
(or
|
||
(memq 'never-indents
|
||
(style-properties
|
||
(cond
|
||
[(paragraph? p) (paragraph-style p)]
|
||
[(compound-paragraph? p) (compound-paragraph-style p)]
|
||
[(nested-flow? p) (nested-flow-style p)]
|
||
[(table? p) (table-style p)]
|
||
[(itemization? p) (itemization-style p)]
|
||
[else plain])))
|
||
(and (nested-flow? p)
|
||
(pair? (nested-flow-blocks p))
|
||
(no-noindent? (car (nested-flow-blocks p)) ri))
|
||
(and (compound-paragraph? p)
|
||
(pair? (compound-paragraph-blocks p))
|
||
(no-noindent? (car (compound-paragraph-blocks p)) ri)))]))
|
||
|
||
(define/override (render-intrapara-block p part ri first? last? starting-item?)
|
||
(unless first?
|
||
(printf "\n\n")
|
||
(unless (no-noindent? p ri)
|
||
(printf "\\noindent ")))
|
||
(super render-intrapara-block p part ri first? last? starting-item?))
|
||
|
||
(define/override (render-content e part ri)
|
||
(let ([part-label? (and (link-element? e)
|
||
(pair? (link-element-tag e))
|
||
(eq? 'part (car (link-element-tag e)))
|
||
(empty-content? (element-content e)))])
|
||
(parameterize ([done-link-page-numbers (or (done-link-page-numbers)
|
||
(link-element? e))])
|
||
(when (target-element? e)
|
||
(printf "\\label{t:~a}"
|
||
(t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri)))))
|
||
(when part-label?
|
||
(define-values (dest ext?) (resolve-get/ext? part ri (link-element-tag e)))
|
||
(let* ([number (and dest (vector-ref dest 2))]
|
||
[formatted-number (and dest
|
||
(list? number)
|
||
(format-number number null))]
|
||
[lbl? (and dest
|
||
(not ext?)
|
||
(not (show-link-page-numbers)))]
|
||
[link-number? (and lbl?
|
||
(eq? 'number (link-render-style-at-element e)))])
|
||
(printf "\\~aRef~a~a~a{"
|
||
(case (and dest (number-depth number))
|
||
[(0) "Book"]
|
||
[(1) (if (string? (car number)) "Part" "Chap")]
|
||
[else "Sec"])
|
||
(if (and lbl? (not link-number?))
|
||
"Local"
|
||
"")
|
||
(if (let ([s (element-style e)])
|
||
(and (style? s) (memq 'uppercase (style-properties s))))
|
||
"UC"
|
||
"")
|
||
(if (null? formatted-number)
|
||
"UN"
|
||
""))
|
||
(when (and lbl? (not link-number?))
|
||
(printf "t:~a}{" (t-encode (vector-ref dest 1))))
|
||
(unless (null? formatted-number)
|
||
(when link-number? (printf "\\SectionNumberLink{t:~a}{" (t-encode (vector-ref dest 1))))
|
||
(render-content
|
||
(if dest
|
||
(if (list? number)
|
||
formatted-number
|
||
(begin (eprintf "Internal tag error: ~s -> ~s\n"
|
||
(link-element-tag e)
|
||
dest)
|
||
'("!!!")))
|
||
(list "???"))
|
||
part ri)
|
||
(when link-number? (printf "}"))
|
||
(printf "}{"))))
|
||
(let* ([es (cond
|
||
[(element? e) (element-style e)]
|
||
[(multiarg-element? e) (multiarg-element-style e)]
|
||
[else #f])]
|
||
[style-name (if (style? es)
|
||
(style-name es)
|
||
es)]
|
||
[style (and (style? es) es)]
|
||
[hyperref? (and (not part-label?)
|
||
(link-element? e)
|
||
(not (disable-hyperref))
|
||
(let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))])
|
||
(and dest (not ext?))))]
|
||
[check-render
|
||
(lambda ()
|
||
(when (render-element? e)
|
||
((render-element-render e) this part ri)))]
|
||
[core-render (lambda (e tt?)
|
||
(cond
|
||
[(and (image-element? e)
|
||
(not (disable-images)))
|
||
(check-render)
|
||
(let ([fn (install-file
|
||
(select-suffix
|
||
(collects-relative->path
|
||
(image-element-path e))
|
||
(image-element-suffixes e)
|
||
'(".pdf" ".ps" ".png")))])
|
||
(printf "\\includegraphics[scale=~a]{~a}"
|
||
(image-element-scale e) fn))]
|
||
[(and (convertible? e)
|
||
(not (disable-images))
|
||
(let ([ftag (lambda (v suffix [scale 1]) (and v (list v suffix scale)))]
|
||
[xxlist (lambda (v) (and v (list v #f #f #f #f #f #f #f #f)))]
|
||
[xlist (lambda (v) (and v (append v (list 0 0 0 0))))])
|
||
(for/or ([req (in-list image-reqs)])
|
||
(case req
|
||
[(eps-bytes)
|
||
(or (ftag (convert e 'eps-bytes+bounds8) ".ps")
|
||
(ftag (xlist (convert e 'eps-bytes+bounds)) ".ps")
|
||
(ftag (xxlist (convert e 'eps-bytes)) ".ps"))]
|
||
[(pdf-bytes)
|
||
(or (ftag (convert e 'pdf-bytes+bounds8) ".pdf")
|
||
(ftag (xlist (convert e 'pdf-bytes+bounds)) ".pdf")
|
||
(ftag (xxlist (convert e 'pdf-bytes)) ".pdf"))]
|
||
[(png@2x-bytes)
|
||
(or (ftag (convert e 'png@2x-bytes+bounds8) ".png" 0.5)
|
||
(ftag (xxlist (convert e 'png@2x-bytes)) ".png" 0.5))]
|
||
[(png-bytes)
|
||
(or (ftag (convert e 'png-bytes+bounds8) ".png")
|
||
(ftag (xxlist (convert e 'png-bytes)) ".png"))]))))
|
||
=> (lambda (bstr+info+suffix)
|
||
(check-render)
|
||
(let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)]
|
||
[suffix (list-ref bstr+info+suffix 1)]
|
||
[scale (list-ref bstr+info+suffix 2)]
|
||
[height (list-ref (list-ref bstr+info+suffix 0) 2)]
|
||
[pad-left (or (list-ref (list-ref bstr+info+suffix 0) 5) 0)]
|
||
[pad-top (or (list-ref (list-ref bstr+info+suffix 0) 6) 0)]
|
||
[pad-right (or (list-ref (list-ref bstr+info+suffix 0) 7) 0)]
|
||
[pad-bottom (or (list-ref (list-ref bstr+info+suffix 0) 8) 0)]
|
||
[descent (and height
|
||
(- (+ (list-ref (list-ref bstr+info+suffix 0) 3)
|
||
(- (ceiling height) height))
|
||
pad-bottom))]
|
||
[width (let ([w (list-ref (list-ref bstr+info+suffix 0) 1)])
|
||
(and w (- w pad-left pad-right)))]
|
||
[fn (install-file (format "pict~a" suffix) bstr)])
|
||
(if descent
|
||
(printf "\\raisebox{-~abp}{\\makebox[~abp][l]{\\includegraphics[~atrim=~a ~a ~a ~a]{~a}}}"
|
||
descent
|
||
width
|
||
(if (= scale 1) "" (format "scale=~a," scale))
|
||
(/ pad-left scale) (/ pad-bottom scale) (/ pad-right scale) (/ pad-top scale)
|
||
fn)
|
||
(printf "\\includegraphics{~a}" fn))))]
|
||
[else
|
||
(parameterize ([rendering-tt (or tt? (rendering-tt))])
|
||
(super render-content e part ri))]))]
|
||
[wrap (lambda (e s tt?)
|
||
(when s (printf "\\~a{" s))
|
||
(core-render e tt?)
|
||
(when s (printf "}")))])
|
||
(define (finish tt?)
|
||
(cond
|
||
[(symbol? style-name)
|
||
(case style-name
|
||
[(italic) (wrap e "textit" tt?)]
|
||
[(bold) (wrap e "textbf" tt?)]
|
||
[(tt) (wrap e "Scribtexttt" #t)]
|
||
[(url) (wrap e "Snolinkurl" 'url)]
|
||
[(no-break) (wrap e "mbox" tt?)]
|
||
[(sf) (wrap e "textsf" #f)]
|
||
[(roman) (wrap e "textrm" #f)]
|
||
[(subscript) (wrap e "textsub" #f)]
|
||
[(superscript) (wrap e "textsuper" #f)]
|
||
[(smaller) (wrap e "Smaller" #f)]
|
||
[(larger) (wrap e "Larger" #f)]
|
||
[(hspace)
|
||
(check-render)
|
||
(let ([s (content->string e)])
|
||
(case (string-length s)
|
||
[(0) (void)]
|
||
[else
|
||
(printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
|
||
(regexp-replace* #rx"." s "x"))]))]
|
||
[(newline)
|
||
(check-render)
|
||
(unless (suppress-newline-content)
|
||
(printf "\\hspace*{\\fill}\\\\"))]
|
||
[else (error 'latex-render
|
||
"unrecognized style symbol: ~s" style)])]
|
||
[(string? style-name)
|
||
(let* ([v (if style (style-properties style) null)]
|
||
[tt? (cond
|
||
[(memq 'tt-chars v) #t]
|
||
[(memq 'exact-chars v) 'exact]
|
||
[else tt?])])
|
||
(cond
|
||
[(multiarg-element? e)
|
||
(check-render)
|
||
(printf "\\~a" style-name)
|
||
(define maybe-optional-args
|
||
(findf command-optional? (if style (style-properties style) '())))
|
||
(when maybe-optional-args
|
||
(for ([i (in-list (command-optional-arguments maybe-optional-args))])
|
||
(printf "[~a]" i)))
|
||
(if (null? (multiarg-element-contents e))
|
||
(printf "{}")
|
||
(for ([i (in-list (multiarg-element-contents e))])
|
||
(printf "{")
|
||
(parameterize ([rendering-tt (or tt? (rendering-tt))])
|
||
(render-content i part ri))
|
||
(printf "}")))]
|
||
[else
|
||
(define maybe-optional
|
||
(findf command-optional? (if style (style-properties style) '())))
|
||
(if maybe-optional
|
||
(wrap e
|
||
(string-join #:before-first (format "~a[" style-name)
|
||
#:after-last "]"
|
||
(command-optional-arguments maybe-optional)
|
||
"][")
|
||
tt?)
|
||
(wrap e style-name tt?))]))]
|
||
[(and (not style-name)
|
||
style
|
||
(memq 'exact-chars (style-properties style)))
|
||
(wrap e style-name 'exact)]
|
||
[else
|
||
(core-render e tt?)]))
|
||
(when hyperref?
|
||
(printf "\\hyperref[t:~a]{"
|
||
(t-encode (link-element-tag e))))
|
||
(let loop ([l (if style (style-properties style) null)] [tt? #f])
|
||
(if (null? l)
|
||
(if hyperref?
|
||
(parameterize ([disable-hyperref #t])
|
||
(finish tt?))
|
||
(finish tt?))
|
||
(let ([v (car l)])
|
||
(cond
|
||
[(target-url? v)
|
||
(define target (let* ([s (let ([p (target-url-addr v)])
|
||
(if (path? p)
|
||
(path->string p)
|
||
p))]
|
||
[s (regexp-replace* #rx"\\\\" s "%5c")]
|
||
[s (regexp-replace* #rx"{" s "%7b")]
|
||
[s (regexp-replace* #rx"}" s "%7d")]
|
||
[s (regexp-replace* #rx"%" s "\\\\%")])
|
||
s))
|
||
(if (regexp-match? #rx"^[^#]*#[^#]*$" target)
|
||
;; work around a problem with `\href' as an
|
||
;; argument to other macros, such as `\marginpar':
|
||
(let ([l (string-split target "#")])
|
||
(printf "\\Shref{~a}{~a}{" (car l) (cadr l)))
|
||
;; normal:
|
||
(printf "\\href{~a}{" target))
|
||
(loop (cdr l) #t)
|
||
(printf "}")]
|
||
[(color-property? v)
|
||
(printf "\\intext~acolor{~a}{"
|
||
(if (string? (color-property-color v)) "" "rgb")
|
||
(color->string (color-property-color v)))
|
||
(loop (cdr l) tt?)
|
||
(printf "}")]
|
||
[(background-color-property? v)
|
||
(printf "\\in~acolorbox{~a}{"
|
||
(if (string? (background-color-property-color v)) "" "rgb")
|
||
(color->string (background-color-property-color v)))
|
||
(loop (cdr l) tt?)
|
||
(printf "}")]
|
||
[(command-extras? (car l))
|
||
(loop (cdr l) tt?)
|
||
(for ([l (in-list (command-extras-arguments (car l)))])
|
||
(printf "{~a}" l))]
|
||
[else (loop (cdr l) tt?)]))))
|
||
(when hyperref?
|
||
(printf "}"))))
|
||
(when part-label?
|
||
(printf "}"))
|
||
(when (and (link-element? e)
|
||
(show-link-page-numbers)
|
||
(not (done-link-page-numbers)))
|
||
(printf ", \\pageref{t:~a}"
|
||
(t-encode
|
||
(let ([v (resolve-get part ri (link-element-tag e))])
|
||
(and v (vector-ref v 1))))))
|
||
null))
|
||
|
||
(define/private (t-encode s)
|
||
(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-flow p part ri starting-item? [wrap-each? #f])
|
||
(if (null? p)
|
||
null
|
||
(begin
|
||
(when wrap-each? (printf "{"))
|
||
(render-block (car p) part ri starting-item?)
|
||
(when wrap-each? (printf "}"))
|
||
(for ([b (in-list (cdr p))])
|
||
(if wrap-each?
|
||
(printf "%\n{")
|
||
(printf "\n\n"))
|
||
(render-block b part ri #f)
|
||
(when wrap-each? (printf "}")))
|
||
null)))
|
||
|
||
(define/override (render-table t part ri starting-item?)
|
||
(render-table* t part ri starting-item? "[t]"))
|
||
|
||
(define/private (render-table* t part ri starting-item? alignment)
|
||
(let* ([s-name (style-name (table-style t))]
|
||
[boxed? (eq? 'boxed s-name)]
|
||
[index? (eq? 'index s-name)]
|
||
[tableform
|
||
(cond [index? "list"]
|
||
[(eq? 'block s-name) "tabular"]
|
||
[(not (current-table-mode)) "bigtabular"]
|
||
[else "tabular"])]
|
||
[opt (cond [(equal? tableform "bigtabular") ""]
|
||
[(equal? tableform "tabular") alignment]
|
||
[else ""])]
|
||
[blockss (if index? (cddr (table-blockss t)) (table-blockss t))]
|
||
[cell-styless (extract-table-cell-styles t)]
|
||
[twidth (if (null? (table-blockss t))
|
||
1
|
||
(length (car (table-blockss t))))]
|
||
[single-column? (and (= 1 twidth)
|
||
(or (not s-name) (string? s-name))
|
||
(not (ormap (lambda (cell-styles)
|
||
(ormap (lambda (s)
|
||
(or (string? (style-name s))
|
||
(let ([l (style-properties s)])
|
||
(or (memq 'right l)
|
||
(memq 'center l)))))
|
||
cell-styles))
|
||
cell-styless))
|
||
(not (current-table-mode)))]
|
||
[inline?
|
||
(and (not single-column?)
|
||
(not boxed?)
|
||
(not index?)
|
||
(ormap (lambda (rs)
|
||
(ormap (lambda (cs) (style-name cs)) rs))
|
||
cell-styless)
|
||
(= 1 twidth)
|
||
(let ([m (current-table-mode)])
|
||
(and m
|
||
(equal? "bigtabular" (car m))
|
||
(= 1 (length (car (table-blockss (cadr m))))))))])
|
||
(if single-column?
|
||
(begin
|
||
(when (string? s-name)
|
||
(printf "\\begin{~a}" s-name))
|
||
(do-render-nested-flow
|
||
(make-nested-flow (make-style "SingleColumn" null) (map car (table-blockss t)))
|
||
part
|
||
ri
|
||
#t
|
||
#f
|
||
#f)
|
||
(when (string? s-name)
|
||
(printf "\\end{~a}" s-name)))
|
||
(unless (or (null? blockss) (null? (car blockss)))
|
||
(define all-left-line?s
|
||
(if (null? cell-styless)
|
||
null
|
||
(for/list ([i (in-range (length (car cell-styless)))])
|
||
(for/and ([cell-styles (in-list cell-styless)])
|
||
(let ([cell-style (list-ref cell-styles i)])
|
||
(or (memq 'left-border (style-properties cell-style))
|
||
(memq 'border (style-properties cell-style))))))))
|
||
(define all-right-line?
|
||
(and (pair? cell-styless)
|
||
(let ([i (sub1 (length (car cell-styless)))])
|
||
(for/and ([cell-styles (in-list cell-styless)])
|
||
(let ([cell-style (list-ref cell-styles i)])
|
||
(or (memq 'right-border (style-properties cell-style))
|
||
(memq 'border (style-properties cell-style))))))))
|
||
(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)]
|
||
[single-column? (printf "\\begin{tabbing}\n")]
|
||
[else
|
||
(printf "~a~a\\begin{~a}~a{@{~a}~a}\n~a"
|
||
(if (and starting-item? (equal? tableform "bigtabular"))
|
||
"\\bigtableinlinecorrect"
|
||
"")
|
||
(if (string? s-name)
|
||
(format "\\begin{~a}" s-name)
|
||
"")
|
||
tableform
|
||
opt
|
||
(if (equal? tableform "bigtabular")
|
||
"\\bigtableleftpad"
|
||
"")
|
||
(string-append*
|
||
(let ([l
|
||
(map (lambda (i cell-style left-line?)
|
||
(format "~a~a@{}"
|
||
(if left-line? "|@{}" "")
|
||
(cond
|
||
[(memq 'center (style-properties cell-style)) "c"]
|
||
[(memq 'right (style-properties cell-style)) "r"]
|
||
[else "l"])))
|
||
(car blockss)
|
||
(car cell-styless)
|
||
all-left-line?s)])
|
||
(let ([l (if all-right-line? (append l '("|")) l)])
|
||
(if boxed? (cons "@{\\SBoxedLeft}" l) l))))
|
||
"")])
|
||
;; Helper to add row-separating lines:
|
||
(define (add-clines prev-styles next-styles)
|
||
(let loop ([pos 1] [start #f] [prev-styles prev-styles] [next-styles next-styles])
|
||
(cond
|
||
[(or (and prev-styles (null? prev-styles))
|
||
(and next-styles (null? next-styles)))
|
||
(when start
|
||
(if (= start 1)
|
||
(printf "\\hline ")
|
||
(printf "\\cline{~a-~a}" start (sub1 pos))))]
|
||
[else
|
||
(define prev-style (and prev-styles (car prev-styles)))
|
||
(define next-style (and next-styles (car next-styles)))
|
||
(define line? (or (and prev-style
|
||
(or (memq 'bottom-border (style-properties prev-style))
|
||
(memq 'border (style-properties prev-style))))
|
||
(and next-style
|
||
(or (memq 'top-border (style-properties next-style))
|
||
(memq 'border (style-properties next-style))))))
|
||
(when (and start (not line?))
|
||
(printf "\\cline{~a-~a}" start (sub1 pos)))
|
||
(loop (add1 pos) (and line? (or start pos))
|
||
(and prev-styles (cdr prev-styles))
|
||
(and next-styles (cdr next-styles)))])))
|
||
;; Loop through rows:
|
||
(let loop ([blockss blockss]
|
||
[cell-styless cell-styless]
|
||
[prev-styles #f]) ; for 'bottom-border styles
|
||
(let ([flows (car blockss)]
|
||
[cell-styles (car cell-styless)])
|
||
(unless index? (add-clines prev-styles cell-styles))
|
||
(let loop ([flows flows]
|
||
[cell-styles cell-styles]
|
||
[all-left-line?s all-left-line?s]
|
||
[need-left? #f])
|
||
(unless (null? flows)
|
||
(define (render-cell cnt)
|
||
(render-table-cell (car flows) part ri (/ twidth cnt) (car cell-styles) (not index?)))
|
||
(define right-line?
|
||
(cond
|
||
[index?
|
||
(printf "\n\\item ")
|
||
(render-cell 1)
|
||
#f]
|
||
[(eq? 'cont (car flows))
|
||
#f]
|
||
[else
|
||
(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))
|
||
(when (and (not (car all-left-line?s))
|
||
(or need-left?
|
||
(memq 'left-border (style-properties (car cell-styles)))
|
||
(memq 'border (style-properties (car cell-styles)))))
|
||
(printf "\\vline "))
|
||
(render-cell cnt)
|
||
(define right-line? (or (memq 'right-border (style-properties (list-ref cell-styles (sub1 cnt))))
|
||
(memq 'border (style-properties (list-ref cell-styles (sub1 cnt))))))
|
||
(when (and right-line? (null? (list-tail flows cnt)) (not all-right-line?))
|
||
(printf "\\vline "))
|
||
(unless (= cnt 1) (printf "}"))
|
||
(unless (null? (list-tail flows cnt))
|
||
(printf " &\n"))
|
||
right-line?)]))
|
||
(unless (null? (cdr flows)) (loop (cdr flows)
|
||
(cdr cell-styles)
|
||
(cdr all-left-line?s)
|
||
right-line?))))
|
||
(unless (or index?
|
||
(and (null? (cdr blockss))
|
||
(not (for/or ([cell-style (in-list cell-styles)])
|
||
(or (memq 'bottom-border (style-properties cell-style))
|
||
(memq 'border (style-properties cell-style)))))))
|
||
(printf " \\\\\n"))
|
||
(cond
|
||
[(null? (cdr blockss))
|
||
(unless index? (add-clines cell-styles #f))]
|
||
[else
|
||
(loop (cdr blockss) (cdr cell-styless) cell-styles)])))
|
||
(unless inline?
|
||
(printf "\\end{~a}~a"
|
||
tableform
|
||
(if (string? s-name)
|
||
(format "\\end{~a}" s-name)
|
||
"")))))))
|
||
null)
|
||
|
||
(define/private (render-table-cell p part ri twidth vstyle can-box?)
|
||
(let* ([top? (or (memq 'top (style-properties vstyle))
|
||
(memq 'baseline (style-properties vstyle)))]
|
||
[bottom? (and (not top?)
|
||
(memq 'bottom (style-properties vstyle)))]
|
||
[center? (and (not bottom?)
|
||
(not top?))]
|
||
[as-box? (and can-box? (boxable? p))])
|
||
(when (string? (style-name vstyle))
|
||
(printf "\\~a{" (style-name vstyle)))
|
||
(let ([minipage? (and can-box? (not as-box?))])
|
||
(when minipage?
|
||
(printf "\\begin{minipage}~a{~a\\linewidth}\n"
|
||
(cond
|
||
[top? "[t]"]
|
||
[center? "[c]"]
|
||
[else ""])
|
||
(/ 1.0 twidth)))
|
||
(cond
|
||
[(table? p)
|
||
(render-table* p part ri #f (cond
|
||
[top? "[t]"]
|
||
[center? "[c]"]
|
||
[else "[b]"]))]
|
||
[as-box?
|
||
(render-boxable-block p part ri (cond
|
||
[top? 't]
|
||
[center? 'c]
|
||
[else 'b]))]
|
||
[else
|
||
(render-block p part ri #f)])
|
||
(when minipage?
|
||
(printf " \\end{minipage}\n")))
|
||
(when (string? (style-name vstyle))
|
||
(printf "}"))
|
||
null))
|
||
|
||
(define/private (boxable? p)
|
||
(or (and (table? p)
|
||
(for* ([l (in-list (table-blockss p))]
|
||
[p (in-list l)])
|
||
(boxable? p)))
|
||
(and (nested-flow? p)
|
||
(or (and (= 1 (length (nested-flow-blocks p)))
|
||
(memq (style-name (nested-flow-style p))
|
||
'(code-inset vertical-inset)))
|
||
(and
|
||
(ormap box-mode? (style-properties (nested-flow-style p)))
|
||
(andmap (lambda (p) (boxable? p)) (nested-flow-blocks p)))))
|
||
(and (paragraph? p)
|
||
(or (not (style-name (paragraph-style p)))
|
||
(ormap box-mode? (style-properties (paragraph-style p)))))))
|
||
|
||
(define/private (render-boxable-block p part ri mode)
|
||
(cond
|
||
[(table? p)
|
||
(render-table* p part ri #f (format "[~a]" mode))]
|
||
[(nested-flow? p)
|
||
(do-render-nested-flow p part ri #f mode #f)]
|
||
[(paragraph? p)
|
||
(do-render-paragraph p part ri #f mode)]))
|
||
|
||
(define/private (box-mode-selector as-box-mode)
|
||
(case as-box-mode
|
||
[(t) box-mode-top-name]
|
||
[(c) box-mode-center-name]
|
||
[(b) box-mode-bottom-name]))
|
||
|
||
(define/override (render-itemization t part ri)
|
||
(let* ([style-str (let ([s (style-name (itemization-style t))])
|
||
(if (eq? s 'compact)
|
||
"compact"
|
||
s))]
|
||
[mode (or (and (string? style-str)
|
||
style-str)
|
||
(if (eq? 'ordered style-str)
|
||
"enumerate"
|
||
"itemize"))])
|
||
(printf "\\begin{~a}\\atItemizeStart" mode)
|
||
(for ([flow (in-list (itemization-blockss t))])
|
||
(printf "\n\n\\~a" (if (string? style-str)
|
||
(format "~aItem{" style-str)
|
||
"item "))
|
||
(render-flow flow part ri #t)
|
||
(when (string? style-str)
|
||
(printf "}")))
|
||
(printf "\\end{~a}" mode)
|
||
null))
|
||
|
||
(define/private (do-render-nested-flow t part ri single-column? as-box-mode show-pre?)
|
||
(let* ([props (style-properties (nested-flow-style t))]
|
||
[kind (or (and as-box-mode
|
||
(or
|
||
(ormap (lambda (a)
|
||
(and (box-mode? a)
|
||
((box-mode-selector as-box-mode) a)))
|
||
props)
|
||
(case (style-name (nested-flow-style t))
|
||
[(code-inset) "SCodeInsetBox"]
|
||
[(vertical-inset) "SVInsetBox"]
|
||
[else (error "unexpected style for box mode")])))
|
||
(let ([s (style-name (nested-flow-style t))])
|
||
(or (and (string? s) s)
|
||
(and (eq? s 'inset) "SInsetFlow")
|
||
(and (eq? s 'code-inset) "SCodeFlow")
|
||
(and (eq? s 'vertical-inset) "SVInsetFlow")))
|
||
"Subflow")]
|
||
[multicommand? (memq 'multicommand props)]
|
||
[command? (or (and as-box-mode (not multicommand?))
|
||
(memq 'command props))])
|
||
(unless (and (not show-pre?)
|
||
(member 'pretitle props))
|
||
(cond
|
||
[command? (printf "\\~a{" kind)]
|
||
[multicommand? (printf "\\~a" kind)]
|
||
[else (printf "\\begin{~a}" kind)])
|
||
(parameterize ([current-table-mode (if (or single-column?
|
||
(not (current-table-mode)))
|
||
(current-table-mode)
|
||
(list "nested-flow" t))])
|
||
(if as-box-mode
|
||
(for-each (lambda (p)
|
||
(when multicommand? (printf "{"))
|
||
(render-boxable-block p part ri as-box-mode)
|
||
(when multicommand? (printf "}")))
|
||
(nested-flow-blocks t))
|
||
(render-flow (nested-flow-blocks t) part ri #f multicommand?)))
|
||
(cond
|
||
[command? (printf "}")]
|
||
[multicommand? (void)]
|
||
[else (printf "\\end{~a}" kind)])
|
||
null)))
|
||
|
||
(define/override (render-nested-flow t part ri starting-item?)
|
||
(do-render-nested-flow t part ri #f #f #f))
|
||
|
||
(define/override (render-compound-paragraph t part ri starting-item?)
|
||
(let ([kind (style-name (compound-paragraph-style t))]
|
||
[command? (memq 'command (style-properties (compound-paragraph-style t)))])
|
||
(when kind
|
||
(if command?
|
||
(printf "\\~a{" kind)
|
||
(printf "\\begin{~a}" kind)))
|
||
(super render-compound-paragraph t part ri starting-item?)
|
||
(when kind
|
||
(if command?
|
||
(printf "}")
|
||
(printf "\\end{~a}" 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) "{'}"]
|
||
[(lsquo) "{`}"]
|
||
[(prime) "$'$"]
|
||
[(rarr) "$\\rightarrow$"]
|
||
[(larr) "$\\leftarrow$"]
|
||
[(alpha) "$\\alpha$"]
|
||
[(infin) "$\\infty$"]
|
||
[(lang) "$\\langle$"]
|
||
[(rang) "$\\rangle$"]
|
||
[else (error 'render "unknown symbol element: ~e" i)]))]
|
||
[else (display-protected (format "~s" i))])
|
||
null)
|
||
|
||
(define/override (string-to-implicit-styles e)
|
||
(for/fold ([ses null]) ([ch (in-string e)])
|
||
(case ch
|
||
[(#\☠) (cons skull-style ses)]
|
||
[else ses])))
|
||
|
||
(define/private (display-protected s)
|
||
(define rtt (rendering-tt))
|
||
(define convs (extra-character-conversions))
|
||
(cond
|
||
[(eq? rtt 'exact)
|
||
(display s)]
|
||
[(eq? rtt 'url)
|
||
(for ([c (in-string s)])
|
||
(case c
|
||
[(#\%) (display "\\%")]
|
||
[(#\#) (display "\\#")]
|
||
[(#\\) (display "\\%5c")]
|
||
[(#\{) (display "\\%7b")]
|
||
[(#\}) (display "\\%7d")]
|
||
[else (display c)]))]
|
||
[else
|
||
;; Start by normalizing to "combined" form, so that Racket characters
|
||
;; are closer to Unicode characters (e.g., ä is one character, instead
|
||
;; of a combining character followed by "a").
|
||
(let ([s (string-normalize-nfc s)])
|
||
(let ([len (string-length s)])
|
||
(let loop ([i 0])
|
||
(unless (= i len)
|
||
(display
|
||
(let char-loop ([c (string-ref s i)])
|
||
(case c
|
||
[(#\\) (if (rendering-tt)
|
||
"{\\char`\\\\}"
|
||
"$\\backslash$")]
|
||
[(#\_) (if (rendering-tt)
|
||
"{\\char`\\_}"
|
||
"$\\_$")]
|
||
[(#\^) "{\\char'136}"]
|
||
[(#\>) (if (rendering-tt) "{\\Stttextmore}" "$>$")]
|
||
[(#\<) (if (rendering-tt) "{\\Stttextless}" "$<$")]
|
||
[(#\|) (if (rendering-tt) "{\\Stttextbar}" "$|$")]
|
||
[(#\-) "{-}"] ;; avoid en- or em-dash
|
||
[(#\`) "{\\textasciigrave}"]
|
||
[(#\') "{\\textquotesingle}"]
|
||
[(#\? #\! #\. #\:)
|
||
(if (rendering-tt) (format "{\\hbox{\\texttt{~a}}}" c) c)]
|
||
[(#\~) "$\\sim$"]
|
||
[(#\{ #\}) (if (rendering-tt)
|
||
(format "{\\char`\\~a}" c)
|
||
(format "\\~a" c))]
|
||
[(#\[ #\]) (if (escape-brackets)
|
||
(if (eq? c #\[)
|
||
"{\\SOpenSq}"
|
||
"{\\SCloseSq}")
|
||
c)]
|
||
[(#\# #\% #\& #\$) (format "\\~a" c)]
|
||
[(#\uA0) "~"] ; non-breaking space
|
||
[(#\uAD) "\\-"] ; soft hyphen; unfortunately, also disables auto-hyphen
|
||
[(#\uDF) "{\\ss}"]
|
||
[else
|
||
(if ((char->integer c) . > . 127)
|
||
;; first, try user-defined conversions
|
||
(or (convs c)
|
||
;; latex-prefix.rkt enables utf8 input, but this does not work for
|
||
;; all the characters below (e.g. ∞). Some parts of the table
|
||
;; below are therefore necessary, but some parts probably are not.
|
||
;; Which parts are necessary may depend on the latex version,
|
||
;; though, so we keep this table around to avoid regressions.
|
||
(case c
|
||
[(#\╔ #\═ #\╗ #\║ #\╚ #\╝ #\╦ #\╠ #\╣ #\╬ #\╩) (box-character c)]
|
||
[(#\┌ #\─ #\┐ #\│ #\└ #\┘ #\┬ #\├ #\┤ #\┼ #\┴) (box-character c)]
|
||
[(#\┏ #\━ #\┓ #\┃ #\┗ #\┛ #\┳ #\┣ #\┫ #\╋ #\┻) (box-character c 2)]
|
||
[(#\u2011) "\\mbox{-}"] ; non-breaking hyphen
|
||
[(#\uB0) "$^{\\circ}$"] ; degree
|
||
[(#\uB2) "$^2$"]
|
||
[(#\u039A) "K"] ; kappa
|
||
[(#\u0391) "A"] ; alpha
|
||
[(#\u039F) "O"] ; omicron
|
||
[(#\u03A3) "$\\Sigma$"]
|
||
[(#\u03BA) "$\\kappa$"]
|
||
[(#\u03B1) "$\\alpha$"]
|
||
[(#\u03B2) "$\\beta$"]
|
||
[(#\u03B3) "$\\gamma$"]
|
||
[(#\u03BF) "o"] ; omicron
|
||
[(#\u03C3) "$\\sigma$"]
|
||
[(#\u03C2) "$\\varsigma$"]
|
||
[(#\u03BB) "$\\lambda$"]
|
||
[(#\u039B) "$\\Lambda$"]
|
||
[(#\u03BC) "$\\mu$"]
|
||
[(#\u03C0) "$\\pi$"]
|
||
[(#\‘) "{`}"]
|
||
[(#\’) "{'}"]
|
||
[(#\“) "{``}"]
|
||
[(#\”) "{''}"]
|
||
[(#\u2013) "{--}"]
|
||
[(#\u2014) "{---}"]
|
||
[(#\⟨ #\〈) "$\\langle$"] ; [MATHEMATICAL] LEFT ANGLE BRACKET
|
||
[(#\⟩ #\〉) "$\\rangle$"] ; [MATHEMATICAL] RIGHT ANGLE BRACKET
|
||
[(#\∞) "$\\infty$"]
|
||
[(#\⇓) "$\\Downarrow$"]
|
||
[(#\↖) "$\\nwarrow$"]
|
||
[(#\↓) "$\\downarrow$"]
|
||
[(#\⇒) "$\\Rightarrow$"]
|
||
[(#\→) "$\\rightarrow$"]
|
||
[(#\↘) "$\\searrow$"]
|
||
[(#\↙) "$\\swarrow$"]
|
||
[(#\←) "$\\leftarrow$"]
|
||
[(#\↑) "$\\uparrow$"]
|
||
[(#\⇐) "$\\Leftarrow$"]
|
||
[(#\−) "$\\longrightarrow$"]
|
||
[(#\⇑) "$\\Uparrow$"]
|
||
[(#\⇔) "$\\Leftrightarrow$"]
|
||
[(#\↕) "$\\updownarrow$"]
|
||
[(#\↔) "$\\leftrightarrow$"]
|
||
[(#\↗) "$\\nearrow$"]
|
||
[(#\↝) "$\\leadsto$"]
|
||
[(#\↱) "$\\Lsh$"]
|
||
[(#\↰) "$\\Rsh$"]
|
||
[(#\⇕) "$\\Updownarrow$"]
|
||
[(#\א) "$\\aleph$"]
|
||
[(#\′) "$\\prime$"]
|
||
[(#\∅) "$\\emptyset$"]
|
||
[(#\∇) "$\\nabla$"]
|
||
[(#\♦) "$\\diamondsuit$"]
|
||
[(#\♠) "$\\spadesuit$"]
|
||
[(#\♣) "$\\clubsuit$"]
|
||
[(#\♥) "$\\heartsuit$"]
|
||
[(#\♯) "$\\sharp$"]
|
||
[(#\♭) "$\\flat$"]
|
||
[(#\♮) "$\\natural$"]
|
||
[(#\√) "$\\surd$"]
|
||
[(#\∆) "$\\Delta$"] ; no better mapping for than \Delta for "increment"
|
||
[(#\u2211) "$\\sum$"] ; better than \Sigma, right?
|
||
[(#\u220F) "$\\prod$"] ; better than \Pi, right?
|
||
[(#\u2210) "$\\coprod$"]
|
||
[(#\u222B) "$\\int$"]
|
||
[(#\u222E) "$\\oint$"]
|
||
[(#\¬) "$\\neg$"]
|
||
[(#\△) "$\\triangle$"]
|
||
[(#\∀) "$\\forall$"]
|
||
[(#\∃) "$\\exists$"]
|
||
[(#\∘) "$\\circ$"]
|
||
[(#\θ) "$\\theta$"]
|
||
[(#\ϑ) "$\\vartheta$"]
|
||
[(#\τ) "$\\tau$"]
|
||
[(#\υ) "$\\upsilon$"]
|
||
[(#\φ) "$\\varphi$"]
|
||
[(#\ϕ) "$\\phi$"]
|
||
[(#\δ) "$\\delta$"]
|
||
[(#\ρ) "$\\rho$"]
|
||
[(#\ϱ) "$\\varrho$"]
|
||
[(#\ϵ) "$\\epsilon$"]
|
||
[(#\ε) "$\\varepsilon$"]
|
||
[(#\ϖ) "$\\varpi$"]
|
||
[(#\χ) "$\\chi$"]
|
||
[(#\ψ) "$\\psi$"]
|
||
[(#\ζ) "$\\zeta$"]
|
||
[(#\ν) "$\\nu$"]
|
||
[(#\ω) "$\\omega$"]
|
||
[(#\η) "$\\eta$"]
|
||
[(#\ι) "$\\iota$"]
|
||
[(#\ξ) "$\\xi$"]
|
||
[(#\Γ) "$\\Gamma$"]
|
||
[(#\Ψ) "$\\Psi$"]
|
||
[(#\Δ) "$\\Delta$"]
|
||
[(#\Ξ) "$\\Xi$"]
|
||
[(#\Υ) "$\\Upsilon$"]
|
||
[(#\Ω) "$\\Omega$"]
|
||
[(#\Θ) "$\\Theta$"]
|
||
[(#\Π) "$\\Pi$"]
|
||
[(#\Φ) "$\\Phi$"]
|
||
[(#\±) "$\\pm$"]
|
||
[(#\∩) "$\\cap$"]
|
||
[(#\◇) "$\\diamond$"]
|
||
[(#\⊕) "$\\oplus$"]
|
||
[(#\∓) "$\\mp$"]
|
||
[(#\∪) "$\\cup$"]
|
||
[(#\△) "$\\bigtriangleup$"]
|
||
[(#\⊖) "$\\ominus$"]
|
||
[(#\×) "$\\times$"]
|
||
[(#\⊎) "$\\uplus$"]
|
||
[(#\▽) "$\\bigtriangledown$"]
|
||
[(#\⊗) "$\\otimes$"]
|
||
[(#\÷) "$\\div$"]
|
||
[(#\⊓) "$\\sqcap$"]
|
||
[(#\▹) "$\\triangleleft$"]
|
||
[(#\⊘) "$\\oslash$"]
|
||
[(#\∗) "$\\ast$"]
|
||
[(#\⊔) "$\\sqcup$"]
|
||
[(#\∨) "$\\vee$"]
|
||
[(#\∧) "$\\wedge$"]
|
||
[(#\◃) "$\\triangleright$"]
|
||
[(#\◊) "$\\Diamond$"]
|
||
[(#\⊙) "$\\odot$"]
|
||
[(#\★) "$\\star$"]
|
||
[(#\†) "$\\dagger$"]
|
||
[(#\•) "$\\bullet$"]
|
||
[(#\‡) "$\\ddagger$"]
|
||
[(#\≀) "$\\wr$"]
|
||
[(#\⨿) "$\\amalg$"]
|
||
[(#\≤) "$\\leq$"]
|
||
[(#\≥) "$\\geq$"]
|
||
[(#\≡) "$\\equiv$"]
|
||
[(#\⊨) "$\\models$"]
|
||
[(#\≺) "$\\prec$"]
|
||
[(#\≻) "$\\succ$"]
|
||
[(#\∼) "$\\sim$"]
|
||
[(#\⊥) "$\\perp$"]
|
||
[(#\≼) "$\\preceq$"]
|
||
[(#\≽) "$\\succeq$"]
|
||
[(#\≃) "$\\simeq$"]
|
||
[(#\≪) "$\\ll$"]
|
||
[(#\≫) "$\\gg$"]
|
||
[(#\≍) "$\\asymp$"]
|
||
[(#\∥) "$\\parallel$"]
|
||
[(#\⊂) "$\\subset$"]
|
||
[(#\⊃) "$\\supset$"]
|
||
[(#\≈) "$\\approx$"]
|
||
[(#\⋈) "$\\bowtie$"]
|
||
[(#\⊆) "$\\subseteq$"]
|
||
[(#\⊇) "$\\supseteq$"]
|
||
[(#\≌) "$\\cong$"]
|
||
[(#\⊏) "$\\sqsubset$"]
|
||
[(#\⊐) "$\\sqsupset$"]
|
||
[(#\≠) "$\\neq$"]
|
||
[(#\⌣) "$\\smile$"]
|
||
[(#\⊑) "$\\sqsubseteq$"]
|
||
[(#\⊒) "$\\sqsupseteq$"]
|
||
[(#\≐) "$\\doteq$"]
|
||
[(#\⌢) "$\\frown$"]
|
||
[(#\∈) "$\\in$"]
|
||
[(#\∉) "$\\not\\in$"]
|
||
[(#\∋) "$\\ni$"]
|
||
[(#\∝) "$\\propto$"]
|
||
[(#\⊢) "$\\vdash$"]
|
||
[(#\⊣) "$\\dashv$"]
|
||
[(#\☠) "$\\skull$"]
|
||
[(#\☺) "$\\smiley$"]
|
||
[(#\☻) "$\\blacksmiley$"]
|
||
[(#\☹) "$\\frownie$"]
|
||
[(#\ø) "{\\o}"]
|
||
[(#\Ø) "{\\O}"]
|
||
[(#\ł) "{\\l}"]
|
||
[(#\Ł) "{\\L}"]
|
||
[(#\uA7) "{\\S}"]
|
||
[(#\⟦ #\〚) "$[\\![$"]
|
||
[(#\⟧ #\〛) "$]\\!]$"]
|
||
[(#\↦) "$\\mapsto$"]
|
||
[(#\⊤) "$\\top$"]
|
||
[(#\¥) "{\\textyen}"]
|
||
[(#\™) "{\\texttrademark}"]
|
||
[(#\®) "{\\textregistered}"]
|
||
[(#\©) "{\\textcopyright}"]
|
||
[(#\u2070) "$^0$"]
|
||
[(#\u00b9) "$^1$"]
|
||
[(#\u00b2) "$^2$"]
|
||
[(#\u00b3) "$^3$"]
|
||
[(#\u2074) "$^4$"]
|
||
[(#\u2075) "$^5$"]
|
||
[(#\u2076) "$^6$"]
|
||
[(#\u2077) "$^7$"]
|
||
[(#\u2078) "$^8$"]
|
||
[(#\u2079) "$^9$"]
|
||
[(#\u207a) "$^+$"]
|
||
[(#\u207b) "$^-$"]
|
||
[(#\⋖) "$\\precdot$"]
|
||
[(#\⋗) "$\\succdot$"]
|
||
[(#\⋮) "\\vdots"]
|
||
[(#\⋱) "$\\ddots$"]
|
||
[(#\⋯) "$\\cdots$"]
|
||
[(#\⋯) "\\hdots"]
|
||
[else
|
||
(cond
|
||
[(char<=? #\uAC00 c #\uD7AF) ; Korean Hangul
|
||
(format "\\begin{CJK}{UTF8}{mj}~a\\end{CJK}" c)]
|
||
[else
|
||
;; Detect characters that can be formed with combining characters
|
||
;; and translate them to Latex combinations:
|
||
(define s (string-normalize-nfd (string c)))
|
||
(define len (string-length s))
|
||
(cond
|
||
[(len . > . 1)
|
||
(define combiner (case (string-ref s (sub1 len))
|
||
[(#\u300) "\\`{~a}"]
|
||
[(#\u301) "\\'{~a}"]
|
||
[(#\u302) "\\^{~a}"]
|
||
[(#\u303) "\\~~{~a}"]
|
||
[(#\u304) "\\={~a}"]
|
||
[(#\u306) "\\u{~a}"]
|
||
[(#\u307) "\\.{~a}"]
|
||
[(#\u308) "\\\"{~a}"]
|
||
[(#\u30a) "\\r{~a}"]
|
||
[(#\u30b) "\\H{~a}"]
|
||
[(#\u30c) "\\v{~a}"]
|
||
[(#\u327) "\\c{~a}"]
|
||
[(#\u328) "\\k{~a}"]
|
||
[else #f]))
|
||
(define base (string-normalize-nfc (substring s 0 (sub1 len))))
|
||
(if (and combiner
|
||
(= 1 (string-length base)))
|
||
(format combiner (char-loop (string-ref base 0)))
|
||
c)]
|
||
[else c])])]))
|
||
c)])))
|
||
(loop (add1 i))))))]))
|
||
|
||
|
||
(define/private (box-character c [line-thickness 1])
|
||
(define (combine . args)
|
||
(apply string-append
|
||
"\\setlength{\\unitlength}{0.05em}"
|
||
(if (= line-thickness 1)
|
||
""
|
||
(format "\\linethickness{~apt}" (* 0.4 line-thickness)))
|
||
(filter (λ (x) (not (regexp-match #rx"^[ \n]*$" x)))
|
||
(flatten args))))
|
||
(define (adjust % v)
|
||
(define num (* % (/ v 10) 10))
|
||
(define i-part (floor num))
|
||
(define d-part (floor (* 10 (- num i-part))))
|
||
(format "~a.~a" i-part d-part))
|
||
(define (x v) (adjust 1 v))
|
||
(define (y v) (adjust 6/4 v))
|
||
(define upper-horizontal @list{\put(@x[0],@y[6]){\line(1,0){@x[10]}}})
|
||
(define mid-horizontal @list{\put(@x[0],@y[5]){\line(1,0){@x[10]}}})
|
||
(define lower-horizontal @list{\put(@x[0],@y[4]){\line(1,0){@x[10]}}})
|
||
(define righter-vertical @list{\put(@x[6],@y[10]){\line(0,-1){@y[10]}}})
|
||
(define mid-vertical @list{\put(@x[5],@y[10]){\line(0,-1){@y[10]}}})
|
||
(define lefter-vertical @list{\put(@x[4],@y[10]){\line(0,-1){@y[10]}}})
|
||
(define bottom-right @list{\put(@x[6],@y[4]){\line(1,0){@x[4]}}
|
||
\put(@x[6],@y[0]){\line(0,1){@y[4]}}})
|
||
(define bottom-left @list{\put(@x[0],@y[4]){\line(1,0){@x[4]}}
|
||
\put(@x[4],@y[0]){\line(0,1){@y[4]}}})
|
||
(define upper-right @list{\put(@x[6],@y[6]){\line(1,0){@x[4]}}
|
||
\put(@x[6],@y[10]){\line(0,-1){@y[4]}}})
|
||
(define upper-left @list{\put(@x[0],@y[6]){\line(1,0){@x[4]}}
|
||
\put(@x[4],@y[10]){\line(0,-1){@y[4]}}})
|
||
(define header @list{\begin{picture}(@x[10],@y[10])(0,0)})
|
||
(define footer @list{\end{picture}})
|
||
|
||
(case c
|
||
[(#\╔)
|
||
@combine{@header
|
||
\put(@x[4],@y[6]){\line(1,0){@x[6]}}
|
||
\put(@x[4],@y[0]){\line(0,1){@y[6]}}
|
||
@bottom-right
|
||
@footer}]
|
||
[(#\═) @combine{@header
|
||
@upper-horizontal
|
||
@lower-horizontal
|
||
@footer}]
|
||
[(#\╗) @combine{@header
|
||
\put(@x[0],@y[6]){\line(1,0){@x[6]}}
|
||
\put(@x[6],@y[0]){\line(0,1){@y[6]}}
|
||
@bottom-left
|
||
@footer}]
|
||
[(#\║) @combine{@header
|
||
@lefter-vertical
|
||
@righter-vertical
|
||
@footer}]
|
||
[(#\╚) @combine{@header
|
||
@upper-right
|
||
\put(@x[4],@y[4]){\line(1,0){@x[6]}}
|
||
\put(@x[4],@y[10]){\line(0,-1){@y[6]}}
|
||
@footer}]
|
||
[(#\╝)
|
||
@combine{@header
|
||
@upper-left
|
||
\put(@x[0],@y[4]){\line(1,0){@x[6]}}
|
||
\put(@x[6],@y[10]){\line(0,-1){@y[6]}}
|
||
@footer}]
|
||
[(#\╣)
|
||
@combine{@header
|
||
@upper-left
|
||
@bottom-left
|
||
@righter-vertical
|
||
@footer}]
|
||
[(#\╠)
|
||
@combine{@header
|
||
@upper-right
|
||
@bottom-right
|
||
@lefter-vertical
|
||
@footer}]
|
||
[(#\╩)
|
||
@combine{@header
|
||
@upper-right
|
||
@upper-left
|
||
@lower-horizontal
|
||
@footer}]
|
||
[(#\╦)
|
||
@combine{@header
|
||
@bottom-right
|
||
@bottom-left
|
||
@upper-horizontal
|
||
@footer}]
|
||
[(#\╬)
|
||
@combine{@header
|
||
@upper-left
|
||
@bottom-left
|
||
@upper-right
|
||
@bottom-right
|
||
@footer}]
|
||
[(#\┌ #\┏)
|
||
@combine{@header
|
||
\put(@x[5],@y[5]){\line(1,0){@x[5]}}
|
||
\put(@x[5],@y[0]){\line(0,1){@y[5]}}
|
||
@footer}]
|
||
[(#\─ #\━) @combine{@header
|
||
@mid-horizontal
|
||
@footer}]
|
||
[(#\┐ #\┓) @combine{@header
|
||
\put(@x[0],@y[5]){\line(1,0){@x[5]}}
|
||
\put(@x[5],@y[0]){\line(0,1){@y[5]}}
|
||
@footer}]
|
||
[(#\│ #\┃) @combine{@header
|
||
@mid-vertical
|
||
@footer}]
|
||
[(#\└ #\┗) @combine{@header
|
||
\put(@x[5],@y[5]){\line(1,0){@x[5]}}
|
||
\put(@x[5],@y[10]){\line(0,-1){@y[5]}}
|
||
@footer}]
|
||
[(#\┘ #\┛)
|
||
@combine{@header
|
||
\put(@x[0],@y[5]){\line(1,0){@x[5]}}
|
||
\put(@x[5],@y[10]){\line(0,-1){@y[5]}}
|
||
@footer}]
|
||
[(#\┤ #\┫)
|
||
@combine{@header
|
||
\put(@x[0],@y[5]){\line(1,0){@x[5]}}
|
||
@mid-vertical
|
||
@footer}]
|
||
[(#\├ #\┣)
|
||
@combine{@header
|
||
\put(@x[5],@y[5]){\line(1,0){@x[5]}}
|
||
@mid-vertical
|
||
@footer}]
|
||
[(#\┴ #\┻)
|
||
@combine{@header
|
||
\put(@x[5],@y[10]){\line(0,-1){@y[5]}}
|
||
@mid-horizontal
|
||
@footer}]
|
||
[(#\┬ #\┳)
|
||
@combine{@header
|
||
\put(@x[5],@y[5]){\line(0,-1){@y[5]}}
|
||
@mid-horizontal
|
||
@footer}]
|
||
[(#\┼ #\╋)
|
||
@combine{@header
|
||
@mid-horizontal
|
||
@mid-vertical
|
||
@footer}]))
|
||
|
||
;; ----------------------------------------
|
||
|
||
(define/override (table-of-contents sec ri)
|
||
;; FIXME: isn't local to the section
|
||
(make-toc-paragraph plain null))
|
||
|
||
(define/override (local-table-of-contents part ri style)
|
||
(make-paragraph plain null))))
|