#lang at-exp racket/base (require "core.rkt" "latex-properties.rkt" "private/render-utils.rkt" "private/latex-index.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 multiple-page-references (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 (and (part-title-content d) (not (and (part-style? d 'hidden) (equal? "" (content->string (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 [(emph) (wrap e "emph" tt?)] [(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))) (define (make-ref e) (string-append "t:" (t-encode (let ([v (resolve-get part ri (link-element-tag e))]) (and v (vector-ref v 1)))))) (cond [(multiple-page-references) ; for index => (lambda (l) (printf ", \\Smanypageref{~a}" ; using cleveref (string-join (map make-ref l) ",")))] [else (printf ", \\pageref{~a}" (make-ref e))])) 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)] [merge-index? (let loop ([part part]) (or (memq 'enable-index-merge (style-properties (part-style part))) (let* ([ci (part-collected-info part ri)] [p (and ci (collected-info-parent ci))]) (and p (loop p)))))] [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)) (define group-size (cond [merge-index? ;; Merge entries that have the same text & style (let loop ([blockss (cdr blockss)] [group-size 1]) (cond [(null? blockss) group-size] [(same-index-entry? flows (car blockss)) (loop (cdr blockss) (add1 group-size))] [else group-size]))] [else 1])) (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 ") (parameterize ([multiple-page-references (and (group-size . > . 1) (extract-index-link-targets (take blockss group-size)))]) (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?)))) (define rest-blockss (list-tail blockss group-size)) (unless (or index? (and (null? rest-blockss) (not (for/or ([cell-style (in-list cell-styles)]) (or (memq 'bottom-border (style-properties cell-style)) (memq 'border (style-properties cell-style))))))) (let ([row-skip (for/or ([cell-style (in-list cell-styles)]) (for/or ([prop (style-properties cell-style)]) (and (table-row-skip? prop) prop)))]) (printf " \\\\~a\n" (if row-skip (format "[~a]" (table-row-skip-amount row-skip)) "")))) (cond [(null? rest-blockss) (unless index? (add-clines cell-styles #f))] [else (loop rest-blockss (list-tail cell-styless group-size) 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$"] [(#\₀) "$_0$"] [(#\₁) "$_1$"] [(#\₂) "$_2$"] [(#\₃) "$_3$"] [(#\₄) "$_4$"] [(#\₅) "$_5$"] [(#\₆) "$_6$"] [(#\₇) "$_7$"] [(#\₈) "$_8$"] [(#\₉) "$_9$"] [(#\‘) "{`}"] [(#\’) "{'}"] [(#\“) "{``}"] [(#\”) "{''}"] [(#\u2013) "{--}"] [(#\u2014) "{---}"] [(#\⟨ #\〈) "$\\langle$"] ; [MATHEMATICAL] LEFT ANGLE BRACKET [(#\⟩ #\〉) "$\\rangle$"] ; [MATHEMATICAL] RIGHT ANGLE BRACKET [(#\∞) "$\\infty$"] [(#\⇓) "$\\Downarrow$"] [(#\↖) "$\\nwarrow$"] [(#\↓) "$\\downarrow$"] [(#\⇒) "$\\Rightarrow$"] [(#\→) "$\\rightarrow$"] [(#\⟶) "$\\longrightarrow$"] [(#\↘) "$\\searrow$"] [(#\↙) "$\\swarrow$"] [(#\←) "$\\leftarrow$"] [(#\↑) "$\\uparrow$"] [(#\⇐) "$\\Leftarrow$"] [(#\−) "$\\longrightarrow$"] [(#\⇑) "$\\Uparrow$"] [(#\⇔) "$\\Leftrightarrow$"] [(#\↕) "$\\updownarrow$"] [(#\↔) "$\\leftrightarrow$"] [(#\↗) "$\\nearrow$"] [(#\↝) "$\\leadsto$"] [(#\↱) "$\\Lsh$"] [(#\↰) "$\\Rsh$"] [(#\⇀) "$\\rightharpoonup$"] [(#\↼) "$\\leftharpoonup$"] [(#\⇁) "$\\rightharpoondown$"] [(#\↽) "$\\leftharpoondown$"] [(#\⇌) "$\\rightleftharpoons$"] [(#\⇕) "$\\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$"] [(#\∂) "$\\partial$"] [(#\θ) "$\\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"] [(#\⊸) "$\\multimap$"] [(#\⟜) "$\\multimapinv$"] [(#\⅋) "$\\invamp$"] [(#\□) "$\\square$"] [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))))