util.rkt (24911B)
1 #lang at-exp racket 2 3 (provide (rename-out [my-title title]) 4 (rename-out [my-author+email author+email]) 5 asection 6 atitle 7 aquote 8 quotation 9 htodo 10 todo 11 (rename-out [~cite* ~cite]) 12 citet 13 generate-bibliography-section 14 (rename-out [note* note]) 15 note. 16 define-footnote ;; TODO: does not use the (superscript …) 17 (all-from-out "abbreviations.rkt") 18 (all-from-out scribble-math) 19 $ 20 $$ 21 $p 22 version-text 23 aappendix 24 tex-header 25 tex-code 26 include-section* 27 include-asection 28 struct-update 29 part-style-update 30 epigraph 31 usetech 32 hr 33 lastname 34 tr<: 35 tr≤: 36 $ooo 37 $inferrule 38 $infertree 39 refrule 40 textsc 41 aligned 42 acase 43 cases 44 intertext 45 interpar 46 cases* 47 frac 48 where 49 textif 50 otherwise 51 quad 52 mathtext 53 textbf 54 textbfit 55 mathbfit 56 mathbm 57 textit 58 textrm 59 text 60 & 61 nl 62 tag* 63 tag) 64 65 (require racket/stxparam 66 racket/splicing 67 scribble/base 68 scribble/core 69 scriblib/bibtex 70 scriblib/footnote 71 scriblib/render-cond 72 racket/runtime-path 73 scribble-enhanced/math 74 scribble/latex-properties 75 scribble/decode 76 (except-in scribble-math $ $$) 77 phc-toolkit/untyped/meta-struct 78 "abbreviations.rkt" 79 "util0.rkt" 80 (for-syntax syntax/parse) 81 scribble/html-properties 82 scribble/latex-properties) 83 84 (use-mathjax) 85 86 (define-syntax struct-update 87 (syntax-parser 88 [(_ struct-type:id v:expr [field:id updater:expr] ...) 89 #'(let ([vv v]) 90 (struct-copy struct-type 91 vv 92 [field (updater ((struct-accessor struct-type field) vv))] 93 ...))])) 94 95 96 (define (tex-header . tex*) 97 (elem #:style (style #f (list (tex-addition (string->bytes/utf-8 98 (apply string-append tex*))))))) 99 100 (define scribble-tex-commands-addition 101 (tex-addition 102 (string->bytes/utf-8 "\\newcommand{\\scribbleTeXCommands}[1]{#1}"))) 103 104 (define (tex-code code) 105 (cond-element 106 [latex (elem #:style (style "scribbleTeXCommands" 107 (list 'exact-chars 108 scribble-tex-commands-addition)) 109 code)] 110 [else (list)])) 111 112 (define (my-author+email author email) 113 (cond-element 114 [html (author+email author email)] 115 ;; TODO: urlencode the email maybe? 116 [latex (list (hyperlink (string-append "mailto:" email) author) 117 (note (hyperlink (string-append "mailto:" email) email)))] 118 [else (author+email author email)] 119 )) 120 121 (define (version-text [prefix ""] [postfix ""]) 122 (with-handlers ([(λ (e) (eq? e 'git-failure)) 123 (λ (e) 124 ;; unknown version (for now, just put the empty string). 125 "")]) 126 (define stderr (open-output-string)) 127 (define result 128 (parameterize ([current-error-port stderr] 129 [current-input-port (open-input-string "")]) 130 (string-append 131 prefix 132 ;(tt 133 (string-trim 134 (with-output-to-string 135 (λ () 136 (let ([git (find-executable-path "git")]) 137 (unless (system* git "show" "-s" "--date=short" "--format=%cd" 138 "HEAD") 139 (raise 'git-failure)))))) 140 "-" "-" 141 (string-trim 142 (with-output-to-string 143 (λ () 144 (let ([git (find-executable-path "git")]) 145 (unless (system* git "rev-parse" "--short" "HEAD") 146 (raise 'git-failure)))))) 147 (if (non-empty-string? 148 (string-trim 149 (with-output-to-string 150 (λ () 151 (let ([git (find-executable-path "git")]) 152 (unless (system* git "diff" "--shortstat") 153 (raise 'git-failure))))))) 154 "x" 155 "") 156 "-" "-" 157 (version);) 158 postfix))) 159 (if (non-empty-string? (get-output-string stderr)) 160 (begin (displayln (get-output-string stderr)) 161 (raise 'git-failure)) 162 result))) 163 164 ;; TODO: merge the handling of unicode chars into scribble-math. 165 (define m 166 (list setup-math 167 (tex-header #<<EOTEX 168 % DRAFT ONLY 169 \overfullrule=1cm\relax 170 171 172 \def\ifmathjax#1{}\def\iflatex#1{#1} 173 \renewcommand{\rmdefault}{cmr} 174 \newenvironment{qaligned}{% 175 \begin{array}[t]{@{}r@{}c@{}l@{}}% 176 }{% 177 \end{array} 178 }% 179 \def\overrightbracedarrow#1{% 180 \overset{\raisebox{-0.75pt}[\height][-0.75pt]{% 181 $\scriptscriptstyle{\{}$}}{\vphantom{#1}% 182 }% 183 \overrightarrow{#1}% 184 \overset{\raisebox{-0.75pt}[\height][-0.75pt]{% 185 $\scriptscriptstyle{\}}$}}{\vphantom{#1}% 186 }% 187 }% 188 \usepackage{bm} 189 % Newline necessary here: 190 191 EOTEX 192 ) 193 (elem #:style (style #f (list (css-addition 194 #"html .NoteBox { 195 height: auto; 196 clear: right; 197 margin-bottom: 1em; 198 } 199 200 html .MathJax_Display, html div.MathJax_Preview { 201 margin: 2em 0; 202 }")))) 203 @${\def\ifmathjax#1{#1}\def\iflatex#1{}})) 204 (define my-title 205 ;; TODO: use this for the other wrapped procs in this file 206 (make-keyword-procedure 207 (λ (kws kw-args . rest) 208 (list m 209 (keyword-apply title kws kw-args rest))))) 210 211 (define counter 0) 212 (define (counter!) 213 (set! counter (add1 counter)) 214 counter) 215 216 (define (note* . content) 217 (cond-element 218 [html (let ([c (number->string (counter!))]) 219 (list (superscript c) 220 (apply note 221 (list (superscript c) ~ content))))] 222 [latex (apply note content)] 223 [else (apply note content)])) 224 225 (define (note. . content) 226 ;; TODO: move the . a bit to the left, or place the footnote number 227 ;; after it, also shifted a bit to the left. 228 (list (apply note* content) ".")) 229 230 (define-runtime-path bib-path "bibliography.bib") 231 (define-bibtex-cite bib-path 232 ~cite 233 citet 234 generate-bibliography-section) 235 236 (define-syntax-parameter asection-current-level 0) 237 (define-syntax-rule (asection . body) 238 (splicing-syntax-parameterize ([asection-current-level 239 (add1 (syntax-parameter-value 240 #'asection-current-level))]) 241 . body)) 242 243 (define-syntax-parameter asection-current-is-appendix #f) 244 (define-syntax-rule (aappendix . body) 245 (splicing-syntax-parameterize ([asection-current-is-appendix #t]) 246 (appendix) 247 . body)) 248 249 250 ;; Alpha numbering of appendices in HTML and TeX 251 (define (num->alpha current parents) 252 (define letters 253 (vector->immutable-vector 254 (vector-map 255 symbol->string 256 #(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)))) 257 258 (define cur (sub1 current)) 259 260 (define-values (oldlimit len) 261 (let loop ([oldlimit 0] 262 [limit 26] 263 [len 1]) 264 (if (< cur limit) 265 (values oldlimit len) 266 (loop limit (+ (* limit 26) 26) (add1 len))))) 267 268 (let-values ([(_ ans) (for/fold ([v (- cur oldlimit)] 269 [ans '()]) 270 ([i (in-range len)]) 271 (define-values (q r) (quotient/remainder v 26)) 272 (values q 273 (cons (vector-ref letters r) ans)))]) 274 (values (list (string-join ans "") ".") 275 (add1 current)))) 276 (define appendix-numberer 277 (make-numberer num->alpha 278 1)) 279 280 (define (part-style-update p updater) 281 (define (style-updater old-style) 282 (struct-update 283 style 284 old-style 285 [properties updater])) 286 (if (part-start? p) 287 (struct-update part-start p [style style-updater]) 288 (struct-update part p [style style-updater]))) 289 290 ;; make-appendix-section must be called by @atitle below 291 (define (make-appendix-section p) 292 (part-style-update p (λ (old-props) 293 (cons appendix-numberer 294 old-props)))) 295 (define (appendix) 296 (list 297 (section #:style (style #f (list 'hidden 'toc-hidden 'unnumbered))) 298 (tex-header 299 "\\usepackage{alphalph}") 300 (tex-code 301 "\\appendix\\renewcommand\\thesection{\\AlphAlph{\\value{section}}}"))) 302 303 (define-syntax (atitle stx) 304 (syntax-case stx () 305 [(_ . args) 306 (case (syntax-parameter-value #'asection-current-level) 307 [(0) #'(my-title . args)] 308 [(1) (if (syntax-parameter-value #'asection-current-is-appendix) 309 #'(make-appendix-section (section . args)) 310 #'(section . args))] 311 [(2) #'(subsection . args)] 312 [(3) #'(subsubsection . args)] 313 [else 314 ;; TODO: log a warning here maybe? 315 #'(subsubsub*section . args)])])) 316 317 (define-syntax (include-section* stx) 318 (syntax-case stx () 319 [(_ mod) 320 (with-syntax ([doc (datum->syntax #'mod 'doc #'mod)]) 321 #'(let () 322 (local-require (only-in mod doc)) 323 doc))])) 324 325 (define-syntax (include-asection stx) 326 (syntax-case stx () 327 [(_ mod) 328 (if (syntax-parameter-value #'asection-current-is-appendix) 329 #'(make-appendix-section (include-section* mod)) 330 #'(include-section* mod))])) 331 332 333 ;; hidden todo: 334 (define (htodo . args) (list)) 335 336 ;; todo: 337 (define (coloured-elem colour . content) 338 (elem #:style (style #f (list (color-property colour))) content)) 339 (define (todo . args) 340 (list (coloured-elem "gray" "[") 341 args 342 (coloured-elem "gray" "]" (superscript "Todo")))) 343 344 (define quote-quotation-css (string->bytes/utf-8 #<<EOCSS 345 .quote, 346 .quotation { 347 background: #eee; 348 padding: 0.885rem 1.18em; /* 0.75 and 1 ×main font-size */ 349 margin-left: 2.36rem; /* 2×main font-size */ 350 margin-right: 2.36rem; /* 2×main font-size */ 351 margin-top: 1.77rem; /* 1.5×main font-size */ 352 quotes: "“" "”" "‘" "’"; 353 } 354 355 .quote > p:last-child, 356 .quotation > p:last-child { 357 margin-bottom: 0; 358 } 359 360 .quote-old:before, 361 .quotation-old:before { 362 content: open-quote; 363 color:gray; 364 font-size: 200%; 365 float: left; 366 margin-left: -0.45em; 367 margin-top: -0.25em; 368 } 369 370 .quote:before, 371 .quotation:before { 372 content: open-quote; 373 color: gray; 374 font-size: 2.36rem; /* 2×outer font-size */ 375 float: left; 376 background: #eee; 377 border-radius: 1.77rem; /* 1.5×outer font-size */ 378 width: 3.54rem; /* 3×outer font-size */ 379 height: 2.36rem; /* 2×outer font-size */ 380 text-align: center; 381 padding: 0.826rem 0 0.354rem; /* 0.7, 0 and 0.3 ×outer font-size */ 382 display: inline-block; 383 margin-left: -2.95rem; /* -2.5×outer font-size */ 384 margin-top: -2.36rem; /* -2×outer font-size */ 385 margin-right: -2.95rem; /* -2.5×outer font-size */ 386 } 387 388 .quote:after, 389 .quotation:after { 390 content: close-quote; 391 color: gray; 392 font-size: 2.36rem; /* 2×outer font-size */ 393 float: right; 394 margin-right: -0.295rem; /* -0.25×outer font-size */ 395 margin-top: -1.18rem; /* -1×outer font-size */ 396 } 397 398 EOCSS 399 )) 400 401 (define (aquote . content) 402 (apply nested 403 #:style (style "quote" (list (css-addition quote-quotation-css))) 404 content #;(list (paragraph content)))) 405 406 (define (quotation . content) 407 (apply nested 408 #:style (style "quotation" (list (css-addition quote-quotation-css))) 409 content)) 410 411 (define (~cite* #:precision [precision #f] . rest) 412 (if precision 413 (list (apply ~cite rest) ", " precision) 414 (apply ~cite rest))) 415 416 (define epigraph-css 417 #" 418 .epigraphStyle p:last-child { 419 padding-bottom: 0.2em; 420 margin-bottom: 0; 421 } 422 423 .epigraphAuthorStyle p:first-child { 424 padding-top: 0; 425 margin-top: 0; 426 } 427 428 .epigraphOuter { 429 text-align: right; 430 display: table; 431 margin-right: 0; 432 padding-right: 0; 433 margin-left: auto; 434 } 435 436 .epigraphStyle { 437 display: table-cell; 438 border-bottom: thin solid gray; 439 font-style: italic; 440 } 441 442 .epigraphAuthorStyle { 443 display: table-cell; 444 padding-top: 0.5em; 445 } 446 447 .epigraphOuter > .SIntrapara { 448 margin: 0; 449 display: table-row; 450 } 451 452 .epigraphOuter * { 453 margin-right: 0; 454 padding-right: 0; 455 margin-left: 0; 456 padding-left: 0; 457 } 458 ") 459 460 (define epigraph-tex 461 (string->bytes/utf-8 462 #<<EOTEX 463 \usepackage{epigraph} 464 \usepackage{environ} 465 \def\lastepigraph{} 466 \def\lastepigraphauthor{} 467 \newenvironment{epigraphOuter}{}{} 468 \def\setepigraphwidth#1{\setlength{\epigraphwidth}{#1}} 469 \NewEnviron{epigraphStyle}{\global\let\lastepigraph\BODY} 470 \NewEnviron{epigraphAuthorStyle}{% 471 \global\let\lastepigraphauthor\BODY% 472 473 \epigraph{\emph{\lastepigraph}}{\lastepigraphauthor}% 474 } 475 EOTEX 476 )) 477 478 (define epigraph-additions 479 (list (css-addition epigraph-css) 480 (tex-addition epigraph-tex))) 481 482 (define (epigraph #:width [width "6cm"] author . rest) 483 (nested #:style (style "epigraphOuter" 484 '() 485 #;(list 486 (attributes 487 `([style . ,(format "max-width: ~a;" width)])))) 488 (cond-element 489 [latex (elem #:style (style "setepigraphwidth" '()) width)] 490 [else (elem)]) 491 (apply nested #:style (style "epigraphStyle" epigraph-additions) 492 rest) 493 (nested #:style (style "epigraphAuthorStyle" epigraph-additions) 494 author))) 495 496 ;; For now, do not perform any check. Later on, we may verify automatically that 497 ;; a usetech always happens after the corresponding deftech. 498 (define usetech list) 499 500 (define hr 501 (elem #:style (style "hrStyle" 502 (list (alt-tag "hr") 503 (css-addition 504 #".hrStyle { margin-bottom: 1em; }") 505 (tex-addition 506 (string->bytes/utf-8 #<<EOTEX 507 \def\hrStyle#1{\noindent{\centerline{\rule[0.5ex]{0.5\linewidth}{0.5pt}}}} 508 EOTEX 509 )))))) 510 511 (define lastname list) 512 513 (define tr<: ($ "\\mathrel{<:_\\mathit{tr}}")) 514 (define tr≤: ($ "\\mathrel{≤:_\\mathit{tr}}")) 515 (define $ooo ($ (mathtext "\\textit{ooo}"))) 516 517 (define ($inferrule from* to* #:wide [wide? #f] [label '()] #:* [*? #f]) 518 (define-syntax-rule (if-wide wide not-wide) 519 (cond 520 [(eq? wide? #t) 521 wide] 522 [(eq? wide? #f) 523 not-wide] 524 [else 525 (cond-element 526 [html (if (eq? wide? 'html) wide not-wide)] 527 [else (if (eq? wide? 'latex) wide not-wide)])])) 528 @$$[ 529 (elem #:style 530 (style #f (list (tex-addition 531 (string->bytes/utf-8 532 (string-append 533 "\\usepackage{mathpartir}" 534 "\\AtBeginDocument{\\global\\let\\savedamp&}"))))) 535 ($ (if-wide 536 @${\begin{aligned}\vphantom{x}&@|label|\\ \vphantom{x}&} 537 '()) 538 (cond-element [html "\\frac{\\begin{gathered}"] 539 [else (list "\\inferrule" (if *? "*" "") "{")]) 540 (if (eq? from* -) "\\vphantom{x}" from*) 541 (cond-element [html "\\end{gathered}}{\\begin{gathered}"] 542 [else "}{"]) 543 (if (eq? to* -) "\\vphantom{x}" to*) 544 (cond-element [html "\\end{gathered}}"] 545 [else "}"]) 546 (if-wide 547 "\\end{aligned}" 548 (list @${\ } label))))]) 549 550 ;; Temporary placeholder, will add linking and propper names later. 551 (define-syntax-rule (refrule name) name) 552 553 (begin-for-syntax 554 (define-syntax-class inferimpl 555 #:attributes (x) 556 (pattern {~and x ({~literal refrule} _rule)}) 557 (pattern {~and x ({~literal $} . _)}) 558 (pattern (from:inferimpl ... 559 {~literal ⇒} 560 to:expr 561 {~optional label:expr}) 562 #:with x #`(cond-element 563 [html 564 @${\begin{array}[b]{c} 565 @(add-between (list from.x ...) "\\quad{}") 566 \\\hline 567 @to 568 \end{array} 569 @#,@(if (attribute label) 570 #'{@list{\ \smash{ 571 \begin{array}[c]{c} 572 @label 573 \\[1ex] 574 \vphantom{@to} 575 \end{array}}}} 576 #'{})}] 577 [else @$inferrule[(add-between (list from.x ...) "\\ ") 578 to 579 #,@(if (attribute label) 580 #'{@list{\ @label}} 581 #'{}) 582 #:* #t]])))) 583 (define-syntax $infertree 584 (syntax-parser 585 [(_ . :inferimpl) 586 #'@$${@x}])) 587 588 (define htmldiff-css-experiment #<<EOCSS 589 .version:after { 590 display:block; 591 content: "."; 592 color: blue; 593 background: blue; 594 width: 1rem; 595 position: fixed; 596 right: 1rem; 597 height: 284427px; 598 opacity: 0.15; 599 z-index: 1 600 } 601 602 .changed:after { 603 content: "."; 604 color: orange; 605 background: orange; 606 width: 1rem; 607 position: absolute; 608 right: 1rem; 609 z-index: 100; 610 } 611 612 .changed { 613 background: orange; 614 } 615 EOCSS 616 ) 617 618 (define (textsc str) 619 ($ (cond-element 620 [html (list "{\\rm " 621 (for/list ([c (in-string str)]) 622 (cond 623 [(char=? c #\-) 624 (mathtext "\\text{-}")] 625 [(char-upper-case? c) 626 (string c)] 627 [else (list "{\\small " 628 (string (char-upcase c)) 629 "}")])) 630 "}")] 631 [else (list (mathtext "\\text{\\textsc{" str "}}"))]))) 632 633 (define (aligned #:valign [valign 'mid] . lines) 634 (define valign-letter (case valign [(top) "t"] [(mid) "m"] [(bot) "b"])) 635 @$${ 636 \begin{aligned}[@valign-letter] 637 @lines 638 \end{aligned} 639 }) 640 641 (define acase list) 642 (define cases 643 (λ (#:first-sep [first-sep "\\vphantom{x}\\mathbin{:=}\\vphantom{x}"] 644 #:then-sep [then-sep "\\mathrel{|}"] 645 term 646 . the-cases) 647 (define first-sep* (list "{}" first-sep "{}")) 648 (define then-sep* (list "{}" then-sep "{}")) 649 @$${ 650 \begin{qaligned} 651 @(add-between 652 (for/list ([c (in-list the-cases)] 653 [i (in-naturals)]) 654 (list (if (= i 0) term '()) 655 " & " 656 (if (= i 0) first-sep* then-sep*) 657 " & " 658 c)) 659 "\\\\\n") 660 \end{qaligned}} 661 #;($$ (list 662 term 663 (aligned #:valign 'top 664 @(for/list ([c (in-list the-cases)] 665 [i (in-naturals)]) 666 (list (minwidth (list first-sep* then-sep*) 667 (if (= i 0) first-sep* then-sep*)) 668 " & " 669 c 670 (if (= i (sub1 (length the-cases))) "" "\\\\\n"))) 671 ))))) 672 (require (for-syntax racket/base 673 racket/contract/base 674 syntax/parse 675 syntax/parse/experimental/template)) 676 (define-syntax (intertext stx) 677 (syntax-case stx () 678 [(_ . l) (eq? (syntax-local-context) 'module) 679 #'(begin . l)] 680 [(_ . l) 681 #'(list (mathtext "\\text{" l "}"))])) 682 (define-syntax-rule (interpar l ...) (intertext "\n" "\n" l ... "\n" "\n")) 683 (define (array<l>-no-extra-h-space lst) 684 (list "\\!\\begin{array}{l}" 685 (add-between lst "\\\\") 686 "\\end{array}\\!")) 687 (define (minwidth phantoms realcontent) 688 (list "\\rlap{" realcontent "}" 689 @$${\hphantom{@array<l>-no-extra-h-space[phantoms]}})) 690 (begin-for-syntax 691 (define-syntax-class acase-cls 692 (pattern ({~and self {~literal acase}} 693 {~and arg {~not ({~or {~literal tag} {~literal tag*}} . _)}} ... 694 {~optional ({~and tag-id {~or {~literal tag} {~literal tag*}}} 695 . tag-args)}) 696 #:with phantom-tag 697 #`(self arg ... 698 . #,(if (attribute tag-id) 699 #'{(tag-id #:phantom? #t . tag-args)} 700 #'()))))) 701 (define-syntax cases* 702 (syntax-parser 703 #:literals (intertext interpar) 704 [(_ term 705 {~optional {~seq #:first-sep first-sep}} 706 {~optional {~seq #:then-sep then-sep}} 707 {~optional {~and inter₀ ({~or intertext interpar} . _)}} 708 (~seq acaseᵢ₀:acase-cls 709 acaseᵢⱼ:acase-cls ... 710 {~and interᵢ [{~or intertext interpar} . _]}) 711 ... 712 acaseₙ₀:acase-cls 713 acaseₙⱼ:acase-cls ...) 714 #:with (tmpᵢ ...) (generate-temporaries #'((acaseᵢⱼ ...) ...)) 715 (quasitemplate 716 (#,(if ((or/c 'expression list?) (syntax-local-context)) #'list #'begin) 717 (define phantoms 718 (list (?@ acaseᵢ₀.phantom-tag acaseᵢⱼ.phantom-tag ...) 719 ... 720 (?? (?@ acaseₙ₀.phantom-tag acaseₙⱼ.phantom-tag ...)))) 721 (define tmpᵢ @cases[term 722 (?? (?@ #:first-sep first-sep)) 723 (?? (?@ #:then-sep then-sep)) 724 (minwidth phantoms acaseᵢ₀) 725 acaseᵢⱼ 726 ...]) 727 ... 728 (?? (define tmpₙ @cases[term 729 (?? (?@ #:first-sep first-sep)) 730 (?? (?@ #:then-sep then-sep)) 731 (minwidth phantoms acaseₙ₀) 732 acaseₙⱼ 733 ...])) 734 (?? inter₀) 735 (?@ tmpᵢ interᵢ) 736 ... 737 tmpₙ 738 ))])) 739 740 (define (frac x . y) 741 @list{\frac{@x}{@y}}) 742 (define where @mathtext{\text{ where }}) 743 (define textif @mathtext{\text{ if }}) 744 (define otherwise @mathtext{\text{ otherwise }}) 745 (define quad @${\quad}) 746 (define (textbf . l) ($ (mathtext "\\textbf{" l "}"))) 747 (define (textbfit . l) 748 (cond-element 749 [html ($ (mathtext "{\\bfit \\text{" l "}}"))] 750 [else ($ (mathtext "\\textbf{\\textit{" l "}}"))])) 751 (define (mathbfit . l) 752 (cond-element 753 [html ($ "{\\bfit " l "}")] 754 [else ($ "\\bm{\\mathit{" l "}}")])) 755 (define (mathbm . l) 756 (cond-element 757 [html ($ "{\\mathbf{" l "}}")] 758 [else ($ "\\bm{\\mathrm{" l "}}")])) 759 (define (textit . l) ($ (mathtext "\\textit{" l "}"))) 760 (define (textrm . l) ($ (mathtext "\\textrm{" l "}"))) 761 (define (text . l) ($ (mathtext "\\text{" l "}"))) 762 763 ;; In some cases, LaTeX doesn't like the use of the regular & and \\ because 764 ;; they were redefined (mostly when placing arrays or cases within an inferrule. 765 ;; For now, we just use this simple workaround 766 (define & @cond-element[[latex "\\savedamp"] [else "&"]]) 767 (define nl @cond-element[[latex "\\csname @arraycr\\endcsname"] [else "\\\\"]]) 768 769 (define-runtime-path tikztag.sty "../tikztag.sty") 770 (define ((tag** starred?) #:phantom? [phantom? #f] . txt) 771 (cond-element 772 [html (list* "\\hphantom{" 773 (text (if starred? "" "(") 774 txt 775 (if starred? "" ")")) 776 "}" 777 (if phantom? 778 '() 779 (list "\\tag*{" 780 (mathtext 781 ($ "\\llap{" 782 (text (if starred? "" "(") 783 txt 784 (if starred? "" ")")) 785 "}")) 786 "}")))] 787 [latex (elem #:style (style #f (list (tex-addition 788 ;; The \n are important in case the 789 ;; file does not end with a newline 790 ;; but ends with a comment (it gobbles 791 ;; the \makeatother and the following 792 ;; commands if there are no \n. 793 (bytes-append #"\n\\makeatletter\n" 794 (file->bytes tikztag.sty) 795 #"\n\\makeatother\n")))) 796 (list* "\\hphantom{\\text{" @mathtext[txt] "}}" 797 (if phantom? 798 '() 799 (list "\\tikztag" (if starred? "*" "") "{" 800 @mathtext[txt] 801 "}"))))] 802 [else (if phantom? '() (list " (" txt ")"))])) 803 804 (define tag (tag** #f)) 805 (define tag* (tag** #t))