1#lang at-exp racket/base
2(require "core.rkt"
3         "latex-properties.rkt"
4         "private/render-utils.rkt"
5         "private/latex-index.rkt"
6         racket/class
7         racket/runtime-path
8         racket/port
9         racket/string
10         racket/path
11         racket/list
12         setup/collects
13         file/convertible)
14(provide render-mixin
15         make-render-part-mixin
16         extra-character-conversions)
17
18(define current-table-mode (make-parameter #f))
19(define rendering-tt (make-parameter #f))
20(define show-link-page-numbers (make-parameter #f))
21(define done-link-page-numbers (make-parameter #f))
22(define multiple-page-references (make-parameter #f))
23(define disable-images (make-parameter #f))
24(define escape-brackets (make-parameter #f))
25(define suppress-newline-content (make-parameter #f))
26(define disable-hyperref (make-parameter #f))
27
28(define-struct (toc-paragraph paragraph) ())
29
30(define-runtime-path scribble-prefix-tex "scribble-prefix.tex")
31(define-runtime-path scribble-packages-tex "scribble-packages.tex")
32(define-runtime-path scribble-load-tex "scribble-load.tex")
33(define-runtime-path scribble-tex "scribble.tex")
34(define-runtime-path scribble-style-tex "scribble-style.tex")
35(define-runtime-path scribble-load-replace-tex "scribble-load-replace.tex")
36
37(define (color->string c)
38  (if (string? c)
39      c
40      (format "~a,~a,~a"
41              (/ (car c) 255.0)
42              (/ (cadr c) 255.0)
43              (/ (caddr c) 255.0))))
44
45(define (make-render-part-mixin n)
46  (lambda (%)
47    (class (render-mixin %)
48      (define/override (render-part-depth) n)
49      (super-new))))
50
51(define-runtime-path skull-tex "scribble-skull.tex")
52(define skull-style (make-style #f (list (tex-addition skull-tex))))
53
54(define extra-character-conversions (make-parameter (λ (c) #f)))
55
56(define (render-mixin % #:image-mode [image-mode #f])
57  (class %
58    (super-new)
59
60    (inherit-field prefix-file style-file style-extra-files image-preferences)
61
62    (define/override (current-render-mode)
63      '(latex))
64
65    (inherit sort-image-requests)
66    (define image-reqs
67      (sort-image-requests (cond
68                            [(eq? image-mode 'pdf)
69                             '(pdf-bytes png@2x-bytes png-bytes)]
70                            [(eq? image-mode 'ps)
71                             '(eps-bytes)]
72                            [else
73                             '(pdf-bytes png@2x-bytes png-bytes eps-bytes)])
74                           image-preferences))
75
76    (define/override (get-suffix) #".tex")
77
78    (inherit render-block
79             render-part
80             install-file
81             format-number
82             number-depth
83             extract-part-style-files
84             extract-version
85             extract-date
86             extract-authors
87             extract-pretitle-content
88             link-render-style-at-element)
89
90    (define/public (extract-short-title d)
91      (ormap (lambda (v)
92               (and (short-title? v)
93                    (short-title-text v)))
94             (style-properties (part-style d))))
95
96    (define/override (auto-extra-files? v) (latex-defaults? v))
97    (define/override (auto-extra-files-paths v) (latex-defaults-extra-files v))
98
99    (define/public (render-part-depth) #f)
100
101    (define/override (render-one d ri fn)
102      (define (maybe-replace file defaults)
103        (cond [(and defaults
104                    (latex-defaults+replacements? defaults)
105                    (hash-ref (latex-defaults+replacements-replacements defaults)
106                              (path->string (file-name-from-path file))
107                              #f)) =>
108               (lambda (v)
109                 (cond
110                   [(bytes? v) v]
111                   [else (collects-relative->path v)]))]
112              [else file]))
113      (let* ([defaults (ormap (lambda (v) (and (latex-defaults? v) v))
114                              (style-properties (part-style d)))]
115             [prefix-file (or prefix-file
116                              (and defaults
117                                   (let ([v (latex-defaults-prefix defaults)])
118                                     (cond
119                                      [(bytes? v) v]
120                                      [else (collects-relative->path v)])))
121                              scribble-prefix-tex)]
122             [style-file (or style-file
123                             (and defaults
124                                  (let ([v (latex-defaults-style defaults)])
125                                    (cond
126                                     [(bytes? v) v]
127                                     [else (collects-relative->path v)])))
128                             scribble-style-tex)]
129             [all-style-files (list* scribble-load-tex
130                                     (maybe-replace scribble-load-replace-tex defaults)
131                                     scribble-tex
132                                     (append (extract-part-style-files
133                                              d
134                                              ri
135                                              (lambda (p) #f)
136                                              tex-addition?
137                                              tex-addition-path)
138                                             (list style-file)
139                                             style-extra-files))]
140             [whole-doc? (not (render-part-depth))])
141        (if whole-doc?
142            (for ([style-file (in-list (cons prefix-file all-style-files))])
143              (if (bytes? style-file)
144                  (display style-file)
145                  (with-input-from-file style-file
146                    (lambda ()
147                      (copy-port (current-input-port) (current-output-port))))))
148            (for ([style-file (in-list all-style-files)])
149              (if (bytes? style-file)
150                  (display style-file)
151                  (install-file style-file))))
152        (when whole-doc?
153          (printf "\\begin{document}\n\\preDoc\n")
154          (when (and (part-title-content d)
155                     (not (and (part-style? d 'hidden)
156                               (equal? "" (content->string (part-title-content d))))))
157            (let ([vers (extract-version d)]
158                  [date (extract-date d)]
159                  [pres (extract-pretitle-content d)]
160                  [auths (extract-authors d)]
161                  [short (extract-short-title d)])
162              (for ([pre (in-list pres)])
163                (printf "\n\n")
164                (cond
165                  [(paragraph? pre)
166                   (do-render-paragraph pre d ri #t #f)]
167                  [(nested-flow? pre)
168                   (do-render-nested-flow pre d ri #t #f #t)]))
169              (when date (printf "\\date{~a}\n" date))
170              (printf "\\titleAnd~aVersionAnd~aAuthors~a{"
171                      (if (equal? vers "") "Empty" "")
172                      (if (null? auths) "Empty" "")
173                      (if short "AndShort" ""))
174              (render-content (part-title-content d) d ri)
175              (printf "}{~a}{" vers)
176              (unless (null? auths)
177                (printf "\\SNumberOfAuthors{~a}" (length auths)))
178              (for/fold ([first? #t]) ([auth (in-list auths)])
179                (unless first? (printf "\\SAuthorSep{}"))
180                (do-render-paragraph auth d ri #t #f)
181                #f)
182              (if short
183                  (printf "}{~a}\n" short)
184                  (printf "}\n")))))
185        (render-part d ri)
186        (when whole-doc?
187          (printf "\n\n\\postDoc\n\\end{document}\n"))))
188
189    (define/override (render-part-content d ri)
190      (let ([number (collected-info-number (part-collected-info d ri))]
191            [completely-hidden?
192             (and (part-style? d 'hidden)
193                  (equal? "" (content->string (part-title-content d))))])
194        (when (and (part-title-content d)
195                   (or (pair? number)
196                       (let ([d (render-part-depth)])
197                         (and d (positive? d)))))
198          (when (eq? (style-name (part-style d)) 'index)
199            (printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
200          (let ([pres (extract-pretitle-content d)])
201            (for ([pre (in-list pres)])
202              (printf "\n\n")
203              (do-render-paragraph pre d ri #t #f)))
204          (define depth (+ (number-depth number) (or (render-part-depth) 0)))
205          (define grouper? (part-style? d 'grouper))
206          (define (inc-section-number)
207            (printf "\\Sinc~a" (case depth
208                                 [(0 1) (if grouper? "part" "section")]
209                                 [(2) "subsection"]
210                                 [(3) "subsubsection"]
211                                 [(4) "subsubsubsection"]
212                                 [else "subsubsubsubsection"])))
213          (cond
214           [completely-hidden?
215            (printf "\n\n\\notitlesection")
216            (unless (part-style? d 'unnumbered)
217              (inc-section-number))]
218           [else
219            (define no-number? (and (pair? number)
220                                    (or (not (car number))
221                                        (equal? "" (car number))
222                                        ((length number) . > . 3))))
223            (define no-toc? (part-style? d 'toc-hidden))
224            (define (show-number)
225              (when (and (part-style? d 'grouper)
226                         (depth . > . 1)
227                         (not no-number?))
228                (printf "~a\\quad{}" (car (format-number number null)))))
229            (printf "\n\n\\~a~a~a"
230                    (case depth
231                      [(0 1) (if grouper?
232                                 "partNewpage\n\n\\Spart"
233                                 "sectionNewpage\n\n\\Ssection")]
234                      [(2) "Ssubsection"]
235                      [(3) "Ssubsubsection"]
236                      [(4) "Ssubsubsubsection"]
237                      [else "Ssubsubsubsubsection"])
238                    (if (and grouper?
239                             (depth . > . 1))
240                        "grouper"
241                        "")
242                    (if no-number?
243                        (if no-toc?
244                            "star"
245                            "starx")
246                        ""))
247            (unless (and no-number? no-toc?)
248              (printf "{")
249              (show-number)
250              (parameterize ([disable-images #t]
251                             [escape-brackets #t]
252                             [disable-hyperref #t])
253                (render-content (part-title-content d) d ri))
254              (printf "}"))
255            (printf "{")
256            (show-number)
257            (parameterize ([disable-hyperref #t])
258              (render-content (part-title-content d) d ri))
259            (printf "}")
260            (when (and (part-style? d 'hidden-number)
261                       (not (part-style? d 'unnumbered)))
262              (inc-section-number))
263            (when (eq? (style-name (part-style d)) 'index) (printf "\n\n"))]))
264        (for ([t (part-tags d)])
265          (printf "\\label{t:~a}~a" (t-encode (add-current-tag-prefix (tag-key t ri)))
266                  (if completely-hidden? "" "\n\n")))
267        (render-flow (part-blocks d) d ri #f)
268        (for ([sec (part-parts d)]) (render-part sec ri))
269        (when (eq? (style-name (part-style d)) 'index) (printf "\\onecolumn\n\n"))
270        null))
271
272    (define/override (render-paragraph p part ri)
273      (do-render-paragraph p part ri #f #f))
274
275    (define/private (do-render-paragraph p part ri show-pre? as-box-mode)
276      (let* ([sn (style-name (paragraph-style p))]
277             [style (cond
278                     [as-box-mode
279                      (or
280                       (ormap (lambda (a)
281                                (and (box-mode? a)
282                                     ((box-mode-selector as-box-mode) a)))
283                              (style-properties
284                               (paragraph-style p)))
285                       "hbox")]
286                     [(eq? sn 'author) "SAuthor"]
287                     [(eq? sn 'pretitle) #f]
288                     [(eq? sn 'wraps) #f]
289                     [else sn])])
290        (unless (and (not show-pre?)
291                     (or (eq? sn 'author)
292                         (eq? sn 'pretitle)))
293          (let ([use-style? (string? style)])
294            (when use-style?
295              (printf "\\~a{" style))
296            (if (toc-paragraph? p)
297                (printf "\\newpage \\tableofcontents \\newpage")
298                (if as-box-mode
299                    (parameterize ([suppress-newline-content #t])
300                      (super render-paragraph p part ri))
301                    (super render-paragraph p part ri)))
302            (when use-style? (printf "}")))))
303      null)
304
305    (define/private (no-noindent? p ri)
306      (cond
307       [(delayed-block? p)
308        (no-noindent? (delayed-block-blocks p ri) ri)]
309       [(traverse-block? p)
310        (no-noindent? (traverse-block-block p ri) ri)]
311       [else
312        (or
313         (memq 'never-indents
314               (style-properties
315                (cond
316                 [(paragraph? p) (paragraph-style p)]
317                 [(compound-paragraph? p) (compound-paragraph-style p)]
318                 [(nested-flow? p) (nested-flow-style p)]
319                 [(table? p) (table-style p)]
320                 [(itemization? p) (itemization-style p)]
321                 [else plain])))
322         (and (nested-flow? p)
323              (pair? (nested-flow-blocks p))
324              (no-noindent? (car (nested-flow-blocks p)) ri))
325         (and (compound-paragraph? p)
326              (pair? (compound-paragraph-blocks p))
327              (no-noindent? (car (compound-paragraph-blocks p)) ri)))]))
328
329    (define/override (render-intrapara-block p part ri first? last? starting-item?)
330      (unless first?
331        (printf "\n\n")
332        (unless (no-noindent? p ri)
333          (printf "\\noindent ")))
334      (super render-intrapara-block p part ri first? last? starting-item?))
335
336    (define/override (render-content e part ri)
337      (let ([part-label? (and (link-element? e)
338                              (pair? (link-element-tag e))
339                              (eq? 'part (car (link-element-tag e)))
340                              (empty-content? (element-content e)))])
341        (parameterize ([done-link-page-numbers (or (done-link-page-numbers)
342                                                   (link-element? e))])
343          (when (target-element? e)
344            (printf "\\label{t:~a}"
345                    (t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri)))))
346          (when part-label?
347            (define-values (dest ext?) (resolve-get/ext? part ri (link-element-tag e)))
348            (let* ([number (and dest (vector-ref dest 2))]
349                   [formatted-number (and dest
350                                          (list? number)
351                                          (format-number number null))]
352                   [lbl? (and dest
353                              (not ext?)
354                              (not (show-link-page-numbers)))]
355                   [link-number? (and lbl?
356                                      (eq? 'number (link-render-style-at-element e)))])
357              (printf "\\~aRef~a~a~a{"
358                      (case (and dest (number-depth number))
359                        [(0) "Book"]
360                        [(1) (if (string? (car number)) "Part" "Chap")]
361                        [else "Sec"])
362                      (if (and lbl? (not link-number?))
363                          "Local"
364                          "")
365                      (if (let ([s (element-style e)])
366                            (and (style? s) (memq 'uppercase (style-properties s))))
367                          "UC"
368                          "")
369                      (if (null? formatted-number)
370                          "UN"
371                          ""))
372              (when (and lbl? (not link-number?))
373                (printf "t:~a}{" (t-encode (vector-ref dest 1))))
374              (unless (null? formatted-number)
375                (when link-number? (printf "\\SectionNumberLink{t:~a}{" (t-encode (vector-ref dest 1))))
376                (render-content
377                 (if dest
378                     (if (list? number)
379                         formatted-number
380                         (begin (eprintf "Internal tag error: ~s -> ~s\n"
381                                         (link-element-tag e)
382                                         dest)
383                                '("!!!")))
384                     (list "???"))
385                 part ri)
386                (when link-number? (printf "}"))
387                (printf "}{"))))
388          (let* ([es (cond
389                      [(element? e) (element-style e)]
390                      [(multiarg-element? e) (multiarg-element-style e)]
391                      [else #f])]
392                 [style-name (if (style? es)
393                                 (style-name es)
394                                 es)]
395                 [style (and (style? es) es)]
396                 [hyperref? (and (not part-label?)
397                                 (link-element? e)
398                                 (not (disable-hyperref))
399                                 (let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))])
400                                   (and dest (not ext?))))]
401                 [check-render
402                  (lambda ()
403                    (when (render-element? e)
404                      ((render-element-render e) this part ri)))]
405                 [core-render (lambda (e tt?)
406                                (cond
407                                 [(and (image-element? e)
408                                       (not (disable-images)))
409                                  (check-render)
410                                  (let ([fn (install-file
411                                             (select-suffix
412                                              (collects-relative->path
413                                               (image-element-path e))
414                                              (image-element-suffixes e)
415                                              '(".pdf" ".ps" ".png")))])
416                                    (printf "\\includegraphics[scale=~a]{~a}"
417                                            (image-element-scale e) fn))]
418                                 [(and (convertible? e)
419                                       (not (disable-images))
420                                       (let ([ftag (lambda (v suffix [scale 1]) (and v (list v suffix scale)))]
421                                             [xxlist (lambda (v) (and v (list v #f #f #f #f #f #f #f #f)))]
422                                             [xlist (lambda (v) (and v (append v (list 0 0 0 0))))])
423                                         (for/or ([req (in-list image-reqs)])
424                                           (case req
425                                             [(eps-bytes)
426                                              (or (ftag (convert e 'eps-bytes+bounds8) ".ps")
427                                                  (ftag (xlist (convert e 'eps-bytes+bounds)) ".ps")
428                                                  (ftag (xxlist (convert e 'eps-bytes)) ".ps"))]
429                                             [(pdf-bytes)
430                                              (or (ftag (convert e 'pdf-bytes+bounds8) ".pdf")
431                                                  (ftag (xlist (convert e 'pdf-bytes+bounds)) ".pdf")
432                                                  (ftag (xxlist (convert e 'pdf-bytes)) ".pdf"))]
433                                             [(png@2x-bytes)
434                                              (or (ftag (convert e 'png@2x-bytes+bounds8) ".png" 0.5)
435                                                  (ftag (xxlist (convert e 'png@2x-bytes)) ".png" 0.5))]
436                                             [(png-bytes)
437                                              (or (ftag (convert e 'png-bytes+bounds8) ".png")
438                                                  (ftag (xxlist (convert e 'png-bytes)) ".png"))]))))
439                                  => (lambda (bstr+info+suffix)
440                                       (check-render)
441                                       (let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)]
442                                              [suffix (list-ref bstr+info+suffix 1)]
443                                              [scale (list-ref bstr+info+suffix 2)]
444                                              [height (list-ref (list-ref bstr+info+suffix 0) 2)]
445                                              [pad-left (or (list-ref (list-ref bstr+info+suffix 0) 5) 0)]
446                                              [pad-top (or (list-ref (list-ref bstr+info+suffix 0) 6) 0)]
447                                              [pad-right (or (list-ref (list-ref bstr+info+suffix 0) 7) 0)]
448                                              [pad-bottom (or (list-ref (list-ref bstr+info+suffix 0) 8) 0)]
449                                              [descent (and height
450                                                            (- (+ (list-ref (list-ref bstr+info+suffix 0) 3)
451                                                                  (- (ceiling height) height))
452                                                               pad-bottom))]
453                                              [width (let ([w (list-ref (list-ref bstr+info+suffix 0) 1)])
454                                                       (and w (- w pad-left pad-right)))]
455                                              [fn (install-file (format "pict~a" suffix) bstr)])
456                                         (if descent
457                                             (printf "\\raisebox{-~abp}{\\makebox[~abp][l]{\\includegraphics[~atrim=~a ~a ~a ~a]{~a}}}"
458                                                     descent
459                                                     width
460                                                     (if (= scale 1) "" (format "scale=~a," scale))
461                                                     (/ pad-left scale) (/ pad-bottom scale) (/ pad-right scale) (/ pad-top scale)
462                                                     fn)
463                                             (printf "\\includegraphics{~a}" fn))))]
464                                 [else
465                                  (parameterize ([rendering-tt (or tt? (rendering-tt))])
466                                    (super render-content e part ri))]))]
467                 [wrap (lambda (e s tt?)
468                         (when s (printf "\\~a{" s))
469                         (core-render e tt?)
470                         (when s (printf "}")))])
471            (define (finish tt?)
472              (cond
473               [(symbol? style-name)
474                (case style-name
475                  [(emph) (wrap e "emph" tt?)]
476                  [(italic) (wrap e "textit" tt?)]
477                  [(bold) (wrap e "textbf" tt?)]
478                  [(tt) (wrap e "Scribtexttt" #t)]
479                  [(url) (wrap e "Snolinkurl" 'url)]
480                  [(no-break) (wrap e "mbox" tt?)]
481                  [(sf) (wrap e "textsf" #f)]
482                  [(roman) (wrap e "textrm" #f)]
483                  [(subscript) (wrap e "textsub" #f)]
484                  [(superscript) (wrap e "textsuper" #f)]
485                  [(smaller) (wrap e "Smaller" #f)]
486                  [(larger) (wrap e "Larger" #f)]
487                  [(hspace)
488                   (check-render)
489                   (let ([s (content->string e)])
490                     (case (string-length s)
491                       [(0) (void)]
492                       [else
493                        (printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
494                                (regexp-replace* #rx"." s "x"))]))]
495                  [(newline)
496                   (check-render)
497                   (unless (suppress-newline-content)
498                     (printf "\\hspace*{\\fill}\\\\"))]
499                  [else (error 'latex-render
500                               "unrecognized style symbol: ~s" style)])]
501               [(string? style-name)
502                (let* ([v (if style (style-properties style) null)]
503                       [tt? (cond
504                             [(memq 'tt-chars v) #t]
505                             [(memq 'exact-chars v) 'exact]
506                             [else tt?])])
507                  (cond
508                   [(multiarg-element? e)
509                    (check-render)
510                    (printf "\\~a" style-name)
511                    (define maybe-optional-args
512                      (findf command-optional? (if style (style-properties style) '())))
513                    (when maybe-optional-args
514                      (for ([i (in-list (command-optional-arguments maybe-optional-args))])
515                        (printf "[~a]" i)))
516                    (if (null? (multiarg-element-contents e))
517                        (printf "{}")
518                        (for ([i (in-list (multiarg-element-contents e))])
519                          (printf "{")
520                          (parameterize ([rendering-tt (or tt? (rendering-tt))])
521                            (render-content i part ri))
522                          (printf "}")))]
523                   [else
524                    (define maybe-optional
525                      (findf command-optional? (if style (style-properties style) '())))
526                    (if maybe-optional
527                        (wrap e
528                              (string-join #:before-first (format "~a[" style-name)
529                                           #:after-last "]"
530                                           (command-optional-arguments maybe-optional)
531                                           "][")
532                              tt?)
533                        (wrap e style-name tt?))]))]
534               [(and (not style-name)
535                     style
536                     (memq 'exact-chars (style-properties style)))
537                (wrap e style-name 'exact)]
538               [else
539                (core-render e tt?)]))
540            (when hyperref?
541              (printf "\\hyperref[t:~a]{"
542                      (t-encode (link-element-tag e))))
543            (let loop ([l (if style (style-properties style) null)] [tt? #f])
544              (if (null? l)
545                  (if hyperref?
546                      (parameterize ([disable-hyperref #t])
547                        (finish tt?))
548                      (finish tt?))
549                  (let ([v (car l)])
550                    (cond
551                     [(target-url? v)
552                      (define target (let* ([s (let ([p (target-url-addr v)])
553                                                 (if (path? p)
554                                                     (path->string p)
555                                                     p))]
556                                            [s (regexp-replace* #rx"\\\\" s "%5c")]
557                                            [s (regexp-replace* #rx"{" s "%7b")]
558                                            [s (regexp-replace* #rx"}" s "%7d")]
559                                            [s (regexp-replace* #rx"%" s "\\\\%")])
560                                       s))
561                      (if (regexp-match? #rx"^[^#]*#[^#]*$" target)
562                          ;; work around a problem with `\href' as an
563                          ;; argument to other macros, such as `\marginpar':
564                          (let ([l (string-split target "#")])
565                            (printf "\\Shref{~a}{~a}{" (car l) (cadr l)))
566                          ;; normal:
567                          (printf "\\href{~a}{" target))
568                      (loop (cdr l) #t)
569                      (printf "}")]
570                     [(color-property? v)
571                      (printf "\\intext~acolor{~a}{"
572                              (if (string? (color-property-color v)) "" "rgb")
573                              (color->string (color-property-color v)))
574                      (loop (cdr l) tt?)
575                      (printf "}")]
576                     [(background-color-property? v)
577                      (printf "\\in~acolorbox{~a}{"
578                              (if (string? (background-color-property-color v)) "" "rgb")
579                              (color->string (background-color-property-color v)))
580                      (loop (cdr l) tt?)
581                      (printf "}")]
582                     [(command-extras? (car l))
583                      (loop (cdr l) tt?)
584                      (for ([l (in-list (command-extras-arguments (car l)))])
585                        (printf "{~a}" l))]
586                     [else (loop (cdr l) tt?)]))))
587            (when hyperref?
588              (printf "}"))))
589        (when part-label?
590          (printf "}"))
591        (when (and (link-element? e)
592                   (show-link-page-numbers)
593                   (not (done-link-page-numbers)))
594          (define (make-ref e)
595            (string-append
596             "t:"
597             (t-encode
598              (let ([v (resolve-get part ri (link-element-tag e))])
599                (and v (vector-ref v 1))))))
600          (cond
601            [(multiple-page-references) ; for index
602             => (lambda (l)
603                  (printf ", \\Smanypageref{~a}" ; using cleveref
604                          (string-join (map make-ref l) ",")))]
605            [else
606             (printf ", \\pageref{~a}" (make-ref e))]))
607        null))
608
609    (define/private (t-encode s)
610      (string-append*
611       (map (lambda (c)
612              (cond
613                [(and (or (char-alphabetic? c) (char-numeric? c))
614                      ((char->integer c) . < . 128))
615                 (string c)]
616                [(char=? c #\space) "_"]
617                [else (format "x~x" (char->integer c))]))
618            (string->list (format "~s" s)))))
619
620    (define/override (render-flow p part ri starting-item? [wrap-each? #f])
621      (if (null? p)
622          null
623          (begin
624            (when wrap-each? (printf "{"))
625            (render-block (car p) part ri starting-item?)
626            (when wrap-each? (printf "}"))
627            (for ([b (in-list (cdr p))])
628              (if wrap-each?
629                  (printf "%\n{")
630                  (printf "\n\n"))
631              (render-block b part ri #f)
632              (when wrap-each? (printf "}")))
633            null)))
634
635    (define/override (render-table t part ri starting-item?)
636      (render-table* t part ri starting-item? "[t]"))
637
638    (define/private (render-table* t part ri starting-item? alignment)
639      (let* ([s-name (style-name (table-style t))]
640             [boxed? (eq? 'boxed s-name)]
641             [index? (eq? 'index s-name)]
642             [merge-index? (let loop ([part part])
643                             (or (memq 'enable-index-merge (style-properties (part-style part)))
644                                 (let* ([ci (part-collected-info part ri)]
645                                        [p (and ci (collected-info-parent ci))])
646                                   (and p (loop p)))))]
647             [tableform
648              (cond [index? "list"]
649                    [(eq? 'block s-name) "tabular"]
650                    [(not (current-table-mode)) "bigtabular"]
651                    [else "tabular"])]
652             [opt (cond [(equal? tableform "bigtabular") ""]
653                        [(equal? tableform "tabular") alignment]
654                        [else ""])]
655             [blockss (if index? (cddr (table-blockss t)) (table-blockss t))]
656             [cell-styless (extract-table-cell-styles t)]
657             [twidth (if (null? (table-blockss t))
658                         1
659                         (length (car (table-blockss t))))]
660             [single-column? (and (= 1 twidth)
661                                  (or (not s-name) (string? s-name))
662                                  (not (ormap (lambda (cell-styles)
663                                                (ormap (lambda (s)
664                                                         (or (string? (style-name s))
665                                                             (let ([l (style-properties s)])
666                                                               (or (memq 'right l)
667                                                                   (memq 'center l)))))
668                                                       cell-styles))
669                                              cell-styless))
670                                  (not (current-table-mode)))]
671             [inline?
672              (and (not single-column?)
673                   (not boxed?)
674                   (not index?)
675                   (ormap (lambda (rs)
676                            (ormap (lambda (cs) (style-name cs)) rs))
677                          cell-styless)
678                   (= 1 twidth)
679                   (let ([m (current-table-mode)])
680                     (and m
681                          (equal? "bigtabular" (car m))
682                          (= 1 (length (car (table-blockss (cadr m))))))))])
683        (if single-column?
684            (begin
685              (when (string? s-name)
686                (printf "\\begin{~a}" s-name))
687              (do-render-nested-flow
688               (make-nested-flow (make-style "SingleColumn" null) (map car (table-blockss t)))
689               part
690               ri
691               #t
692               #f
693               #f)
694              (when (string? s-name)
695                (printf "\\end{~a}" s-name)))
696            (unless (or (null? blockss) (null? (car blockss)))
697              (define all-left-line?s
698                (if (null? cell-styless)
699                    null
700                    (for/list ([i (in-range (length (car cell-styless)))])
701                      (for/and ([cell-styles (in-list cell-styless)])
702                        (let ([cell-style (list-ref cell-styles i)])
703                          (or (memq 'left-border (style-properties cell-style))
704                              (memq 'border (style-properties cell-style))))))))
705              (define all-right-line?
706                (and (pair? cell-styless)
707                     (let ([i (sub1 (length (car cell-styless)))])
708                       (for/and ([cell-styles (in-list cell-styless)])
709                         (let ([cell-style (list-ref cell-styles i)])
710                           (or (memq 'right-border (style-properties cell-style))
711                               (memq 'border (style-properties cell-style))))))))
712              (parameterize ([current-table-mode
713                              (if inline? (current-table-mode) (list tableform t))]
714                             [show-link-page-numbers
715                              (or index? (show-link-page-numbers))])
716                (cond
717                 [index? (printf "\\begin{list}{}{\\parsep=0pt \\itemsep=1pt \\leftmargin=2ex \\itemindent=-2ex}\n")]
718                 [inline? (void)]
719                 [single-column? (printf "\\begin{tabbing}\n")]
720                 [else
721                  (printf "~a~a\\begin{~a}~a{@{~a}~a}\n~a"
722                          (if (and starting-item? (equal? tableform "bigtabular"))
723                              "\\bigtableinlinecorrect"
724                              "")
725                          (if (string? s-name)
726                              (format "\\begin{~a}" s-name)
727                              "")
728                          tableform
729                          opt
730                          (if (equal? tableform "bigtabular")
731                              "\\bigtableleftpad"
732                              "")
733                          (string-append*
734                           (let ([l
735                                  (map (lambda (i cell-style left-line?)
736                                         (format "~a~a@{}"
737                                                 (if left-line? "|@{}" "")
738                                                 (cond
739                                                  [(memq 'center (style-properties cell-style)) "c"]
740                                                  [(memq 'right (style-properties cell-style)) "r"]
741                                                  [else "l"])))
742                                       (car blockss)
743                                       (car cell-styless)
744                                       all-left-line?s)])
745                             (let ([l (if all-right-line? (append l '("|")) l)])
746                               (if boxed? (cons "@{\\SBoxedLeft}" l) l))))
747                          "")])
748                ;; Helper to add row-separating lines:
749                (define (add-clines prev-styles next-styles)
750                  (let loop ([pos 1] [start #f] [prev-styles prev-styles] [next-styles next-styles])
751                    (cond
752                     [(or (and prev-styles (null? prev-styles))
753                          (and next-styles (null? next-styles)))
754                      (when start
755                        (if (= start 1)
756                            (printf "\\hline ")
757                            (printf "\\cline{~a-~a}" start (sub1 pos))))]
758                     [else
759                      (define prev-style (and prev-styles (car prev-styles)))
760                      (define next-style (and next-styles (car next-styles)))
761                      (define line? (or (and prev-style
762                                             (or (memq 'bottom-border (style-properties prev-style))
763                                                 (memq 'border (style-properties prev-style))))
764                                        (and next-style
765                                             (or (memq 'top-border (style-properties next-style))
766                                                 (memq 'border (style-properties next-style))))))
767                      (when (and start (not line?))
768                        (printf "\\cline{~a-~a}" start (sub1 pos)))
769                      (loop (add1 pos) (and line? (or start pos))
770                            (and prev-styles (cdr prev-styles))
771                            (and next-styles (cdr next-styles)))])))
772                ;; Loop through rows:
773                (let loop ([blockss blockss]
774                           [cell-styless cell-styless]
775                           [prev-styles #f]) ; for 'bottom-border styles
776                  (let ([flows (car blockss)]
777                        [cell-styles (car cell-styless)])
778                    (unless index? (add-clines prev-styles cell-styles))
779                    (define group-size
780                      (cond
781                        [merge-index?
782                         ;; Merge entries that have the same text & style
783                         (let loop ([blockss (cdr blockss)] [group-size 1])
784                           (cond
785                             [(null? blockss) group-size]
786                             [(same-index-entry? flows (car blockss))
787                              (loop (cdr blockss) (add1 group-size))]
788                             [else group-size]))]
789                        [else 1]))
790                    (let loop ([flows flows]
791                               [cell-styles cell-styles]
792                               [all-left-line?s all-left-line?s]
793                               [need-left? #f])
794                      (unless (null? flows)
795                        (define (render-cell cnt)
796                          (render-table-cell (car flows) part ri (/ twidth cnt) (car cell-styles) (not index?)))
797                        (define right-line?
798                          (cond
799                           [index?
800                            (printf "\n\\item ")
801                            (parameterize ([multiple-page-references
802                                            (and (group-size . > . 1)
803                                                 (extract-index-link-targets (take blockss group-size)))])
804                              (render-cell 1))
805                            #f]
806                           [(eq? 'cont (car flows))
807                            #f]
808                           [else
809                            (let ([cnt (let loop ([flows (cdr flows)][n 1])
810                                         (cond [(null? flows) n]
811                                               [(eq? (car flows) 'cont)
812                                                (loop (cdr flows) (add1 n))]
813                                               [else n]))])
814                              (unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt))
815                              (when (and (not (car all-left-line?s))
816                                         (or need-left?
817                                             (memq 'left-border (style-properties (car cell-styles)))
818                                             (memq 'border (style-properties (car cell-styles)))))
819                                (printf "\\vline "))
820                              (render-cell cnt)
821                              (define right-line? (or (memq 'right-border (style-properties (list-ref cell-styles (sub1 cnt))))
822                                                      (memq 'border (style-properties (list-ref cell-styles (sub1 cnt))))))
823                              (when (and right-line? (null? (list-tail flows cnt)) (not all-right-line?))
824                                (printf "\\vline "))
825                              (unless (= cnt 1) (printf "}"))
826                              (unless (null? (list-tail flows cnt))
827                                (printf " &\n"))
828                              right-line?)]))
829                        (unless (null? (cdr flows)) (loop (cdr flows)
830                                                          (cdr cell-styles)
831                                                          (cdr all-left-line?s)
832                                                          right-line?))))
833                    (define rest-blockss (list-tail blockss group-size))
834                    (unless (or index?
835                                (and (null? rest-blockss)
836                                     (not (for/or ([cell-style (in-list cell-styles)])
837                                            (or (memq 'bottom-border (style-properties cell-style))
838                                                (memq 'border (style-properties cell-style)))))))
839                      (let ([row-skip (for/or ([cell-style (in-list cell-styles)])
840                                        (for/or ([prop (style-properties cell-style)])
841                                          (and (table-row-skip? prop) prop)))])
842                        (printf " \\\\~a\n" (if row-skip
843                                                (format "[~a]" (table-row-skip-amount row-skip))
844                                                ""))))
845                    (cond
846                     [(null? rest-blockss)
847                      (unless index? (add-clines cell-styles #f))]
848                     [else
849                      (loop rest-blockss (list-tail cell-styless group-size) cell-styles)])))
850                (unless inline?
851                  (printf "\\end{~a}~a"
852                          tableform
853                          (if (string? s-name)
854                              (format "\\end{~a}" s-name)
855                              "")))))))
856      null)
857
858    (define/private (render-table-cell p part ri twidth vstyle can-box?)
859      (let* ([top? (or (memq 'top (style-properties vstyle))
860                       (memq 'baseline (style-properties vstyle)))]
861             [bottom? (and (not top?)
862                           (memq 'bottom (style-properties vstyle)))]
863             [center? (and (not bottom?)
864                           (not top?))]
865             [as-box? (and can-box? (boxable? p))])
866        (when (string? (style-name vstyle))
867          (printf "\\~a{" (style-name vstyle)))
868        (let ([minipage? (and can-box? (not as-box?))])
869          (when minipage?
870            (printf "\\begin{minipage}~a{~a\\linewidth}\n"
871                    (cond
872                     [top? "[t]"]
873                     [center? "[c]"]
874                     [else ""])
875                    (/ 1.0 twidth)))
876          (cond
877           [(table? p)
878            (render-table* p part ri #f (cond
879                                         [top? "[t]"]
880                                         [center? "[c]"]
881                                         [else "[b]"]))]
882           [as-box?
883            (render-boxable-block p part ri (cond
884                                             [top? 't]
885                                             [center? 'c]
886                                             [else 'b]))]
887           [else
888            (render-block p part ri #f)])
889          (when minipage?
890            (printf " \\end{minipage}\n")))
891        (when (string? (style-name vstyle))
892          (printf "}"))
893        null))
894
895    (define/private (boxable? p)
896      (or (and (table? p)
897               (for* ([l (in-list (table-blockss p))]
898                      [p (in-list l)])
899                 (boxable? p)))
900          (and (nested-flow? p)
901               (or (and (= 1 (length (nested-flow-blocks p)))
902                        (memq (style-name (nested-flow-style p))
903                              '(code-inset vertical-inset)))
904                   (and
905                    (ormap box-mode? (style-properties (nested-flow-style p)))
906                    (andmap (lambda (p) (boxable? p)) (nested-flow-blocks p)))))
907          (and (paragraph? p)
908               (or (not (style-name (paragraph-style p)))
909                   (ormap box-mode? (style-properties (paragraph-style p)))))))
910
911    (define/private (render-boxable-block p part ri mode)
912      (cond
913       [(table? p)
914        (render-table* p part ri #f (format "[~a]" mode))]
915       [(nested-flow? p)
916        (do-render-nested-flow p part ri #f mode #f)]
917       [(paragraph? p)
918        (do-render-paragraph p part ri #f mode)]))
919
920    (define/private (box-mode-selector as-box-mode)
921      (case as-box-mode
922        [(t) box-mode-top-name]
923        [(c) box-mode-center-name]
924        [(b) box-mode-bottom-name]))
925
926    (define/override (render-itemization t part ri)
927      (let* ([style-str (let ([s (style-name (itemization-style t))])
928                          (if (eq? s 'compact)
929                              "compact"
930                              s))]
931             [mode (or (and (string? style-str)
932                            style-str)
933                       (if (eq? 'ordered style-str)
934                           "enumerate"
935                           "itemize"))])
936        (printf "\\begin{~a}\\atItemizeStart" mode)
937        (for ([flow (in-list (itemization-blockss t))])
938          (printf "\n\n\\~a" (if (string? style-str)
939                                  (format "~aItem{" style-str)
940                                  "item "))
941          (render-flow flow part ri #t)
942          (when (string? style-str)
943            (printf "}")))
944        (printf "\\end{~a}" mode)
945        null))
946
947    (define/private (do-render-nested-flow t part ri single-column? as-box-mode show-pre?)
948      (let* ([props (style-properties (nested-flow-style t))]
949             [kind (or (and as-box-mode
950                            (or
951                             (ormap (lambda (a)
952                                      (and (box-mode? a)
953                                           ((box-mode-selector as-box-mode) a)))
954                                    props)
955                             (case (style-name (nested-flow-style t))
956                               [(code-inset) "SCodeInsetBox"]
957                               [(vertical-inset) "SVInsetBox"]
958                               [else (error "unexpected style for box mode")])))
959                       (let ([s (style-name (nested-flow-style t))])
960                         (or (and (string? s) s)
961                             (and (eq? s 'inset) "SInsetFlow")
962                             (and (eq? s 'code-inset) "SCodeFlow")
963                             (and (eq? s 'vertical-inset) "SVInsetFlow")))
964                       "Subflow")]
965             [multicommand? (memq 'multicommand props)]
966             [command? (or (and as-box-mode (not multicommand?))
967                           (memq 'command props))])
968        (unless (and (not show-pre?)
969                     (member 'pretitle props))
970          (cond
971            [command? (printf "\\~a{" kind)]
972            [multicommand? (printf "\\~a" kind)]
973            [else (printf "\\begin{~a}" kind)])
974          (parameterize ([current-table-mode (if (or single-column?
975                                                     (not (current-table-mode)))
976                                                 (current-table-mode)
977                                                 (list "nested-flow" t))])
978            (if as-box-mode
979                (for-each (lambda (p)
980                            (when multicommand? (printf "{"))
981                            (render-boxable-block p part ri as-box-mode)
982                            (when multicommand? (printf "}")))
983                          (nested-flow-blocks t))
984                (render-flow (nested-flow-blocks t) part ri #f multicommand?)))
985          (cond
986            [command? (printf "}")]
987            [multicommand? (void)]
988            [else (printf "\\end{~a}" kind)])
989          null)))
990
991    (define/override (render-nested-flow t part ri starting-item?)
992      (do-render-nested-flow t part ri #f #f #f))
993
994    (define/override (render-compound-paragraph t part ri starting-item?)
995      (let ([kind (style-name (compound-paragraph-style t))]
996            [command? (memq 'command (style-properties (compound-paragraph-style t)))])
997        (when kind
998          (if command?
999              (printf "\\~a{" kind)
1000              (printf "\\begin{~a}" kind)))
1001        (super render-compound-paragraph t part ri starting-item?)
1002        (when kind
1003          (if command?
1004              (printf "}")
1005              (printf "\\end{~a}" kind)))
1006        null))
1007
1008    (define/override (render-other i part ri)
1009      (cond
1010        [(string? i) (display-protected i)]
1011        [(symbol? i)
1012         (display (case i
1013                    [(nbsp) "~"]
1014                    [(mdash) "{---}"]
1015                    [(ndash) "{--}"]
1016                    [(ldquo) "{``}"]
1017                    [(rdquo) "{''}"]
1018                    [(rsquo) "{'}"]
1019                    [(lsquo) "{`}"]
1020                    [(prime) "$'$"]
1021                    [(rarr) "$\\rightarrow$"]
1022                    [(larr) "$\\leftarrow$"]
1023                    [(alpha) "$\\alpha$"]
1024                    [(infin) "$\\infty$"]
1025                    [(lang) "$\\langle$"]
1026                    [(rang) "$\\rangle$"]
1027                    [else (error 'render "unknown symbol element: ~e" i)]))]
1028        [else (display-protected (format "~s" i))])
1029      null)
1030
1031    (define/override (string-to-implicit-styles e)
1032      (for/fold ([ses null]) ([ch (in-string e)])
1033        (case ch
1034          [(#\☠) (cons skull-style ses)]
1035          [else ses])))
1036
1037    (define/private (display-protected s)
1038      (define rtt   (rendering-tt))
1039      (define convs (extra-character-conversions))
1040      (cond
1041       [(eq? rtt 'exact)
1042        (display s)]
1043       [(eq? rtt 'url)
1044        (for ([c (in-string s)])
1045          (case c
1046            [(#\%) (display "\\%")]
1047            [(#\#) (display "\\#")]
1048            [(#\\) (display "\\%5c")]
1049            [(#\{) (display "\\%7b")]
1050            [(#\}) (display "\\%7d")]
1051            [else (display c)]))]
1052       [else
1053        ;; Start by normalizing to "combined" form, so that Racket characters
1054        ;; are closer to Unicode characters (e.g., ä is one character, instead
1055        ;; of a combining character followed by "a").
1056        (let ([s (string-normalize-nfc s)])
1057          (let ([len (string-length s)])
1058            (let loop ([i 0])
1059              (unless (= i len)
1060                (display
1061                 (let char-loop ([c (string-ref s i)])
1062                   (case c
1063                     [(#\\) (if (rendering-tt)
1064                                "{\\char`\\\\}"
1065                                "$\\backslash$")]
1066                     [(#\_) (if (rendering-tt)
1067                                "{\\char`\\_}"
1068                                "$\\_$")]
1069                     [(#\^) "{\\char'136}"]
1070                     [(#\>) (if (rendering-tt) "{\\Stttextmore}" "$>$")]
1071                     [(#\<) (if (rendering-tt) "{\\Stttextless}" "$<$")]
1072                     [(#\|) (if (rendering-tt) "{\\Stttextbar}" "$|$")]
1073                     [(#\-) "{-}"] ;; avoid en- or em-dash
1074                     [(#\`) "{\\textasciigrave}"]
1075                     [(#\') "{\\textquotesingle}"]
1076                     [(#\? #\! #\. #\:)
1077                      (if (rendering-tt) (format "{\\hbox{\\texttt{~a}}}" c) c)]
1078                     [(#\~) "$\\sim$"]
1079                     [(#\{ #\}) (if (rendering-tt)
1080                                    (format "{\\char`\\~a}" c)
1081                                    (format "\\~a" c))]
1082                     [(#\[ #\]) (if (escape-brackets)
1083                                    (if (eq? c #\[)
1084                                        "{\\SOpenSq}"
1085                                        "{\\SCloseSq}")
1086                                    c)]
1087                     [(#\# #\% #\& #\$) (format "\\~a" c)]
1088                     [(#\uA0) "~"] ; non-breaking space
1089                     [(#\uAD) "\\-"] ; soft hyphen; unfortunately, also disables auto-hyphen
1090                     [(#\uDF) "{\\ss}"]
1091                     [else
1092                      (if ((char->integer c) . > . 127)
1093                          ;; first, try user-defined conversions
1094                          (or (convs c)
1095                              ;; latex-prefix.rkt enables utf8 input, but this does not work for
1096                              ;; all the characters below (e.g. ∞). Some parts of the table
1097                              ;; below are therefore necessary, but some parts probably are not.
1098                              ;; Which parts are necessary may depend on the latex version,
1099                              ;; though, so we keep this table around to avoid regressions.
1100                              (case c
1101                                [(#\╔ #\═ #\╗ #\║ #\╚ #\╝ #\╦ #\╠ #\╣ #\╬ #\╩) (box-character c)]
1102                                [(#\┌ #\─ #\┐ #\│ #\└ #\┘ #\┬ #\├ #\┤ #\┼ #\┴) (box-character c)]
1103                                [(#\┏ #\━ #\┓ #\┃ #\┗ #\┛ #\┳ #\┣ #\┫ #\╋ #\┻) (box-character c 2)]
1104                                [(#\u2011) "\\mbox{-}"] ; non-breaking hyphen
1105                                [(#\uB0) "$^{\\circ}$"] ; degree
1106                                [(#\uB2) "$^2$"]
1107                                [(#\u039A) "K"] ; kappa
1108                                [(#\u0391) "A"] ; alpha
1109                                [(#\u039F) "O"] ; omicron
1110                                [(#\u03A3) "$\\Sigma$"]
1111                                [(#\u03BA) "$\\kappa$"]
1112                                [(#\u03B1) "$\\alpha$"]
1113                                [(#\u03B2) "$\\beta$"]
1114                                [(#\u03B3) "$\\gamma$"]
1115                                [(#\u03BF) "o"] ; omicron
1116                                [(#\u03C3) "$\\sigma$"]
1117                                [(#\u03C2) "$\\varsigma$"]
1118                                [(#\u03BB) "$\\lambda$"]
1119                                [(#\u039B) "$\\Lambda$"]
1120                                [(#\u03BC) "$\\mu$"]
1121                                [(#\u03C0) "$\\pi$"]
1122                                [(#\₀) "$_0$"]
1123                                [(#\₁) "$_1$"]
1124                                [(#\₂) "$_2$"]
1125                                [(#\₃) "$_3$"]
1126                                [(#\₄) "$_4$"]
1127                                [(#\₅) "$_5$"]
1128                                [(#\₆) "$_6$"]
1129                                [(#\₇) "$_7$"]
1130                                [(#\₈) "$_8$"]
1131                                [(#\₉) "$_9$"]
1132                                [(#\‘) "{`}"]
1133                                [(#\’) "{'}"]
1134                                [(#\“) "{``}"]
1135                                [(#\”) "{''}"]
1136                                [(#\u2013) "{--}"]
1137                                [(#\u2014) "{---}"]
1138                                [(#\⟨ #\〈) "$\\langle$"] ; [MATHEMATICAL] LEFT ANGLE BRACKET
1139                                [(#\⟩ #\〉) "$\\rangle$"] ; [MATHEMATICAL] RIGHT ANGLE BRACKET
1140                                [(#\∞) "$\\infty$"]
1141                                [(#\⇓) "$\\Downarrow$"]
1142                                [(#\↖) "$\\nwarrow$"]
1143                                [(#\↓) "$\\downarrow$"]
1144                                [(#\⇒) "$\\Rightarrow$"]
1145                                [(#\→) "$\\rightarrow$"]
1146                                [(#\⟶) "$\\longrightarrow$"]
1147                                [(#\↘) "$\\searrow$"]
1148                                [(#\↙) "$\\swarrow$"]
1149                                [(#\←) "$\\leftarrow$"]
1150                                [(#\↑) "$\\uparrow$"]
1151                                [(#\⇐) "$\\Leftarrow$"]
1152                                [(#\−) "$\\longrightarrow$"]
1153                                [(#\⇑) "$\\Uparrow$"]
1154                                [(#\⇔) "$\\Leftrightarrow$"]
1155                                [(#\↕) "$\\updownarrow$"]
1156                                [(#\↔) "$\\leftrightarrow$"]
1157                                [(#\↗) "$\\nearrow$"]
1158                                [(#\↝) "$\\leadsto$"]
1159                                [(#\↱) "$\\Lsh$"]
1160                                [(#\↰) "$\\Rsh$"]
1161                                [(#\⇀) "$\\rightharpoonup$"]
1162                                [(#\↼) "$\\leftharpoonup$"]
1163                                [(#\⇁) "$\\rightharpoondown$"]
1164                                [(#\↽) "$\\leftharpoondown$"]
1165                                [(#\⇌) "$\\rightleftharpoons$"]
1166                                [(#\⇕) "$\\Updownarrow$"]
1167                                [(#\א) "$\\aleph$"]
1168                                [(#\′) "$\\prime$"]
1169                                [(#\∅) "$\\emptyset$"]
1170                                [(#\∇) "$\\nabla$"]
1171                                [(#\♦) "$\\diamondsuit$"]
1172                                [(#\♠) "$\\spadesuit$"]
1173                                [(#\♣) "$\\clubsuit$"]
1174                                [(#\♥) "$\\heartsuit$"]
1175                                [(#\♯) "$\\sharp$"]
1176                                [(#\♭) "$\\flat$"]
1177                                [(#\♮) "$\\natural$"]
1178                                [(#\√) "$\\surd$"]
1179                                [(#\∆) "$\\Delta$"] ; no better mapping for than \Delta for "increment"
1180                                [(#\u2211) "$\\sum$"] ; better than \Sigma, right?
1181                                [(#\u220F) "$\\prod$"] ; better than \Pi, right?
1182                                [(#\u2210) "$\\coprod$"]
1183                                [(#\u222B) "$\\int$"]
1184                                [(#\u222E) "$\\oint$"]
1185                                [(#\¬) "$\\neg$"]
1186                                [(#\△) "$\\triangle$"]
1187                                [(#\∀) "$\\forall$"]
1188                                [(#\∃) "$\\exists$"]
1189                                [(#\∘) "$\\circ$"]
1190                                [(#\∂) "$\\partial$"]
1191                                [(#\θ) "$\\theta$"]
1192                                [(#\ϑ) "$\\vartheta$"]
1193                                [(#\τ) "$\\tau$"]
1194                                [(#\υ) "$\\upsilon$"]
1195                                [(#\φ) "$\\varphi$"]
1196                                [(#\ϕ) "$\\phi$"]
1197                                [(#\δ) "$\\delta$"]
1198                                [(#\ρ) "$\\rho$"]
1199                                [(#\ϱ) "$\\varrho$"]
1200                                [(#\ϵ) "$\\epsilon$"]
1201                                [(#\ε) "$\\varepsilon$"]
1202                                [(#\ϖ) "$\\varpi$"]
1203                                [(#\χ) "$\\chi$"]
1204                                [(#\ψ) "$\\psi$"]
1205                                [(#\ζ) "$\\zeta$"]
1206                                [(#\ν) "$\\nu$"]
1207                                [(#\ω) "$\\omega$"]
1208                                [(#\η) "$\\eta$"]
1209                                [(#\ι) "$\\iota$"]
1210                                [(#\ξ) "$\\xi$"]
1211                                [(#\Γ) "$\\Gamma$"]
1212                                [(#\Ψ) "$\\Psi$"]
1213                                [(#\Δ) "$\\Delta$"]
1214                                [(#\Ξ) "$\\Xi$"]
1215                                [(#\Υ) "$\\Upsilon$"]
1216                                [(#\Ω) "$\\Omega$"]
1217                                [(#\Θ) "$\\Theta$"]
1218                                [(#\Π) "$\\Pi$"]
1219                                [(#\Φ) "$\\Phi$"]
1220                                [(#\±) "$\\pm$"]
1221                                [(#\∩) "$\\cap$"]
1222                                [(#\◇) "$\\diamond$"]
1223                                [(#\⊕) "$\\oplus$"]
1224                                [(#\∓) "$\\mp$"]
1225                                [(#\∪) "$\\cup$"]
1226                                [(#\△) "$\\bigtriangleup$"]
1227                                [(#\⊖) "$\\ominus$"]
1228                                [(#\×) "$\\times$"]
1229                                [(#\⊎) "$\\uplus$"]
1230                                [(#\▽) "$\\bigtriangledown$"]
1231                                [(#\⊗) "$\\otimes$"]
1232                                [(#\÷) "$\\div$"]
1233                                [(#\⊓) "$\\sqcap$"]
1234                                [(#\▹) "$\\triangleleft$"]
1235                                [(#\⊘) "$\\oslash$"]
1236                                [(#\∗) "$\\ast$"]
1237                                [(#\⊔) "$\\sqcup$"]
1238                                [(#\∨) "$\\vee$"]
1239                                [(#\∧) "$\\wedge$"]
1240                                [(#\◃) "$\\triangleright$"]
1241                                [(#\◊) "$\\Diamond$"]
1242                                [(#\⊙) "$\\odot$"]
1243                                [(#\★) "$\\star$"]
1244                                [(#\†) "$\\dagger$"]
1245                                [(#\•) "$\\bullet$"]
1246                                [(#\‡) "$\\ddagger$"]
1247                                [(#\≀) "$\\wr$"]
1248                                [(#\⨿) "$\\amalg$"]
1249                                [(#\≤) "$\\leq$"]
1250                                [(#\≥) "$\\geq$"]
1251                                [(#\≡) "$\\equiv$"]
1252                                [(#\⊨) "$\\models$"]
1253                                [(#\≺) "$\\prec$"]
1254                                [(#\≻) "$\\succ$"]
1255                                [(#\∼) "$\\sim$"]
1256                                [(#\⊥) "$\\perp$"]
1257                                [(#\≼) "$\\preceq$"]
1258                                [(#\≽) "$\\succeq$"]
1259                                [(#\≃) "$\\simeq$"]
1260                                [(#\≪) "$\\ll$"]
1261                                [(#\≫) "$\\gg$"]
1262                                [(#\≍) "$\\asymp$"]
1263                                [(#\∥) "$\\parallel$"]
1264                                [(#\⊂) "$\\subset$"]
1265                                [(#\⊃) "$\\supset$"]
1266                                [(#\≈) "$\\approx$"]
1267                                [(#\⋈) "$\\bowtie$"]
1268                                [(#\⊆) "$\\subseteq$"]
1269                                [(#\⊇) "$\\supseteq$"]
1270                                [(#\≌) "$\\cong$"] ;; this is wrong but left in for backwards compatibility
1271                                [(#\≅) "$\\cong$"]
1272                                [(#\⊏) "$\\sqsubset$"]
1273                                [(#\⊐) "$\\sqsupset$"]
1274                                [(#\≠) "$\\neq$"]
1275                                [(#\⌣) "$\\smile$"]
1276                                [(#\⊑) "$\\sqsubseteq$"]
1277                                [(#\⊒) "$\\sqsupseteq$"]
1278                                [(#\≐) "$\\doteq$"]
1279                                [(#\⌢) "$\\frown$"]
1280                                [(#\∈) "$\\in$"]
1281                                [(#\∉) "$\\not\\in$"]
1282                                [(#\∋) "$\\ni$"]
1283                                [(#\∝) "$\\propto$"]
1284                                [(#\⊢) "$\\vdash$"]
1285                                [(#\⊣) "$\\dashv$"]
1286                                [(#\☠) "$\\skull$"]
1287                                [(#\☺) "$\\smiley$"]
1288                                [(#\☻) "$\\blacksmiley$"]
1289                                [(#\☹) "$\\frownie$"]
1290                                [(#\ø) "{\\o}"]
1291                                [(#\Ø) "{\\O}"]
1292                                [(#\ł) "{\\l}"]
1293                                [(#\Ł) "{\\L}"]
1294                                [(#\uA7) "{\\S}"]
1295                                [(#\⟦ #\〚) "$[\\![$"]
1296                                [(#\⟧ #\〛) "$]\\!]$"]
1297                                [(#\↦) "$\\mapsto$"]
1298                                [(#\⊤) "$\\top$"]
1299                                [(#\¥) "{\\textyen}"]
1300                                [(#\™) "{\\texttrademark}"]
1301                                [(#\®) "{\\textregistered}"]
1302                                [(#\©) "{\\textcopyright}"]
1303                                [(#\u2070) "$^0$"]
1304                                [(#\u00b9) "$^1$"]
1305                                [(#\u00b2) "$^2$"]
1306                                [(#\u00b3) "$^3$"]
1307                                [(#\u2074) "$^4$"]
1308                                [(#\u2075) "$^5$"]
1309                                [(#\u2076) "$^6$"]
1310                                [(#\u2077) "$^7$"]
1311                                [(#\u2078) "$^8$"]
1312                                [(#\u2079) "$^9$"]
1313                                [(#\u207a) "$^+$"]
1314                                [(#\u207b) "$^-$"]
1315                                [(#\⋖) "$\\precdot$"]
1316                                [(#\⋗) "$\\succdot$"]
1317                                [(#\⋮) "\\vdots"]
1318                                [(#\⋱) "$\\ddots$"]
1319                                [(#\⋯) "$\\cdots$"]
1320                                [(#\⋯) "\\hdots"]
1321                                [(#\⊸) "$\\multimap$"]
1322                                [(#\⟜) "$\\multimapinv$"]
1323                                [(#\⅋) "$\\invamp$"]
1324                                [(#\□) "$\\square$"]
1325                                [else
1326                                 (cond
1327                                  [(char<=? #\uAC00 c #\uD7AF) ; Korean Hangul
1328                                   ;; This likely will not work right if it shows up in a section
1329                                   ;; title as a table-of-contents entry. Originally, this approach
1330                                   ;; was paired with the `tocstyle` package, which may have made it
1331                                   ;; work, but that package is now deprecated and does not seem to
1332                                   ;; solve the problem.
1333                                   (format "\\begin{CJK}{UTF8}{mj}~a\\end{CJK}" c)]
1334                                  [else
1335                                   ;; Detect characters that can be formed with combining characters
1336                                   ;; and translate them to Latex combinations:
1337                                   (define s (string-normalize-nfd (string c)))
1338                                   (define len (string-length s))
1339                                   (cond
1340                                    [(len . > . 1)
1341                                     (define combiner (case (string-ref s (sub1 len))
1342                                                        [(#\u300) "\\`{~a}"]
1343                                                        [(#\u301) "\\'{~a}"]
1344                                                        [(#\u302) "\\^{~a}"]
1345                                                        [(#\u303) "\\~~{~a}"]
1346                                                        [(#\u304) "\\={~a}"]
1347                                                        [(#\u306) "\\u{~a}"]
1348                                                        [(#\u307) "\\.{~a}"]
1349                                                        [(#\u308) "\\\"{~a}"]
1350                                                        [(#\u30a) "\\r{~a}"]
1351                                                        [(#\u30b) "\\H{~a}"]
1352                                                        [(#\u30c) "\\v{~a}"]
1353                                                        [(#\u327) "\\c{~a}"]
1354                                                        [(#\u328) "\\k{~a}"]
1355                                                        [else #f]))
1356                                     (define base (string-normalize-nfc (substring s 0 (sub1 len))))
1357                                     (if (and combiner
1358                                              (= 1 (string-length base)))
1359                                         (format combiner (char-loop (string-ref base 0)))
1360                                         c)]
1361                                    [else c])])]))
1362                          c)])))
1363                (loop (add1 i))))))]))
1364
1365
1366    (define/private (box-character c [line-thickness 1])
1367      (define (combine . args)
1368        (apply string-append
1369               "\\setlength{\\unitlength}{0.05em}"
1370               (if (= line-thickness 1)
1371                   ""
1372                   (format "\\linethickness{~apt}" (* 0.4 line-thickness)))
1373               (filter (λ (x) (not (regexp-match #rx"^[ \n]*$" x)))
1374                       (flatten args))))
1375      (define (adjust % v)
1376        (define num (* % (/ v 10) 10))
1377        (define i-part (floor num))
1378        (define d-part (floor (* 10 (- num i-part))))
1379        (format "~a.~a" i-part d-part))
1380      (define (x v) (adjust 1 v))
1381      (define (y v) (adjust 6/4 v))
1382      (define upper-horizontal @list{\put(@x[0],@y[6]){\line(1,0){@x[10]}}})
1383      (define mid-horizontal @list{\put(@x[0],@y[5]){\line(1,0){@x[10]}}})
1384      (define lower-horizontal @list{\put(@x[0],@y[4]){\line(1,0){@x[10]}}})
1385      (define righter-vertical @list{\put(@x[6],@y[10]){\line(0,-1){@y[10]}}})
1386      (define mid-vertical @list{\put(@x[5],@y[10]){\line(0,-1){@y[10]}}})
1387      (define lefter-vertical @list{\put(@x[4],@y[10]){\line(0,-1){@y[10]}}})
1388      (define bottom-right @list{\put(@x[6],@y[4]){\line(1,0){@x[4]}}
1389                                 \put(@x[6],@y[0]){\line(0,1){@y[4]}}})
1390      (define bottom-left @list{\put(@x[0],@y[4]){\line(1,0){@x[4]}}
1391                                \put(@x[4],@y[0]){\line(0,1){@y[4]}}})
1392      (define upper-right @list{\put(@x[6],@y[6]){\line(1,0){@x[4]}}
1393                                \put(@x[6],@y[10]){\line(0,-1){@y[4]}}})
1394      (define upper-left @list{\put(@x[0],@y[6]){\line(1,0){@x[4]}}
1395                               \put(@x[4],@y[10]){\line(0,-1){@y[4]}}})
1396      (define header @list{\begin{picture}(@x[10],@y[10])(0,0)})
1397      (define footer @list{\end{picture}})
1398
1399      (case c
1400        [(#\╔)
1401         @combine{@header
1402                   \put(@x[4],@y[6]){\line(1,0){@x[6]}}
1403                   \put(@x[4],@y[0]){\line(0,1){@y[6]}}
1404                   @bottom-right
1405                   @footer}]
1406        [(#\═) @combine{@header
1407                         @upper-horizontal
1408                         @lower-horizontal
1409                         @footer}]
1410        [(#\╗) @combine{@header
1411                         \put(@x[0],@y[6]){\line(1,0){@x[6]}}
1412                         \put(@x[6],@y[0]){\line(0,1){@y[6]}}
1413                         @bottom-left
1414                         @footer}]
1415        [(#\║) @combine{@header
1416                         @lefter-vertical
1417                         @righter-vertical
1418                         @footer}]
1419        [(#\╚) @combine{@header
1420                         @upper-right
1421                         \put(@x[4],@y[4]){\line(1,0){@x[6]}}
1422                         \put(@x[4],@y[10]){\line(0,-1){@y[6]}}
1423                         @footer}]
1424        [(#\╝)
1425         @combine{@header
1426                   @upper-left
1427                   \put(@x[0],@y[4]){\line(1,0){@x[6]}}
1428                   \put(@x[6],@y[10]){\line(0,-1){@y[6]}}
1429                   @footer}]
1430        [(#\╣)
1431         @combine{@header
1432                   @upper-left
1433                   @bottom-left
1434                   @righter-vertical
1435                   @footer}]
1436        [(#\╠)
1437         @combine{@header
1438                   @upper-right
1439                   @bottom-right
1440                   @lefter-vertical
1441                   @footer}]
1442        [(#\╩)
1443         @combine{@header
1444                   @upper-right
1445                   @upper-left
1446                   @lower-horizontal
1447                   @footer}]
1448        [(#\╦)
1449         @combine{@header
1450                   @bottom-right
1451                   @bottom-left
1452                   @upper-horizontal
1453                   @footer}]
1454        [(#\╬)
1455          @combine{@header
1456                   @upper-left
1457                   @bottom-left
1458                   @upper-right
1459                   @bottom-right
1460                   @footer}]
1461        [(#\┌ #\┏)
1462         @combine{@header
1463                   \put(@x[5],@y[5]){\line(1,0){@x[5]}}
1464                   \put(@x[5],@y[0]){\line(0,1){@y[5]}}
1465                   @footer}]
1466        [(#\─ #\━) @combine{@header
1467                        @mid-horizontal
1468                        @footer}]
1469        [(#\┐ #\┓) @combine{@header
1470                        \put(@x[0],@y[5]){\line(1,0){@x[5]}}
1471                        \put(@x[5],@y[0]){\line(0,1){@y[5]}}
1472                        @footer}]
1473        [(#\│ #\┃) @combine{@header
1474                        @mid-vertical
1475                        @footer}]
1476        [(#\└ #\┗) @combine{@header
1477                        \put(@x[5],@y[5]){\line(1,0){@x[5]}}
1478                        \put(@x[5],@y[10]){\line(0,-1){@y[5]}}
1479                        @footer}]
1480        [(#\┘ #\┛)
1481         @combine{@header
1482                  \put(@x[0],@y[5]){\line(1,0){@x[5]}}
1483                  \put(@x[5],@y[10]){\line(0,-1){@y[5]}}
1484                  @footer}]
1485        [(#\┤ #\┫)
1486         @combine{@header
1487                  \put(@x[0],@y[5]){\line(1,0){@x[5]}}
1488                  @mid-vertical
1489                  @footer}]
1490        [(#\├ #\┣)
1491         @combine{@header
1492                  \put(@x[5],@y[5]){\line(1,0){@x[5]}}
1493                  @mid-vertical
1494                  @footer}]
1495        [(#\┴ #\┻)
1496         @combine{@header
1497                  \put(@x[5],@y[10]){\line(0,-1){@y[5]}}
1498                  @mid-horizontal
1499                  @footer}]
1500        [(#\┬ #\┳)
1501         @combine{@header
1502                  \put(@x[5],@y[5]){\line(0,-1){@y[5]}}
1503                  @mid-horizontal
1504                  @footer}]
1505        [(#\┼ #\╋)
1506          @combine{@header
1507                   @mid-horizontal
1508                   @mid-vertical
1509                   @footer}]))
1510
1511    ;; ----------------------------------------
1512
1513    (define/override (table-of-contents sec ri)
1514      ;; FIXME: isn't local to the section
1515      (make-toc-paragraph plain null))
1516
1517    (define/override (local-table-of-contents part ri style)
1518      (make-paragraph plain null))))
1519