~ chicken-core (master) /tests/slatex.scm
Trap1(declare (standard-bindings) (extended-bindings)2 (fixnum) (not safe) (block))34(define slatex-iters 20)56(define (fatal-error . args)7 (for-each display args)8 (newline)9 (exit 1))1011 (define (call-with-output-file/truncate filename proc)12 (call-with-output-file filename proc))1314(define (run-bench name count ok? run)15 (let loop ((i count) (result '(undefined)))16 (if (< 0 i)17 (loop (- i 1) (run))18 result)))1920(define (run-benchmark name count ok? run-maker . args)21 (newline)22 (let* ((run (apply run-maker args))23 (result (run-bench name count ok? run)))24 (if (not (ok? result))25 (begin26 (display "*** wrong result ***")27 (newline)28 (display "*** got: ")29 (pp result)30 (newline))))31 (exit 0))3233;;; SLATEX -- Scheme to Latex processor.3435;slatex.scm file generated using config.scm36;This file is compatible for the dialect other37;(c) Dorai Sitaram, Rice U., 1991, 19943839(define *op-sys* 'unix)4041(define slatex.ormap42 (lambda (f l)43 (let loop ((l l)) (if (null? l) #f (or (f (car l)) (loop (cdr l)))))))4445(define slatex.ormapcdr46 (lambda (f l)47 (let loop ((l l)) (if (null? l) #f (or (f l) (loop (cdr l)))))))4849(define slatex.append!50 (lambda (l1 l2)51 (cond ((null? l1) l2)52 ((null? l2) l1)53 (else54 (let loop ((l1 l1))55 (if (null? (cdr l1)) (set-cdr! l1 l2) (loop (cdr l1))))56 l1))))5758(define slatex.append-map!59 (lambda (f l)60 (let loop ((l l))61 (if (null? l) '() (slatex.append! (f (car l)) (loop (cdr l)))))))6263(define slatex.remove-if!64 (lambda (p s)65 (let loop ((s s))66 (cond ((null? s) '())67 ((p (car s)) (loop (cdr s)))68 (else (let ((r (loop (cdr s)))) (set-cdr! s r) s))))))6970(define slatex.reverse!71 (lambda (s)72 (let loop ((s s) (r '()))73 (if (null? s) r (let ((d (cdr s))) (set-cdr! s r) (loop d s))))))7475(define slatex.list-set!76 (lambda (l i v)77 (let loop ((l l) (i i))78 (cond ((null? l) (slatex.error 'slatex.list-set! 'list-too-small))79 ((= i 0) (set-car! l v))80 (else (loop (cdr l) (- i 1)))))))8182(define slatex.list-prefix?83 (lambda (pfx l)84 (cond ((null? pfx) #t)85 ((null? l) #f)86 ((eqv? (car pfx) (car l)) (slatex.list-prefix? (cdr pfx) (cdr l)))87 (else #f))))8889(define slatex.string-prefix?90 (lambda (pfx s)91 (let ((pfx-len (string-length pfx)) (s-len (string-length s)))92 (if (> pfx-len s-len)93 #f94 (let loop ((i 0))95 (if (>= i pfx-len)96 #t97 (and (char=? (string-ref pfx i) (string-ref s i))98 (loop (+ i 1)))))))))99100(define slatex.string-suffix?101 (lambda (sfx s)102 (let ((sfx-len (string-length sfx)) (s-len (string-length s)))103 (if (> sfx-len s-len)104 #f105 (let loop ((i (- sfx-len 1)) (j (- s-len 1)))106 (if (< i 0)107 #t108 (and (char=? (string-ref sfx i) (string-ref s j))109 (loop (- i 1) (- j 1)))))))))110111(define slatex.member-string member)112113(define slatex.adjoin-string114 (lambda (s l) (if (slatex.member-string s l) l (cons s l))))115116(define slatex.remove-string!117 (lambda (s l) (slatex.remove-if! (lambda (l_i) (string=? l_i s)) l)))118119(define slatex.adjoin-char (lambda (c l) (if (memv c l) l (cons c l))))120121(define slatex.remove-char!122 (lambda (c l) (slatex.remove-if! (lambda (l_i) (char=? l_i c)) l)))123124(define slatex.sublist125 (lambda (l i f)126 (let loop ((l (list-tail l i)) (k i) (r '()))127 (cond ((>= k f) (slatex.reverse! r))128 ((null? l) (slatex.error 'slatex.sublist 'list-too-small))129 (else (loop (cdr l) (+ k 1) (cons (car l) r)))))))130131(define slatex.position-char132 (lambda (c l)133 (let loop ((l l) (i 0))134 (cond ((null? l) #f)135 ((char=? (car l) c) i)136 (else (loop (cdr l) (+ i 1)))))))137138(define slatex.string-position-right139 (lambda (c s)140 (let ((n (string-length s)))141 (let loop ((i (- n 1)))142 (cond ((< i 0) #f)143 ((char=? (string-ref s i) c) i)144 (else (loop (- i 1))))))))145146(define slatex.token=?147 (lambda (t1 t2)148 ((if slatex.*slatex-case-sensitive?* string=? string-ci=?) t1 t2)))149150(define slatex.assoc-token151 (lambda (x s)152 (slatex.ormap (lambda (s_i) (if (slatex.token=? (car s_i) x) s_i #f)) s)))153154(define slatex.member-token155 (lambda (x s)156 (slatex.ormapcdr157 (lambda (s_i..) (if (slatex.token=? (car s_i..) x) s_i.. #f))158 s)))159160(define slatex.remove-token!161 (lambda (x s) (slatex.remove-if! (lambda (s_i) (slatex.token=? s_i x)) s)))162163(define slatex.file-exists? (lambda (f) #t))164165(define slatex.delete-file (lambda (f) 'assume-file-deleted))166167(define slatex.force-output (lambda z 'assume-output-forced))168169(define slatex.*return* (integer->char 13))170171(define slatex.*tab* (integer->char 9))172173(define slatex.error174 (lambda (error-type error-values)175 (display "Error: ")176 (display error-type)177 (display ": ")178 (newline)179 (for-each (lambda (x) (write x) (newline)) error-values)180 (fatal-error "")))181182(define slatex.keyword-tokens183 (map symbol->string184 '(=> %185 abort186 and187 begin188 begin0189 case190 case-lambda191 cond192 define193 define!194 define-macro!195 define-syntax196 defrec!197 delay198 do199 else200 extend-syntax201 fluid-let202 if203 lambda204 let205 let*206 letrec207 let-syntax208 letrec-syntax209 or210 quasiquote211 quote212 rec213 record-case214 record-evcase215 recur216 set!217 sigma218 struct219 syntax220 syntax-rules221 trace222 trace-lambda223 trace-let224 trace-recur225 unless226 unquote227 unquote-splicing228 untrace229 when230 with)))231232(define slatex.variable-tokens '())233234(define slatex.constant-tokens '())235236(define slatex.special-symbols237 (list (cons "." ".")238 (cons "..." "{\\dots}")239 (cons "-" "$-$")240 (cons "1-" "\\va{1$-$}")241 (cons "-1+" "\\va{$-$1$+$}")))242243(define slatex.macro-definers244 '("define-syntax" "syntax-rules" "defmacro" "extend-syntax" "define-macro!"))245246(define slatex.case-and-ilk '("case" "record-case"))247248(define slatex.tex-analog249 (lambda (c)250 (cond ((memv c '(#\$ #\& #\% #\# #\_)) (string #\\ c))251 ((memv c '(#\{ #\})) (string #\$ #\\ c #\$))252 ((char=? c #\\) "$\\backslash$")253 ((char=? c #\+) "$+$")254 ((char=? c #\=) "$=$")255 ((char=? c #\<) "$\\lt$")256 ((char=? c #\>) "$\\gt$")257 ((char=? c #\^) "\\^{}")258 ((char=? c #\|) "$\\vert$")259 ((char=? c #\~) "\\~{}")260 ((char=? c #\@) "{\\atsign}")261 ((char=? c #\") "{\\tt\\dq}")262 (else (string c)))))263264(define slatex.*slatex-case-sensitive?* #t)265266(define slatex.*slatex-enabled?* #t)267268(define slatex.*slatex-reenabler* "UNDEFINED")269270(define slatex.*intext-triggerers* (list "scheme"))271272(define slatex.*resultintext-triggerers* (list "schemeresult"))273274(define slatex.*display-triggerers* (list "schemedisplay"))275276(define slatex.*box-triggerers* (list "schemebox"))277278(define slatex.*input-triggerers* (list "schemeinput"))279280(define slatex.*region-triggerers* (list "schemeregion"))281282(define slatex.*math-triggerers* '())283284(define slatex.*slatex-in-protected-region?* #f)285286(define slatex.*protected-files* '())287288(define slatex.*include-onlys* 'all)289290(define slatex.*latex?* #t)291292(define slatex.*slatex-separate-includes?* #f)293294(define slatex.set-keyword295 (lambda (x)296 (if (slatex.member-token x slatex.keyword-tokens)297 'skip298 (begin299 (set! slatex.constant-tokens300 (slatex.remove-token! x slatex.constant-tokens))301 (set! slatex.variable-tokens302 (slatex.remove-token! x slatex.variable-tokens))303 (set! slatex.keyword-tokens (cons x slatex.keyword-tokens))))))304305(define slatex.set-constant306 (lambda (x)307 (if (slatex.member-token x slatex.constant-tokens)308 'skip309 (begin310 (set! slatex.keyword-tokens311 (slatex.remove-token! x slatex.keyword-tokens))312 (set! slatex.variable-tokens313 (slatex.remove-token! x slatex.variable-tokens))314 (set! slatex.constant-tokens (cons x slatex.constant-tokens))))))315316(define slatex.set-variable317 (lambda (x)318 (if (slatex.member-token x slatex.variable-tokens)319 'skip320 (begin321 (set! slatex.keyword-tokens322 (slatex.remove-token! x slatex.keyword-tokens))323 (set! slatex.constant-tokens324 (slatex.remove-token! x slatex.constant-tokens))325 (set! slatex.variable-tokens (cons x slatex.variable-tokens))))))326327(define slatex.set-special-symbol328 (lambda (x transl)329 (let ((c (slatex.assoc-token x slatex.special-symbols)))330 (if c331 (set-cdr! c transl)332 (set! slatex.special-symbols333 (cons (cons x transl) slatex.special-symbols))))))334335(define slatex.unset-special-symbol336 (lambda (x)337 (set! slatex.special-symbols338 (slatex.remove-if!339 (lambda (c) (slatex.token=? (car c) x))340 slatex.special-symbols))))341342(define slatex.texify (lambda (s) (list->string (slatex.texify-aux s))))343344(define slatex.texify-data345 (lambda (s)346 (let loop ((l (slatex.texify-aux s)) (r '()))347 (if (null? l)348 (list->string (slatex.reverse! r))349 (let ((c (car l)))350 (loop (cdr l)351 (if (char=? c #\-)352 (slatex.append! (list #\$ c #\$) r)353 (cons c r))))))))354355(define slatex.texify-aux356 (let* ((arrow (string->list "-$>$")) (arrow-lh (length arrow)))357 (lambda (s)358 (let* ((sl (string->list s))359 (texified-sl360 (slatex.append-map!361 (lambda (c) (string->list (slatex.tex-analog c)))362 sl)))363 (slatex.ormapcdr364 (lambda (d)365 (if (slatex.list-prefix? arrow d)366 (let ((to (string->list "$\\to$")))367 (set-car! d (car to))368 (set-cdr! d (append (cdr to) (list-tail d arrow-lh)))))369 #f)370 texified-sl)371 texified-sl))))372373(define slatex.display-begin-sequence374 (lambda (out)375 (if (or slatex.*intext?* (not slatex.*latex?*))376 (begin377 (display "\\" out)378 (display slatex.*code-env-spec* out)379 (newline out))380 (begin381 (display "\\begin{" out)382 (display slatex.*code-env-spec* out)383 (display "}" out)384 (newline out)))))385386(define slatex.display-end-sequence387 (lambda (out)388 (if (or slatex.*intext?* (not slatex.*latex?*))389 (begin390 (display "\\end" out)391 (display slatex.*code-env-spec* out)392 (newline out))393 (begin394 (display "\\end{" out)395 (display slatex.*code-env-spec* out)396 (display "}" out)397 (newline out)))))398399(define slatex.display-tex-char400 (lambda (c p) (display (if (char? c) (slatex.tex-analog c) c) p)))401402(define slatex.display-token403 (lambda (s typ p)404 (cond ((eq? typ 'syntax)405 (display "\\sy{" p)406 (display (slatex.texify s) p)407 (display "}" p))408 ((eq? typ 'variable)409 (display "\\va{" p)410 (display (slatex.texify s) p)411 (display "}" p))412 ((eq? typ 'constant)413 (display "\\cn{" p)414 (display (slatex.texify s) p)415 (display "}" p))416 ((eq? typ 'data)417 (display "\\dt{" p)418 (display (slatex.texify-data s) p)419 (display "}" p))420 (else (slatex.error 'slatex.display-token typ)))))421422(define slatex.*max-line-length* 200)423424(begin425 (define slatex.&inner-space (integer->char 7))426 (define slatex."e-space (integer->char 6))427 (define slatex.&bracket-space (integer->char 5))428 (define slatex.&paren-space (integer->char 4))429 (define slatex.&init-plain-space (integer->char 3))430 (define slatex.&init-space (integer->char 2))431 (define slatex.&plain-space (integer->char 1))432 (define slatex.&void-space (integer->char 0)))433434(begin435 (define slatex.&plain-crg-ret (integer->char 4))436 (define slatex.&tabbed-crg-ret (integer->char 3))437 (define slatex.&move-tab (integer->char 2))438 (define slatex.&set-tab (integer->char 1))439 (define slatex.&void-tab (integer->char 0)))440441(begin442 (define slatex.&end-math (integer->char 8))443 (define slatex.&mid-math (integer->char 7))444 (define slatex.&begin-math (integer->char 6))445 (define slatex.&end-string (integer->char 5))446 (define slatex.&mid-string (integer->char 4))447 (define slatex.&begin-string (integer->char 3))448 (define slatex.&mid-comment (integer->char 2))449 (define slatex.&begin-comment (integer->char 1))450 (define slatex.&void-notab (integer->char 0)))451452(begin453 (define slatex.make-raw-line (lambda () (make-vector 5)))454 (define slatex.=notab 4)455 (define slatex.=tab 3)456 (define slatex.=space 2)457 (define slatex.=char 1)458 (define slatex.=rtedge 0))459460(define slatex.make-line461 (lambda ()462 (let ((l (slatex.make-raw-line)))463 (vector-set! l slatex.=rtedge 0)464 (vector-set!465 l466 slatex.=char467 (make-string slatex.*max-line-length* #\space))468 (vector-set!469 l470 slatex.=space471 (make-string slatex.*max-line-length* slatex.&void-space))472 (vector-set!473 l474 slatex.=tab475 (make-string slatex.*max-line-length* slatex.&void-tab))476 (vector-set!477 l478 slatex.=notab479 (make-string slatex.*max-line-length* slatex.&void-notab))480 l)))481482(define slatex.*line1* (slatex.make-line))483484(define slatex.*line2* (slatex.make-line))485486(begin487 (define slatex.make-case-frame (lambda () (make-vector 3)))488 (define slatex.=in-case-exp 2)489 (define slatex.=in-bktd-ctag-exp 1)490 (define =in-ctag-tkn 0))491492(begin493 (define slatex.make-bq-frame (lambda () (make-vector 3)))494 (define slatex.=in-bktd-bq-exp 2)495 (define slatex.=in-bq-tkn 1)496 (define slatex.=in-comma 0))497498(define slatex.*latex-paragraph-mode?* 'fwd1)499500(define slatex.*intext?* 'fwd2)501502(define slatex.*code-env-spec* "UNDEFINED")503504(define slatex.*in* 'fwd3)505506(define slatex.*out* 'fwd4)507508(define slatex.*in-qtd-tkn* 'fwd5)509510(define slatex.*in-bktd-qtd-exp* 'fwd6)511512(define slatex.*in-mac-tkn* 'fwd7)513514(define slatex.*in-bktd-mac-exp* 'fwd8)515516(define slatex.*case-stack* 'fwd9)517518(define slatex.*bq-stack* 'fwd10)519520(define slatex.display-space521 (lambda (s p)522 (cond ((eq? s slatex.&plain-space) (display #\space p))523 ((eq? s slatex.&init-plain-space) (display #\space p))524 ((eq? s slatex.&init-space) (display "\\HL " p))525 ((eq? s slatex.&paren-space) (display "\\PRN " p))526 ((eq? s slatex.&bracket-space) (display "\\BKT " p))527 ((eq? s slatex."e-space) (display "\\QUO " p))528 ((eq? s slatex.&inner-space) (display "\\ " p)))))529530(define slatex.display-tab531 (lambda (tab p)532 (cond ((eq? tab slatex.&set-tab) (display "\\=" p))533 ((eq? tab slatex.&move-tab) (display "\\>" p)))))534535(define slatex.display-notab536 (lambda (notab p)537 (cond ((eq? notab slatex.&begin-string) (display "\\dt{" p))538 ((eq? notab slatex.&end-string) (display "}" p)))))539540(define slatex.get-line541 (let ((curr-notab slatex.&void-notab))542 (lambda (line)543 (let ((graphic-char-seen? #f))544 (let loop ((i 0))545 (let ((c (read-char slatex.*in*)))546 (cond (graphic-char-seen? 'already-seen)547 ((or (eof-object? c)548 (char=? c slatex.*return*)549 (char=? c #\newline)550 (char=? c #\space)551 (char=? c slatex.*tab*))552 'not-yet)553 (else (set! graphic-char-seen? #t)))554 (cond ((eof-object? c)555 (cond ((eq? curr-notab slatex.&mid-string)556 (if (> i 0)557 (string-set!558 (vector-ref line slatex.=notab)559 (- i 1)560 slatex.&end-string)))561 ((eq? curr-notab slatex.&mid-comment)562 (set! curr-notab slatex.&void-notab))563 ((eq? curr-notab slatex.&mid-math)564 (slatex.error565 'slatex.get-line566 'runaway-math-subformula)))567 (string-set! (vector-ref line slatex.=char) i #\newline)568 (string-set!569 (vector-ref line slatex.=space)570 i571 slatex.&void-space)572 (string-set!573 (vector-ref line slatex.=tab)574 i575 slatex.&void-tab)576 (string-set!577 (vector-ref line slatex.=notab)578 i579 slatex.&void-notab)580 (vector-set! line slatex.=rtedge i)581 (if (eq? (string-ref (vector-ref line slatex.=notab) 0)582 slatex.&mid-string)583 (string-set!584 (vector-ref line slatex.=notab)585 0586 slatex.&begin-string))587 (if (= i 0) #f #t))588 ((or (char=? c slatex.*return*) (char=? c #\newline))589 (if (and (eq? *op-sys* 'dos) (char=? c slatex.*return*))590 (if (char=? (peek-char slatex.*in*) #\newline)591 (read-char slatex.*in*)))592 (cond ((eq? curr-notab slatex.&mid-string)593 (if (> i 0)594 (string-set!595 (vector-ref line slatex.=notab)596 (- i 1)597 slatex.&end-string)))598 ((eq? curr-notab slatex.&mid-comment)599 (set! curr-notab slatex.&void-notab))600 ((eq? curr-notab slatex.&mid-math)601 (slatex.error602 'slatex.get-line603 'runaway-math-subformula)))604 (string-set! (vector-ref line slatex.=char) i #\newline)605 (string-set!606 (vector-ref line slatex.=space)607 i608 slatex.&void-space)609 (string-set!610 (vector-ref line slatex.=tab)611 i612 (cond ((eof-object? (peek-char slatex.*in*))613 slatex.&plain-crg-ret)614 (slatex.*intext?* slatex.&plain-crg-ret)615 (else slatex.&tabbed-crg-ret)))616 (string-set!617 (vector-ref line slatex.=notab)618 i619 slatex.&void-notab)620 (vector-set! line slatex.=rtedge i)621 (if (eq? (string-ref (vector-ref line slatex.=notab) 0)622 slatex.&mid-string)623 (string-set!624 (vector-ref line slatex.=notab)625 0626 slatex.&begin-string))627 #t)628 ((eq? curr-notab slatex.&mid-comment)629 (string-set! (vector-ref line slatex.=char) i c)630 (string-set!631 (vector-ref line slatex.=space)632 i633 (cond ((char=? c #\space) slatex.&plain-space)634 ((char=? c slatex.*tab*) slatex.&plain-space)635 (else slatex.&void-space)))636 (string-set!637 (vector-ref line slatex.=tab)638 i639 slatex.&void-tab)640 (string-set!641 (vector-ref line slatex.=notab)642 i643 slatex.&mid-comment)644 (loop (+ i 1)))645 ((char=? c #\\)646 (string-set! (vector-ref line slatex.=char) i c)647 (string-set!648 (vector-ref line slatex.=space)649 i650 slatex.&void-space)651 (string-set!652 (vector-ref line slatex.=tab)653 i654 slatex.&void-tab)655 (string-set! (vector-ref line slatex.=notab) i curr-notab)656 (let ((i+1 (+ i 1)) (c+1 (read-char slatex.*in*)))657 (if (char=? c+1 slatex.*tab*) (set! c+1 #\space))658 (string-set! (vector-ref line slatex.=char) i+1 c+1)659 (string-set!660 (vector-ref line slatex.=space)661 i+1662 (if (char=? c+1 #\space)663 slatex.&plain-space664 slatex.&void-space))665 (string-set!666 (vector-ref line slatex.=tab)667 i+1668 slatex.&void-tab)669 (string-set!670 (vector-ref line slatex.=notab)671 i+1672 curr-notab)673 (loop (+ i+1 1))))674 ((eq? curr-notab slatex.&mid-math)675 (if (char=? c slatex.*tab*) (set! c #\space))676 (string-set!677 (vector-ref line slatex.=space)678 i679 (if (char=? c #\space)680 slatex.&plain-space681 slatex.&void-space))682 (string-set!683 (vector-ref line slatex.=tab)684 i685 slatex.&void-tab)686 (cond ((memv c slatex.*math-triggerers*)687 (string-set! (vector-ref line slatex.=char) i #\$)688 (string-set!689 (vector-ref line slatex.=notab)690 i691 slatex.&end-math)692 (set! curr-notab slatex.&void-notab))693 (else694 (string-set! (vector-ref line slatex.=char) i c)695 (string-set!696 (vector-ref line slatex.=notab)697 i698 slatex.&mid-math)))699 (loop (+ i 1)))700 ((eq? curr-notab slatex.&mid-string)701 (if (char=? c slatex.*tab*) (set! c #\space))702 (string-set! (vector-ref line slatex.=char) i c)703 (string-set!704 (vector-ref line slatex.=space)705 i706 (if (char=? c #\space)707 slatex.&inner-space708 slatex.&void-space))709 (string-set!710 (vector-ref line slatex.=tab)711 i712 slatex.&void-tab)713 (string-set!714 (vector-ref line slatex.=notab)715 i716 (cond ((char=? c #\")717 (set! curr-notab slatex.&void-notab)718 slatex.&end-string)719 (else slatex.&mid-string)))720 (loop (+ i 1)))721 ((char=? c #\space)722 (string-set! (vector-ref line slatex.=char) i c)723 (string-set!724 (vector-ref line slatex.=space)725 i726 (cond (slatex.*intext?* slatex.&plain-space)727 (graphic-char-seen? slatex.&inner-space)728 (else slatex.&init-space)))729 (string-set!730 (vector-ref line slatex.=tab)731 i732 slatex.&void-tab)733 (string-set!734 (vector-ref line slatex.=notab)735 i736 slatex.&void-notab)737 (loop (+ i 1)))738 ((char=? c slatex.*tab*)739 (let loop2 ((i i) (j 0))740 (if (< j 8)741 (begin742 (string-set! (vector-ref line slatex.=char) i #\space)743 (string-set!744 (vector-ref line slatex.=space)745 i746 (cond (slatex.*intext?* slatex.&plain-space)747 (graphic-char-seen? slatex.&inner-space)748 (else slatex.&init-space)))749 (string-set!750 (vector-ref line slatex.=tab)751 i752 slatex.&void-tab)753 (string-set!754 (vector-ref line slatex.=notab)755 i756 slatex.&void-notab)757 (loop2 (+ i 1) (+ j 1)))))758 (loop (+ i 8)))759 ((char=? c #\")760 (string-set! (vector-ref line slatex.=char) i c)761 (string-set!762 (vector-ref line slatex.=space)763 i764 slatex.&void-space)765 (string-set!766 (vector-ref line slatex.=tab)767 i768 slatex.&void-tab)769 (string-set!770 (vector-ref line slatex.=notab)771 i772 slatex.&begin-string)773 (set! curr-notab slatex.&mid-string)774 (loop (+ i 1)))775 ((char=? c #\;)776 (string-set! (vector-ref line slatex.=char) i c)777 (string-set!778 (vector-ref line slatex.=space)779 i780 slatex.&void-space)781 (string-set!782 (vector-ref line slatex.=tab)783 i784 slatex.&void-tab)785 (string-set!786 (vector-ref line slatex.=notab)787 i788 slatex.&begin-comment)789 (set! curr-notab slatex.&mid-comment)790 (loop (+ i 1)))791 ((memv c slatex.*math-triggerers*)792 (string-set! (vector-ref line slatex.=char) i #\$)793 (string-set!794 (vector-ref line slatex.=space)795 i796 slatex.&void-space)797 (string-set!798 (vector-ref line slatex.=tab)799 i800 slatex.&void-tab)801 (string-set!802 (vector-ref line slatex.=notab)803 i804 slatex.&begin-math)805 (set! curr-notab slatex.&mid-math)806 (loop (+ i 1)))807 (else808 (string-set! (vector-ref line slatex.=char) i c)809 (string-set!810 (vector-ref line slatex.=space)811 i812 slatex.&void-space)813 (string-set!814 (vector-ref line slatex.=tab)815 i816 slatex.&void-tab)817 (string-set!818 (vector-ref line slatex.=notab)819 i820 slatex.&void-notab)821 (loop (+ i 1))))))))))822823(define slatex.peephole-adjust824 (lambda (curr prev)825 (if (or (slatex.blank-line? curr) (slatex.flush-comment-line? curr))826 (if slatex.*latex-paragraph-mode?*827 'skip828 (begin829 (set! slatex.*latex-paragraph-mode?* #t)830 (if slatex.*intext?*831 'skip832 (begin833 (slatex.remove-some-tabs prev 0)834 (let ((prev-rtedge (vector-ref prev slatex.=rtedge)))835 (if (eq? (string-ref (vector-ref prev slatex.=tab) prev-rtedge)836 slatex.&tabbed-crg-ret)837 (string-set!838 (vector-ref prev slatex.=tab)839 (vector-ref prev slatex.=rtedge)840 slatex.&plain-crg-ret)))))))841 (begin842 (if slatex.*latex-paragraph-mode?*843 (set! slatex.*latex-paragraph-mode?* #f)844 (if slatex.*intext?*845 'skip846 (let ((remove-tabs-from #f))847 (let loop ((i 0))848 (cond ((char=? (string-ref (vector-ref curr slatex.=char) i)849 #\newline)850 (set! remove-tabs-from i))851 ((char=? (string-ref (vector-ref prev slatex.=char) i)852 #\newline)853 (set! remove-tabs-from #f))854 ((eq? (string-ref (vector-ref curr slatex.=space) i)855 slatex.&init-space)856 (if (eq? (string-ref (vector-ref prev slatex.=notab) i)857 slatex.&void-notab)858 (begin859 (cond ((or (char=? (string-ref860 (vector-ref prev slatex.=char)861 i)862 #\()863 (eq? (string-ref864 (vector-ref prev slatex.=space)865 i)866 slatex.&paren-space))867 (string-set!868 (vector-ref curr slatex.=space)869 i870 slatex.&paren-space))871 ((or (char=? (string-ref872 (vector-ref prev slatex.=char)873 i)874 #\[)875 (eq? (string-ref876 (vector-ref prev slatex.=space)877 i)878 slatex.&bracket-space))879 (string-set!880 (vector-ref curr slatex.=space)881 i882 slatex.&bracket-space))883 ((or (memv (string-ref884 (vector-ref prev slatex.=char)885 i)886 '(#\' #\` #\,))887 (eq? (string-ref888 (vector-ref prev slatex.=space)889 i)890 slatex."e-space))891 (string-set!892 (vector-ref curr slatex.=space)893 i894 slatex."e-space)))895 (if (memq (string-ref896 (vector-ref prev slatex.=tab)897 i)898 (list slatex.&set-tab slatex.&move-tab))899 (string-set!900 (vector-ref curr slatex.=tab)901 i902 slatex.&move-tab))))903 (loop (+ i 1)))904 ((= i 0) (set! remove-tabs-from 0))905 ((not (eq? (string-ref (vector-ref prev slatex.=tab) i)906 slatex.&void-tab))907 (set! remove-tabs-from (+ i 1))908 (if (memq (string-ref (vector-ref prev slatex.=tab) i)909 (list slatex.&set-tab slatex.&move-tab))910 (string-set!911 (vector-ref curr slatex.=tab)912 i913 slatex.&move-tab)))914 ((memq (string-ref (vector-ref prev slatex.=space) i)915 (list slatex.&init-space916 slatex.&init-plain-space917 slatex.&paren-space918 slatex.&bracket-space919 slatex."e-space))920 (set! remove-tabs-from (+ i 1)))921 ((and (char=? (string-ref922 (vector-ref prev slatex.=char)923 (- i 1))924 #\space)925 (eq? (string-ref926 (vector-ref prev slatex.=notab)927 (- i 1))928 slatex.&void-notab))929 (set! remove-tabs-from (+ i 1))930 (string-set!931 (vector-ref prev slatex.=tab)932 i933 slatex.&set-tab)934 (string-set!935 (vector-ref curr slatex.=tab)936 i937 slatex.&move-tab))938 (else939 (set! remove-tabs-from (+ i 1))940 (let loop1 ((j (- i 1)))941 (cond ((<= j 0) 'exit-loop1)942 ((not (eq? (string-ref943 (vector-ref curr slatex.=tab)944 j)945 slatex.&void-tab))946 'exit-loop1)947 ((memq (string-ref948 (vector-ref curr slatex.=space)949 j)950 (list slatex.&paren-space951 slatex.&bracket-space952 slatex."e-space))953 (loop1 (- j 1)))954 ((or (not (eq? (string-ref955 (vector-ref prev slatex.=notab)956 j)957 slatex.&void-notab))958 (char=? (string-ref959 (vector-ref prev slatex.=char)960 j)961 #\space))962 (let ((k (+ j 1)))963 (if (memq (string-ref964 (vector-ref prev slatex.=notab)965 k)966 (list slatex.&mid-comment967 slatex.&mid-math968 slatex.&end-math969 slatex.&mid-string970 slatex.&end-string))971 'skip972 (begin973 (if (eq? (string-ref974 (vector-ref prev slatex.=tab)975 k)976 slatex.&void-tab)977 (string-set!978 (vector-ref prev slatex.=tab)979 k980 slatex.&set-tab))981 (string-set!982 (vector-ref curr slatex.=tab)983 k984 slatex.&move-tab)))))985 (else 'anything-else?))))))986 (slatex.remove-some-tabs prev remove-tabs-from))))987 (if slatex.*intext?* 'skip (slatex.add-some-tabs curr))988 (slatex.clean-init-spaces curr)989 (slatex.clean-inner-spaces curr)))))990991(define slatex.add-some-tabs992 (lambda (line)993 (let loop ((i 1) (succ-parens? #f))994 (let ((c (string-ref (vector-ref line slatex.=char) i)))995 (cond ((char=? c #\newline) 'exit-loop)996 ((not (eq? (string-ref (vector-ref line slatex.=notab) i)997 slatex.&void-notab))998 (loop (+ i 1) #f))999 ((char=? c #\[)1000 (if (eq? (string-ref (vector-ref line slatex.=tab) i)1001 slatex.&void-tab)1002 (string-set! (vector-ref line slatex.=tab) i slatex.&set-tab))1003 (loop (+ i 1) #f))1004 ((char=? c #\()1005 (if (eq? (string-ref (vector-ref line slatex.=tab) i)1006 slatex.&void-tab)1007 (if succ-parens?1008 'skip1009 (string-set!1010 (vector-ref line slatex.=tab)1011 i1012 slatex.&set-tab)))1013 (loop (+ i 1) #t))1014 (else (loop (+ i 1) #f)))))))10151016(define slatex.remove-some-tabs1017 (lambda (line i)1018 (if i1019 (let loop ((i i))1020 (cond ((char=? (string-ref (vector-ref line slatex.=char) i) #\newline)1021 'exit)1022 ((eq? (string-ref (vector-ref line slatex.=tab) i)1023 slatex.&set-tab)1024 (string-set! (vector-ref line slatex.=tab) i slatex.&void-tab)1025 (loop (+ i 1)))1026 (else (loop (+ i 1))))))))10271028(define slatex.clean-init-spaces1029 (lambda (line)1030 (let loop ((i (vector-ref line slatex.=rtedge)))1031 (cond ((< i 0) 'exit-loop)1032 ((eq? (string-ref (vector-ref line slatex.=tab) i)1033 slatex.&move-tab)1034 (let loop2 ((i (- i 1)))1035 (cond ((< i 0) 'exit-loop2)1036 ((memq (string-ref (vector-ref line slatex.=space) i)1037 (list slatex.&init-space1038 slatex.&paren-space1039 slatex.&bracket-space1040 slatex."e-space))1041 (string-set!1042 (vector-ref line slatex.=space)1043 i1044 slatex.&init-plain-space)1045 (loop2 (- i 1)))1046 (else (loop2 (- i 1))))))1047 (else (loop (- i 1)))))))10481049(define slatex.clean-inner-spaces1050 (lambda (line)1051 (let loop ((i 0) (succ-inner-spaces? #f))1052 (cond ((char=? (string-ref (vector-ref line slatex.=char) i) #\newline)1053 'exit-loop)1054 ((eq? (string-ref (vector-ref line slatex.=space) i)1055 slatex.&inner-space)1056 (if succ-inner-spaces?1057 'skip1058 (string-set!1059 (vector-ref line slatex.=space)1060 i1061 slatex.&plain-space))1062 (loop (+ i 1) #t))1063 (else (loop (+ i 1) #f))))))10641065(define slatex.blank-line?1066 (lambda (line)1067 (let loop ((i 0))1068 (let ((c (string-ref (vector-ref line slatex.=char) i)))1069 (cond ((char=? c #\space)1070 (if (eq? (string-ref (vector-ref line slatex.=notab) i)1071 slatex.&void-notab)1072 (loop (+ i 1))1073 #f))1074 ((char=? c #\newline)1075 (let loop2 ((j (- i 1)))1076 (if (<= j 0)1077 'skip1078 (begin1079 (string-set!1080 (vector-ref line slatex.=space)1081 i1082 slatex.&void-space)1083 (loop2 (- j 1)))))1084 #t)1085 (else #f))))))10861087(define slatex.flush-comment-line?1088 (lambda (line)1089 (and (char=? (string-ref (vector-ref line slatex.=char) 0) #\;)1090 (eq? (string-ref (vector-ref line slatex.=notab) 0)1091 slatex.&begin-comment)1092 (not (char=? (string-ref (vector-ref line slatex.=char) 1) #\;)))))10931094(define slatex.do-all-lines1095 (lambda ()1096 (let loop ((line1 slatex.*line1*) (line2 slatex.*line2*))1097 (let* ((line2-paragraph? slatex.*latex-paragraph-mode?*)1098 (more? (slatex.get-line line1)))1099 (slatex.peephole-adjust line1 line2)1100 ((if line2-paragraph? slatex.display-tex-line slatex.display-scm-line)1101 line2)1102 (if (eq? line2-paragraph? slatex.*latex-paragraph-mode?*)1103 'else1104 ((if slatex.*latex-paragraph-mode?*1105 slatex.display-end-sequence1106 slatex.display-begin-sequence)1107 slatex.*out*))1108 (if more? (loop line2 line1))))))11091110(define scheme2tex1111 (lambda (inport outport)1112 (set! slatex.*in* inport)1113 (set! slatex.*out* outport)1114 (set! slatex.*latex-paragraph-mode?* #t)1115 (set! slatex.*in-qtd-tkn* #f)1116 (set! slatex.*in-bktd-qtd-exp* 0)1117 (set! slatex.*in-mac-tkn* #f)1118 (set! slatex.*in-bktd-mac-exp* 0)1119 (set! slatex.*case-stack* '())1120 (set! slatex.*bq-stack* '())1121 (let ((flush-line1122 (lambda (line)1123 (vector-set! line slatex.=rtedge 0)1124 (string-set! (vector-ref line slatex.=char) 0 #\newline)1125 (string-set!1126 (vector-ref line slatex.=space)1127 01128 slatex.&void-space)1129 (string-set! (vector-ref line slatex.=tab) 0 slatex.&void-tab)1130 (string-set!1131 (vector-ref line slatex.=notab)1132 01133 slatex.&void-notab))))1134 (flush-line slatex.*line1*)1135 (flush-line slatex.*line2*))1136 (slatex.do-all-lines)))11371138(define slatex.display-tex-line1139 (lambda (line)1140 (cond (else1141 (let loop ((i (if (slatex.flush-comment-line? line) 1 0)))1142 (let ((c (string-ref (vector-ref line slatex.=char) i)))1143 (if (char=? c #\newline)1144 (if (eq? (string-ref (vector-ref line slatex.=tab) i)1145 slatex.&void-tab)1146 'skip1147 (newline slatex.*out*))1148 (begin (display c slatex.*out*) (loop (+ i 1))))))))))11491150(define slatex.display-scm-line1151 (lambda (line)1152 (let loop ((i 0))1153 (let ((c (string-ref (vector-ref line slatex.=char) i)))1154 (cond ((char=? c #\newline)1155 (let ((tab (string-ref (vector-ref line slatex.=tab) i)))1156 (cond ((eq? tab slatex.&tabbed-crg-ret)1157 (display "\\\\" slatex.*out*)1158 (newline slatex.*out*))1159 ((eq? tab slatex.&plain-crg-ret) (newline slatex.*out*))1160 ((eq? tab slatex.&void-tab)1161 (display #\% slatex.*out*)1162 (newline slatex.*out*)))))1163 ((eq? (string-ref (vector-ref line slatex.=notab) i)1164 slatex.&begin-comment)1165 (slatex.display-tab1166 (string-ref (vector-ref line slatex.=tab) i)1167 slatex.*out*)1168 (display c slatex.*out*)1169 (loop (+ i 1)))1170 ((eq? (string-ref (vector-ref line slatex.=notab) i)1171 slatex.&mid-comment)1172 (display c slatex.*out*)1173 (loop (+ i 1)))1174 ((eq? (string-ref (vector-ref line slatex.=notab) i)1175 slatex.&begin-string)1176 (slatex.display-tab1177 (string-ref (vector-ref line slatex.=tab) i)1178 slatex.*out*)1179 (display "\\dt{" slatex.*out*)1180 (if (char=? c #\space)1181 (slatex.display-space1182 (string-ref (vector-ref line slatex.=space) i)1183 slatex.*out*)1184 (slatex.display-tex-char c slatex.*out*))1185 (loop (+ i 1)))1186 ((eq? (string-ref (vector-ref line slatex.=notab) i)1187 slatex.&mid-string)1188 (if (char=? c #\space)1189 (slatex.display-space1190 (string-ref (vector-ref line slatex.=space) i)1191 slatex.*out*)1192 (slatex.display-tex-char c slatex.*out*))1193 (loop (+ i 1)))1194 ((eq? (string-ref (vector-ref line slatex.=notab) i)1195 slatex.&end-string)1196 (if (char=? c #\space)1197 (slatex.display-space1198 (string-ref (vector-ref line slatex.=space) i)1199 slatex.*out*)1200 (slatex.display-tex-char c slatex.*out*))1201 (display "}" slatex.*out*)1202 (loop (+ i 1)))1203 ((eq? (string-ref (vector-ref line slatex.=notab) i)1204 slatex.&begin-math)1205 (slatex.display-tab1206 (string-ref (vector-ref line slatex.=tab) i)1207 slatex.*out*)1208 (display c slatex.*out*)1209 (loop (+ i 1)))1210 ((memq (string-ref (vector-ref line slatex.=notab) i)1211 (list slatex.&mid-math slatex.&end-math))1212 (display c slatex.*out*)1213 (loop (+ i 1)))1214 ((char=? c #\space)1215 (slatex.display-tab1216 (string-ref (vector-ref line slatex.=tab) i)1217 slatex.*out*)1218 (slatex.display-space1219 (string-ref (vector-ref line slatex.=space) i)1220 slatex.*out*)1221 (loop (+ i 1)))1222 ((char=? c #\')1223 (slatex.display-tab1224 (string-ref (vector-ref line slatex.=tab) i)1225 slatex.*out*)1226 (display c slatex.*out*)1227 (if (or slatex.*in-qtd-tkn* (> slatex.*in-bktd-qtd-exp* 0))1228 'skip1229 (set! slatex.*in-qtd-tkn* #t))1230 (loop (+ i 1)))1231 ((char=? c #\`)1232 (slatex.display-tab1233 (string-ref (vector-ref line slatex.=tab) i)1234 slatex.*out*)1235 (display c slatex.*out*)1236 (if (or (null? slatex.*bq-stack*)1237 (vector-ref (car slatex.*bq-stack*) slatex.=in-comma))1238 (set! slatex.*bq-stack*1239 (cons (let ((f (slatex.make-bq-frame)))1240 (vector-set! f slatex.=in-comma #f)1241 (vector-set! f slatex.=in-bq-tkn #t)1242 (vector-set! f slatex.=in-bktd-bq-exp 0)1243 f)1244 slatex.*bq-stack*)))1245 (loop (+ i 1)))1246 ((char=? c #\,)1247 (slatex.display-tab1248 (string-ref (vector-ref line slatex.=tab) i)1249 slatex.*out*)1250 (display c slatex.*out*)1251 (if (or (null? slatex.*bq-stack*)1252 (vector-ref (car slatex.*bq-stack*) slatex.=in-comma))1253 'skip1254 (set! slatex.*bq-stack*1255 (cons (let ((f (slatex.make-bq-frame)))1256 (vector-set! f slatex.=in-comma #t)1257 (vector-set! f slatex.=in-bq-tkn #t)1258 (vector-set! f slatex.=in-bktd-bq-exp 0)1259 f)1260 slatex.*bq-stack*)))1261 (if (char=? (string-ref (vector-ref line slatex.=char) (+ i 1))1262 #\@)1263 (begin1264 (slatex.display-tex-char #\@ slatex.*out*)1265 (loop (+ 2 i)))1266 (loop (+ i 1))))1267 ((memv c '(#\( #\[))1268 (slatex.display-tab1269 (string-ref (vector-ref line slatex.=tab) i)1270 slatex.*out*)1271 (display c slatex.*out*)1272 (cond (slatex.*in-qtd-tkn*1273 (set! slatex.*in-qtd-tkn* #f)1274 (set! slatex.*in-bktd-qtd-exp* 1))1275 ((> slatex.*in-bktd-qtd-exp* 0)1276 (set! slatex.*in-bktd-qtd-exp*1277 (+ slatex.*in-bktd-qtd-exp* 1))))1278 (cond (slatex.*in-mac-tkn*1279 (set! slatex.*in-mac-tkn* #f)1280 (set! slatex.*in-bktd-mac-exp* 1))1281 ((> slatex.*in-bktd-mac-exp* 0)1282 (set! slatex.*in-bktd-mac-exp*1283 (+ slatex.*in-bktd-mac-exp* 1))))1284 (if (null? slatex.*bq-stack*)1285 'skip1286 (let ((top (car slatex.*bq-stack*)))1287 (cond ((vector-ref top slatex.=in-bq-tkn)1288 (vector-set! top slatex.=in-bq-tkn #f)1289 (vector-set! top slatex.=in-bktd-bq-exp 1))1290 ((> (vector-ref top slatex.=in-bktd-bq-exp) 0)1291 (vector-set!1292 top1293 slatex.=in-bktd-bq-exp1294 (+ (vector-ref top slatex.=in-bktd-bq-exp) 1))))))1295 (if (null? slatex.*case-stack*)1296 'skip1297 (let ((top (car slatex.*case-stack*)))1298 (cond ((vector-ref top =in-ctag-tkn)1299 (vector-set! top =in-ctag-tkn #f)1300 (vector-set! top slatex.=in-bktd-ctag-exp 1))1301 ((> (vector-ref top slatex.=in-bktd-ctag-exp) 0)1302 (vector-set!1303 top1304 slatex.=in-bktd-ctag-exp1305 (+ (vector-ref top slatex.=in-bktd-ctag-exp) 1)))1306 ((> (vector-ref top slatex.=in-case-exp) 0)1307 (vector-set!1308 top1309 slatex.=in-case-exp1310 (+ (vector-ref top slatex.=in-case-exp) 1))1311 (if (= (vector-ref top slatex.=in-case-exp) 2)1312 (set! slatex.*in-qtd-tkn* #t))))))1313 (loop (+ i 1)))1314 ((memv c '(#\) #\]))1315 (slatex.display-tab1316 (string-ref (vector-ref line slatex.=tab) i)1317 slatex.*out*)1318 (display c slatex.*out*)1319 (if (> slatex.*in-bktd-qtd-exp* 0)1320 (set! slatex.*in-bktd-qtd-exp*1321 (- slatex.*in-bktd-qtd-exp* 1)))1322 (if (> slatex.*in-bktd-mac-exp* 0)1323 (set! slatex.*in-bktd-mac-exp*1324 (- slatex.*in-bktd-mac-exp* 1)))1325 (if (null? slatex.*bq-stack*)1326 'skip1327 (let ((top (car slatex.*bq-stack*)))1328 (if (> (vector-ref top slatex.=in-bktd-bq-exp) 0)1329 (begin1330 (vector-set!1331 top1332 slatex.=in-bktd-bq-exp1333 (- (vector-ref top slatex.=in-bktd-bq-exp) 1))1334 (if (= (vector-ref top slatex.=in-bktd-bq-exp) 0)1335 (set! slatex.*bq-stack* (cdr slatex.*bq-stack*)))))))1336 (let loop ()1337 (if (null? slatex.*case-stack*)1338 'skip1339 (let ((top (car slatex.*case-stack*)))1340 (cond ((> (vector-ref top slatex.=in-bktd-ctag-exp) 0)1341 (vector-set!1342 top1343 slatex.=in-bktd-ctag-exp1344 (- (vector-ref top slatex.=in-bktd-ctag-exp) 1))1345 (if (= (vector-ref top slatex.=in-bktd-ctag-exp) 0)1346 (vector-set! top slatex.=in-case-exp 1)))1347 ((> (vector-ref top slatex.=in-case-exp) 0)1348 (vector-set!1349 top1350 slatex.=in-case-exp1351 (- (vector-ref top slatex.=in-case-exp) 1))1352 (if (= (vector-ref top slatex.=in-case-exp) 0)1353 (begin1354 (set! slatex.*case-stack*1355 (cdr slatex.*case-stack*))1356 (loop))))))))1357 (loop (+ i 1)))1358 (else1359 (slatex.display-tab1360 (string-ref (vector-ref line slatex.=tab) i)1361 slatex.*out*)1362 (loop (slatex.do-token line i))))))))13631364(define slatex.do-token1365 (let ((token-delims1366 (list #\(1367 #\)1368 #\[1369 #\]1370 #\space1371 slatex.*return*1372 #\newline1373 #\,1374 #\@1375 #\;)))1376 (lambda (line i)1377 (let loop ((buf '()) (i i))1378 (let ((c (string-ref (vector-ref line slatex.=char) i)))1379 (cond ((char=? c #\\)1380 (loop (cons (string-ref1381 (vector-ref line slatex.=char)1382 (+ i 1))1383 (cons c buf))1384 (+ i 2)))1385 ((or (memv c token-delims) (memv c slatex.*math-triggerers*))1386 (slatex.output-token (list->string (slatex.reverse! buf)))1387 i)1388 ((char? c)1389 (loop (cons (string-ref (vector-ref line slatex.=char) i) buf)1390 (+ i 1)))1391 (else (slatex.error 'slatex.do-token 1))))))))13921393(define slatex.output-token1394 (lambda (token)1395 (if (null? slatex.*case-stack*)1396 'skip1397 (let ((top (car slatex.*case-stack*)))1398 (if (vector-ref top =in-ctag-tkn)1399 (begin1400 (vector-set! top =in-ctag-tkn #f)1401 (vector-set! top slatex.=in-case-exp 1)))))1402 (if (slatex.assoc-token token slatex.special-symbols)1403 (display (cdr (slatex.assoc-token token slatex.special-symbols))1404 slatex.*out*)1405 (slatex.display-token1406 token1407 (cond (slatex.*in-qtd-tkn*1408 (set! slatex.*in-qtd-tkn* #f)1409 (cond ((equal? token "else") 'syntax)1410 ((slatex.data-token? token) 'data)1411 (else 'constant)))1412 ((slatex.data-token? token) 'data)1413 ((> slatex.*in-bktd-qtd-exp* 0) 'constant)1414 ((and (not (null? slatex.*bq-stack*))1415 (not (vector-ref1416 (car slatex.*bq-stack*)1417 slatex.=in-comma)))1418 'constant)1419 (slatex.*in-mac-tkn*1420 (set! slatex.*in-mac-tkn* #f)1421 (slatex.set-keyword token)1422 'syntax)1423 ((> slatex.*in-bktd-mac-exp* 0)1424 (slatex.set-keyword token)1425 'syntax)1426 ((slatex.member-token token slatex.constant-tokens) 'constant)1427 ((slatex.member-token token slatex.variable-tokens) 'variable)1428 ((slatex.member-token token slatex.keyword-tokens)1429 (cond ((slatex.token=? token "quote")1430 (set! slatex.*in-qtd-tkn* #t))1431 ((slatex.member-token token slatex.macro-definers)1432 (set! slatex.*in-mac-tkn* #t))1433 ((slatex.member-token token slatex.case-and-ilk)1434 (set! slatex.*case-stack*1435 (cons (let ((f (slatex.make-case-frame)))1436 (vector-set! f =in-ctag-tkn #t)1437 (vector-set! f slatex.=in-bktd-ctag-exp 0)1438 (vector-set! f slatex.=in-case-exp 0)1439 f)1440 slatex.*case-stack*))))1441 'syntax)1442 (else 'variable))1443 slatex.*out*))1444 (if (and (not (null? slatex.*bq-stack*))1445 (vector-ref (car slatex.*bq-stack*) slatex.=in-bq-tkn))1446 (set! slatex.*bq-stack* (cdr slatex.*bq-stack*)))))14471448(define slatex.data-token?1449 (lambda (token)1450 (or (char=? (string-ref token 0) #\#) (string->number token))))14511452(define slatex.*texinputs* "")14531454(define slatex.*texinputs-list* '())14551456(define slatex.*path-separator*1457 (cond ((eq? *op-sys* 'unix) #\:)1458 ((eq? *op-sys* 'dos) #\;)1459 (else (slatex.error 'slatex.*path-separator* 'cant-determine))))14601461(define slatex.*directory-mark*1462 (cond ((eq? *op-sys* 'unix) "/")1463 ((eq? *op-sys* 'dos) "\\")1464 (else (slatex.error 'slatex.*directory-mark* 'cant-determine))))14651466(define slatex.*file-hider*1467 (cond ((eq? *op-sys* 'unix) "") ((eq? *op-sys* 'dos) "x") (else ".")))14681469(define slatex.path->list1470 (lambda (p)1471 (let loop ((p (string->list p)) (r (list "")))1472 (let ((separator-pos (slatex.position-char slatex.*path-separator* p)))1473 (if separator-pos1474 (loop (list-tail p (+ separator-pos 1))1475 (cons (list->string (slatex.sublist p 0 separator-pos)) r))1476 (slatex.reverse! (cons (list->string p) r)))))))14771478(define slatex.find-some-file1479 (lambda (path . files)1480 (let loop ((path path))1481 (if (null? path)1482 #f1483 (let ((dir (car path)))1484 (let loop2 ((files (if (or (string=? dir "") (string=? dir "."))1485 files1486 (map (lambda (file)1487 (string-append1488 dir1489 slatex.*directory-mark*1490 file))1491 files))))1492 (if (null? files)1493 (loop (cdr path))1494 (let ((file (car files)))1495 (if (slatex.file-exists? file)1496 file1497 (loop2 (cdr files)))))))))))14981499(define slatex.file-extension1500 (lambda (filename)1501 (let ((i (slatex.string-position-right #\. filename)))1502 (if i (substring filename i (string-length filename)) #f))))15031504(define slatex.basename1505 (lambda (filename ext)1506 (let* ((filename-len (string-length filename))1507 (ext-len (string-length ext))1508 (len-diff (- filename-len ext-len)))1509 (cond ((> ext-len filename-len) filename)1510 ((equal? ext (substring filename len-diff filename-len))1511 (substring filename 0 len-diff))1512 (else filename)))))15131514(define slatex.full-texfile-name1515 (lambda (filename)1516 (let ((extn (slatex.file-extension filename)))1517 (if (and extn (or (string=? extn ".sty") (string=? extn ".tex")))1518 (slatex.find-some-file slatex.*texinputs-list* filename)1519 (slatex.find-some-file1520 slatex.*texinputs-list*1521 (string-append filename ".tex")1522 filename)))))15231524(define slatex.full-scmfile-name1525 (lambda (filename)1526 (apply slatex.find-some-file1527 slatex.*texinputs-list*1528 filename1529 (map (lambda (extn) (string-append filename extn))1530 '(".scm" ".ss" ".s")))))15311532(define slatex.new-aux-file1533 (lambda e1534 (apply (if slatex.*slatex-in-protected-region?*1535 slatex.new-secondary-aux-file1536 slatex.new-primary-aux-file)1537 e)))15381539(define slatex.subjobname 'fwd)15401541(define primary-aux-file-count -1)15421543(define slatex.new-primary-aux-file1544 (lambda e1545 (set! primary-aux-file-count (+ primary-aux-file-count 1))1546 (apply string-append1547 slatex.*file-hider*1548 "slatexdir/z"1549 (number->string primary-aux-file-count)1550; slatex.subjobname1551 e)))15521553(define slatex.new-secondary-aux-file1554 (let ((n -1))1555 (lambda e1556 (set! n (+ n 1))1557 (apply string-append1558 slatex.*file-hider*1559 "slatexdir/zz"1560 (number->string n)1561; slatex.subjobname1562 e))))15631564(define slatex.eat-till-newline1565 (lambda (in)1566 (let loop ()1567 (let ((c (read-char in)))1568 (cond ((eof-object? c) 'done)1569 ((char=? c #\newline) 'done)1570 (else (loop)))))))15711572(define slatex.read-ctrl-seq1573 (lambda (in)1574 (let ((c (read-char in)))1575 (if (eof-object? c) (slatex.error 'read-ctrl-exp 1))1576 (if (char-alphabetic? c)1577 (list->string1578 (slatex.reverse!1579 (let loop ((s (list c)))1580 (let ((c (peek-char in)))1581 (cond ((eof-object? c) s)1582 ((char-alphabetic? c) (read-char in) (loop (cons c s)))1583 ((char=? c #\%) (slatex.eat-till-newline in) (loop s))1584 (else s))))))1585 (string c)))))15861587(define slatex.eat-tabspace1588 (lambda (in)1589 (let loop ()1590 (let ((c (peek-char in)))1591 (cond ((eof-object? c) 'done)1592 ((or (char=? c #\space) (char=? c slatex.*tab*))1593 (read-char in)1594 (loop))1595 (else 'done))))))15961597(define slatex.eat-whitespace1598 (lambda (in)1599 (let loop ()1600 (let ((c (peek-char in)))1601 (cond ((eof-object? c) 'done)1602 ((char-whitespace? c) (read-char in) (loop))1603 (else 'done))))))16041605(define slatex.eat-latex-whitespace1606 (lambda (in)1607 (let loop ()1608 (let ((c (peek-char in)))1609 (cond ((eof-object? c) 'done)1610 ((char-whitespace? c) (read-char in) (loop))1611 ((char=? c #\%) (slatex.eat-till-newline in))1612 (else 'done))))))16131614(define slatex.chop-off-whitespace1615 (lambda (l)1616 (slatex.ormapcdr (lambda (d) (if (char-whitespace? (car d)) #f d)) l)))16171618(define slatex.read-grouped-latexexp1619 (lambda (in)1620 (slatex.eat-latex-whitespace in)1621 (let ((c (read-char in)))1622 (if (eof-object? c) (slatex.error 'slatex.read-grouped-latexexp 1))1623 (if (char=? c #\{) 'ok (slatex.error 'slatex.read-grouped-latexexp 2))1624 (slatex.eat-latex-whitespace in)1625 (list->string1626 (slatex.reverse!1627 (slatex.chop-off-whitespace1628 (let loop ((s '()) (nesting 0) (escape? #f))1629 (let ((c (read-char in)))1630 (if (eof-object? c)1631 (slatex.error 'slatex.read-grouped-latexexp 3))1632 (cond (escape? (loop (cons c s) nesting #f))1633 ((char=? c #\\) (loop (cons c s) nesting #t))1634 ((char=? c #\%)1635 (slatex.eat-till-newline in)1636 (loop s nesting #f))1637 ((char=? c #\{) (loop (cons c s) (+ nesting 1) #f))1638 ((char=? c #\})1639 (if (= nesting 0) s (loop (cons c s) (- nesting 1) #f)))1640 (else (loop (cons c s) nesting #f)))))))))))16411642(define slatex.read-filename1643 (let ((filename-delims1644 (list #\{1645 #\}1646 #\[1647 #\]1648 #\(1649 #\)1650 #\#1651 #\%1652 #\\1653 #\,1654 #\space1655 slatex.*return*1656 #\newline1657 slatex.*tab*)))1658 (lambda (in)1659 (slatex.eat-latex-whitespace in)1660 (let ((c (peek-char in)))1661 (if (eof-object? c) (slatex.error 'slatex.read-filename 1))1662 (if (char=? c #\{)1663 (slatex.read-grouped-latexexp in)1664 (list->string1665 (slatex.reverse!1666 (let loop ((s '()) (escape? #f))1667 (let ((c (peek-char in)))1668 (cond ((eof-object? c)1669 (if escape? (slatex.error 'slatex.read-filename 2) s))1670 (escape? (read-char in) (loop (cons c s) #f))1671 ((char=? c #\\) (read-char in) (loop (cons c s) #t))1672 ((memv c filename-delims) s)1673 (else (read-char in) (loop (cons c s) #f))))))))))))16741675(define slatex.read-schemeid1676 (let ((schemeid-delims1677 (list #\{1678 #\}1679 #\[1680 #\]1681 #\(1682 #\)1683 #\space1684 slatex.*return*1685 #\newline1686 slatex.*tab*)))1687 (lambda (in)1688 (slatex.eat-whitespace in)1689 (list->string1690 (slatex.reverse!1691 (let loop ((s '()) (escape? #f))1692 (let ((c (peek-char in)))1693 (cond ((eof-object? c) s)1694 (escape? (read-char in) (loop (cons c s) #f))1695 ((char=? c #\\) (read-char in) (loop (cons c s) #t))1696 ((memv c schemeid-delims) s)1697 (else (read-char in) (loop (cons c s) #f))))))))))16981699(define slatex.read-delimed-commaed-filenames1700 (lambda (in lft-delim rt-delim)1701 (slatex.eat-latex-whitespace in)1702 (let ((c (read-char in)))1703 (if (eof-object? c)1704 (slatex.error 'slatex.read-delimed-commaed-filenames 1))1705 (if (char=? c lft-delim)1706 'ok1707 (slatex.error 'slatex.read-delimed-commaed-filenames 2))1708 (let loop ((s '()))1709 (slatex.eat-latex-whitespace in)1710 (let ((c (peek-char in)))1711 (if (eof-object? c)1712 (slatex.error 'slatex.read-delimed-commaed-filenames 3))1713 (if (char=? c rt-delim)1714 (begin (read-char in) (slatex.reverse! s))1715 (let ((s (cons (slatex.read-filename in) s)))1716 (slatex.eat-latex-whitespace in)1717 (let ((c (peek-char in)))1718 (if (eof-object? c)1719 (slatex.error 'slatex.read-delimed-commaed-filenames 4))1720 (cond ((char=? c #\,) (read-char in))1721 ((char=? c rt-delim) 'void)1722 (else1723 (slatex.error1724 'slatex.read-delimed-commaed-filenames1725 5)))1726 (loop s)))))))))17271728(define slatex.read-grouped-commaed-filenames1729 (lambda (in) (slatex.read-delimed-commaed-filenames in #\{ #\})))17301731(define slatex.read-bktd-commaed-filenames1732 (lambda (in) (slatex.read-delimed-commaed-filenames in #\[ #\])))17331734(define slatex.read-grouped-schemeids1735 (lambda (in)1736 (slatex.eat-latex-whitespace in)1737 (let ((c (read-char in)))1738 (if (eof-object? c) (slatex.error 'slatex.read-grouped-schemeids 1))1739 (if (char=? c #\{) 'ok (slatex.error 'slatex.read-grouped-schemeids 2))1740 (let loop ((s '()))1741 (slatex.eat-whitespace in)1742 (let ((c (peek-char in)))1743 (if (eof-object? c) (slatex.error 'slatex.read-grouped-schemeids 3))1744 (if (char=? c #\})1745 (begin (read-char in) (slatex.reverse! s))1746 (loop (cons (slatex.read-schemeid in) s))))))))17471748(define slatex.disable-slatex-temply1749 (lambda (in)1750 (set! slatex.*slatex-enabled?* #f)1751 (set! slatex.*slatex-reenabler* (slatex.read-grouped-latexexp in))))17521753(define slatex.enable-slatex-again1754 (lambda ()1755 (set! slatex.*slatex-enabled?* #t)1756 (set! slatex.*slatex-reenabler* "UNDEFINED")))17571758(define slatex.ignore2 (lambda (i ii) 'void))17591760(define slatex.add-to-slatex-db1761 (lambda (in categ)1762 (if (memq categ '(keyword constant variable))1763 (slatex.add-to-slatex-db-basic in categ)1764 (slatex.add-to-slatex-db-special in categ))))17651766(define slatex.add-to-slatex-db-basic1767 (lambda (in categ)1768 (let ((setter (cond ((eq? categ 'keyword) slatex.set-keyword)1769 ((eq? categ 'constant) slatex.set-constant)1770 ((eq? categ 'variable) slatex.set-variable)1771 (else1772 (slatex.error 'slatex.add-to-slatex-db-basic 1))))1773 (ids (slatex.read-grouped-schemeids in)))1774 (for-each setter ids))))17751776(define slatex.add-to-slatex-db-special1777 (lambda (in what)1778 (let ((ids (slatex.read-grouped-schemeids in)))1779 (cond ((eq? what 'unsetspecialsymbol)1780 (for-each slatex.unset-special-symbol ids))1781 ((eq? what 'setspecialsymbol)1782 (if (= (length ids) 1)1783 'ok1784 (slatex.error1785 'slatex.add-to-slatex-db-special1786 'setspecialsymbol-takes-one-arg-only))1787 (let ((transl (slatex.read-grouped-latexexp in)))1788 (slatex.set-special-symbol (car ids) transl)))1789 (else (slatex.error 'slatex.add-to-slatex-db-special 2))))))17901791(define slatex.process-slatex-alias1792 (lambda (in what which)1793 (let ((triggerer (slatex.read-grouped-latexexp in)))1794 (cond ((eq? which 'intext)1795 (set! slatex.*intext-triggerers*1796 (what triggerer slatex.*intext-triggerers*)))1797 ((eq? which 'resultintext)1798 (set! slatex.*resultintext-triggerers*1799 (what triggerer slatex.*resultintext-triggerers*)))1800 ((eq? which 'display)1801 (set! slatex.*display-triggerers*1802 (what triggerer slatex.*display-triggerers*)))1803 ((eq? which 'box)1804 (set! slatex.*box-triggerers*1805 (what triggerer slatex.*box-triggerers*)))1806 ((eq? which 'input)1807 (set! slatex.*input-triggerers*1808 (what triggerer slatex.*input-triggerers*)))1809 ((eq? which 'region)1810 (set! slatex.*region-triggerers*1811 (what triggerer slatex.*region-triggerers*)))1812 ((eq? which 'mathescape)1813 (if (= (string-length triggerer) 1)1814 'ok1815 (slatex.error1816 'slatex.process-slatex-alias1817 'math-escape-should-be-character))1818 (set! slatex.*math-triggerers*1819 (what (string-ref triggerer 0) slatex.*math-triggerers*)))1820 (else (slatex.error 'slatex.process-slatex-alias 2))))))18211822(define slatex.decide-latex-or-tex1823 (lambda (latex?)1824 (set! slatex.*latex?* latex?)1825 (let ((pltexchk.jnk "pltexchk.jnk"))1826 (if (slatex.file-exists? pltexchk.jnk) (slatex.delete-file pltexchk.jnk))1827 (if (not slatex.*latex?*)1828 (call-with-output-file/truncate1829 pltexchk.jnk1830 (lambda (outp) (display 'junk outp) (newline outp)))))))18311832(define slatex.process-include-only1833 (lambda (in)1834 (set! slatex.*include-onlys* '())1835 (for-each1836 (lambda (filename)1837 (let ((filename (slatex.full-texfile-name filename)))1838 (if filename1839 (set! slatex.*include-onlys*1840 (slatex.adjoin-string filename slatex.*include-onlys*)))))1841 (slatex.read-grouped-commaed-filenames in))))18421843(define slatex.process-documentstyle1844 (lambda (in)1845 (slatex.eat-latex-whitespace in)1846 (if (char=? (peek-char in) #\[)1847 (for-each1848 (lambda (filename)1849 (let ((%:g0% slatex.*slatex-in-protected-region?*))1850 (set! slatex.*slatex-in-protected-region?* #f)1851 (let ((%temp% (begin1852 (slatex.process-tex-file1853 (string-append filename ".sty")))))1854 (set! slatex.*slatex-in-protected-region?* %:g0%)1855 %temp%)))1856 (slatex.read-bktd-commaed-filenames in)))))18571858(define slatex.process-case-info1859 (lambda (in)1860 (let ((bool (slatex.read-grouped-latexexp in)))1861 (set! slatex.*slatex-case-sensitive?*1862 (cond ((string-ci=? bool "true") #t)1863 ((string-ci=? bool "false") #f)1864 (else1865 (slatex.error1866 'slatex.process-case-info1867 'bad-schemecasesensitive-arg)))))))18681869(define slatex.seen-first-command? #f)18701871(define slatex.process-main-tex-file1872 (lambda (filename)1873; (display "SLaTeX v. 2.2")1874; (newline)1875 (set! slatex.*texinputs-list* (slatex.path->list slatex.*texinputs*))1876 (let ((file-hide-file "xZfilhid.tex"))1877 (if (slatex.file-exists? file-hide-file)1878 (slatex.delete-file file-hide-file))1879 (if (eq? *op-sys* 'dos)1880 (call-with-output-file/truncate1881 file-hide-file1882 (lambda (out) (display "\\def\\filehider{x}" out) (newline out)))))1883; (display "typesetting code")1884 (set! slatex.subjobname (slatex.basename filename ".tex"))1885 (set! slatex.seen-first-command? #f)1886 (slatex.process-tex-file filename)1887; (display 'done)1888; (newline)1889))18901891(define slatex.dump-intext1892 (lambda (in out)1893 (let* ((display (if out display slatex.ignore2))1894 (delim-char (begin (slatex.eat-whitespace in) (read-char in)))1895 (delim-char (cond ((char=? delim-char #\{) #\}) (else delim-char))))1896 (if (eof-object? delim-char) (slatex.error 'slatex.dump-intext 1))1897 (let loop ()1898 (let ((c (read-char in)))1899 (if (eof-object? c) (slatex.error 'slatex.dump-intext 2))1900 (if (char=? c delim-char) 'done (begin (display c out) (loop))))))))19011902(define slatex.dump-display1903 (lambda (in out ender)1904 (slatex.eat-tabspace in)1905 (let ((display (if out display slatex.ignore2))1906 (ender-lh (string-length ender))1907 (c (peek-char in)))1908 (if (eof-object? c) (slatex.error 'slatex.dump-display 1))1909 (if (char=? c #\newline) (read-char in))1910 (let loop ((buf ""))1911 (let ((c (read-char in)))1912 (if (eof-object? c) (slatex.error 'slatex.dump-display 2))1913 (let ((buf (string-append buf (string c))))1914 (if (slatex.string-prefix? buf ender)1915 (if (= (string-length buf) ender-lh) 'done (loop buf))1916 (begin (display buf out) (loop "")))))))))19171918(define slatex.debug? #f)19191920(define slatex.process-tex-file1921 (lambda (raw-filename)1922 (if slatex.debug?1923 (begin (display "begin ") (display raw-filename) (newline)))1924 (let ((filename (slatex.full-texfile-name raw-filename)))1925 (if (not filename)1926 (begin1927 (display "[")1928 (display raw-filename)1929 (display "]")1930 (slatex.force-output))1931 (call-with-input-file1932 filename1933 (lambda (in)1934 (let ((done? #f))1935 (let loop ()1936 (if done?1937 'exit-loop1938 (begin1939 (let ((c (read-char in)))1940 (cond ((eof-object? c) (set! done? #t))1941 ((char=? c #\%) (slatex.eat-till-newline in))1942 ((char=? c #\\)1943 (let ((cs (slatex.read-ctrl-seq in)))1944 (if slatex.seen-first-command?1945 'skip1946 (begin1947 (set! slatex.seen-first-command? #t)1948 (slatex.decide-latex-or-tex1949 (string=? cs "documentstyle"))))1950 (cond ((not slatex.*slatex-enabled?*)1951 (if (string=?1952 cs1953 slatex.*slatex-reenabler*)1954 (slatex.enable-slatex-again)))1955 ((string=? cs "slatexignorecurrentfile")1956 (set! done? #t))1957 ((string=? cs "slatexseparateincludes")1958 (if slatex.*latex?*1959 (set! slatex.*slatex-separate-includes?*1960 #t)))1961 ((string=? cs "slatexdisable")1962 (slatex.disable-slatex-temply in))1963 ((string=? cs "begin")1964 (let ((cs (slatex.read-grouped-latexexp1965 in)))1966 (cond ((member cs1967 slatex.*display-triggerers*)1968 (slatex.trigger-scheme2tex1969 'envdisplay1970 in1971 cs))1972 ((member cs1973 slatex.*box-triggerers*)1974 (slatex.trigger-scheme2tex1975 'envbox1976 in1977 cs))1978 ((member cs1979 slatex.*region-triggerers*)1980 (slatex.trigger-region1981 'envregion1982 in1983 cs)))))1984 ((member cs slatex.*intext-triggerers*)1985 (slatex.trigger-scheme2tex1986 'intext1987 in1988 #f))1989 ((member cs1990 slatex.*resultintext-triggerers*)1991 (slatex.trigger-scheme2tex1992 'resultintext1993 in1994 #f))1995 ((member cs slatex.*display-triggerers*)1996 (slatex.trigger-scheme2tex1997 'plaindisplay1998 in1999 cs))2000 ((member cs slatex.*box-triggerers*)2001 (slatex.trigger-scheme2tex2002 'plainbox2003 in2004 cs))2005 ((member cs slatex.*region-triggerers*)2006 (slatex.trigger-region2007 'plainregion2008 in2009 cs))2010 ((member cs slatex.*input-triggerers*)2011 (slatex.process-scheme-file2012 (slatex.read-filename in)))2013 ((string=? cs "input")2014 (let ((%:g1% slatex.*slatex-in-protected-region?*))2015 (set! slatex.*slatex-in-protected-region?*2016 #f)2017 (let ((%temp% (begin2018 (slatex.process-tex-file2019 (slatex.read-filename2020 in)))))2021 (set! slatex.*slatex-in-protected-region?*2022 %:g1%)2023 %temp%)))2024 ((string=? cs "include")2025 (if slatex.*latex?*2026 (let ((f (slatex.full-texfile-name2027 (slatex.read-filename in))))2028 (if (and f2029 (or (eq? slatex.*include-onlys*2030 'all)2031 (member f2032 slatex.*include-onlys*)))2033 (let ((%:g2% slatex.*slatex-in-protected-region?*)2034 (%:g3% slatex.subjobname)2035 (%:g4% primary-aux-file-count))2036 (set! slatex.*slatex-in-protected-region?*2037 #f)2038 (set! slatex.subjobname2039 slatex.subjobname)2040 (set! primary-aux-file-count2041 primary-aux-file-count)2042 (let ((%temp% (begin2043 (if slatex.*slatex-separate-includes?*2044 (begin2045 (set! slatex.subjobname2046 (slatex.basename2047 f2048 ".tex"))2049 (set! primary-aux-file-count2050 -1)))2051 (slatex.process-tex-file2052 f))))2053 (set! slatex.*slatex-in-protected-region?*2054 %:g2%)2055 (set! slatex.subjobname %:g3%)2056 (set! primary-aux-file-count2057 %:g4%)2058 %temp%))))))2059 ((string=? cs "includeonly")2060 (if slatex.*latex?*2061 (slatex.process-include-only in)))2062 ((string=? cs "documentstyle")2063 (if slatex.*latex?*2064 (slatex.process-documentstyle in)))2065 ((string=? cs "schemecasesensitive")2066 (slatex.process-case-info in))2067 ((string=? cs "defschemetoken")2068 (slatex.process-slatex-alias2069 in2070 slatex.adjoin-string2071 'intext))2072 ((string=? cs "undefschemetoken")2073 (slatex.process-slatex-alias2074 in2075 slatex.remove-string!2076 'intext))2077 ((string=? cs "defschemeresulttoken")2078 (slatex.process-slatex-alias2079 in2080 slatex.adjoin-string2081 'resultintext))2082 ((string=? cs "undefschemeresulttoken")2083 (slatex.process-slatex-alias2084 in2085 slatex.remove-string!2086 'resultintext))2087 ((string=? cs "defschemedisplaytoken")2088 (slatex.process-slatex-alias2089 in2090 slatex.adjoin-string2091 'display))2092 ((string=? cs "undefschemedisplaytoken")2093 (slatex.process-slatex-alias2094 in2095 slatex.remove-string!2096 'display))2097 ((string=? cs "defschemeboxtoken")2098 (slatex.process-slatex-alias2099 in2100 slatex.adjoin-string2101 'box))2102 ((string=? cs "undefschemeboxtoken")2103 (slatex.process-slatex-alias2104 in2105 slatex.remove-string!2106 'box))2107 ((string=? cs "defschemeinputtoken")2108 (slatex.process-slatex-alias2109 in2110 slatex.adjoin-string2111 'input))2112 ((string=? cs "undefschemeinputtoken")2113 (slatex.process-slatex-alias2114 in2115 slatex.remove-string!2116 'input))2117 ((string=? cs "defschemeregiontoken")2118 (slatex.process-slatex-alias2119 in2120 slatex.adjoin-string2121 'region))2122 ((string=? cs "undefschemeregiontoken")2123 (slatex.process-slatex-alias2124 in2125 slatex.remove-string!2126 'region))2127 ((string=? cs "defschememathescape")2128 (slatex.process-slatex-alias2129 in2130 slatex.adjoin-char2131 'mathescape))2132 ((string=? cs "undefschememathescape")2133 (slatex.process-slatex-alias2134 in2135 slatex.remove-char!2136 'mathescape))2137 ((string=? cs "setkeyword")2138 (slatex.add-to-slatex-db in 'keyword))2139 ((string=? cs "setconstant")2140 (slatex.add-to-slatex-db in 'constant))2141 ((string=? cs "setvariable")2142 (slatex.add-to-slatex-db in 'variable))2143 ((string=? cs "setspecialsymbol")2144 (slatex.add-to-slatex-db2145 in2146 'setspecialsymbol))2147 ((string=? cs "unsetspecialsymbol")2148 (slatex.add-to-slatex-db2149 in2150 'unsetspecialsymbol)))))))2151 (loop)))))))))2152 (if slatex.debug?2153 (begin (display "end ") (display raw-filename) (newline)))))21542155(define slatex.process-scheme-file2156 (lambda (raw-filename)2157 (let ((filename (slatex.full-scmfile-name raw-filename)))2158 (if (not filename)2159 (begin2160 (display "process-scheme-file: ")2161 (display raw-filename)2162 (display " doesn't exist")2163 (newline))2164 (let ((aux.tex (slatex.new-aux-file ".tex")))2165 ;(display ".")2166 (slatex.force-output)2167 (if (slatex.file-exists? aux.tex) (slatex.delete-file aux.tex))2168 (call-with-input-file2169 filename2170 (lambda (in)2171 (call-with-output-file/truncate2172 aux.tex2173 (lambda (out)2174 (let ((%:g5% slatex.*intext?*)2175 (%:g6% slatex.*code-env-spec*))2176 (set! slatex.*intext?* #f)2177 (set! slatex.*code-env-spec* "ZZZZschemedisplay")2178 (let ((%temp% (begin (scheme2tex in out))))2179 (set! slatex.*intext?* %:g5%)2180 (set! slatex.*code-env-spec* %:g6%)2181 %temp%))))))2182 (if slatex.*slatex-in-protected-region?*2183 (set! slatex.*protected-files*2184 (cons aux.tex slatex.*protected-files*)))2185 (slatex.process-tex-file filename))))))21862187(define slatex.trigger-scheme2tex2188 (lambda (typ in env)2189 (let* ((aux (slatex.new-aux-file))2190 (aux.scm (string-append aux ".scm"))2191 (aux.tex (string-append aux ".tex")))2192 (if (slatex.file-exists? aux.scm) (slatex.delete-file aux.scm))2193 (if (slatex.file-exists? aux.tex) (slatex.delete-file aux.tex))2194; (display ".")2195 (slatex.force-output)2196 (call-with-output-file/truncate2197 aux.scm2198 (lambda (out)2199 (cond ((memq typ '(intext resultintext)) (slatex.dump-intext in out))2200 ((memq typ '(envdisplay envbox))2201 (slatex.dump-display in out (string-append "\\end{" env "}")))2202 ((memq typ '(plaindisplay plainbox))2203 (slatex.dump-display in out (string-append "\\end" env)))2204 (else (slatex.error 'slatex.trigger-scheme2tex 1)))))2205 (call-with-input-file2206 aux.scm2207 (lambda (in)2208 (call-with-output-file/truncate2209 aux.tex2210 (lambda (out)2211 (let ((%:g7% slatex.*intext?*) (%:g8% slatex.*code-env-spec*))2212 (set! slatex.*intext?* (memq typ '(intext resultintext)))2213 (set! slatex.*code-env-spec*2214 (cond ((eq? typ 'intext) "ZZZZschemecodeintext")2215 ((eq? typ 'resultintext) "ZZZZschemeresultintext")2216 ((memq typ '(envdisplay plaindisplay))2217 "ZZZZschemedisplay")2218 ((memq typ '(envbox plainbox)) "ZZZZschemebox")2219 (else (slatex.error 'slatex.trigger-scheme2tex 2))))2220 (let ((%temp% (begin (scheme2tex in out))))2221 (set! slatex.*intext?* %:g7%)2222 (set! slatex.*code-env-spec* %:g8%)2223 %temp%))))))2224 (if slatex.*slatex-in-protected-region?*2225 (set! slatex.*protected-files*2226 (cons aux.tex slatex.*protected-files*)))2227 (if (memq typ '(envdisplay plaindisplay envbox plainbox))2228 (slatex.process-tex-file aux.tex))2229 (slatex.delete-file aux.scm))))22302231(define slatex.trigger-region2232 (lambda (typ in env)2233 (let ((aux.tex (slatex.new-primary-aux-file ".tex"))2234 (aux2.tex (slatex.new-secondary-aux-file ".tex")))2235 (if (slatex.file-exists? aux2.tex) (slatex.delete-file aux2.tex))2236 (if (slatex.file-exists? aux.tex) (slatex.delete-file aux.tex))2237; (display ".")2238 (slatex.force-output)2239 (let ((%:g9% slatex.*slatex-in-protected-region?*)2240 (%:g10% slatex.*protected-files*))2241 (set! slatex.*slatex-in-protected-region?* #t)2242 (set! slatex.*protected-files* '())2243 (let ((%temp% (begin2244 (call-with-output-file/truncate2245 aux2.tex2246 (lambda (out)2247 (cond ((eq? typ 'envregion)2248 (slatex.dump-display2249 in2250 out2251 (string-append "\\end{" env "}")))2252 ((eq? typ 'plainregion)2253 (slatex.dump-display2254 in2255 out2256 (string-append "\\end" env)))2257 (else2258 (slatex.error 'slatex.trigger-region 1)))))2259 (slatex.process-tex-file aux2.tex)2260 (set! slatex.*protected-files*2261 (slatex.reverse! slatex.*protected-files*))2262 (call-with-input-file2263 aux2.tex2264 (lambda (in)2265 (call-with-output-file/truncate2266 aux.tex2267 (lambda (out)2268 (slatex.inline-protected-files in out)))))2269 (slatex.delete-file aux2.tex))))2270 (set! slatex.*slatex-in-protected-region?* %:g9%)2271 (set! slatex.*protected-files* %:g10%)2272 %temp%)))))22732274(define slatex.inline-protected-files2275 (lambda (in out)2276 (let ((done? #f))2277 (let loop ()2278 (if done?2279 'exit-loop2280 (begin2281 (let ((c (read-char in)))2282 (cond ((eof-object? c) (display "{}" out) (set! done? #t))2283 ((char=? c #\%) (slatex.eat-till-newline in))2284 ((char=? c #\\)2285 (let ((cs (slatex.read-ctrl-seq in)))2286 (cond ((string=? cs "begin")2287 (let ((cs (slatex.read-grouped-latexexp in)))2288 (cond ((member cs slatex.*display-triggerers*)2289 (slatex.inline-protected2290 'envdisplay2291 in2292 out2293 cs))2294 ((member cs slatex.*box-triggerers*)2295 (slatex.inline-protected2296 'envbox2297 in2298 out2299 cs))2300 ((member cs slatex.*region-triggerers*)2301 (slatex.inline-protected2302 'envregion2303 in2304 out2305 cs))2306 (else2307 (display "\\begin{" out)2308 (display cs out)2309 (display "}" out)))))2310 ((member cs slatex.*intext-triggerers*)2311 (slatex.inline-protected 'intext in out #f))2312 ((member cs slatex.*resultintext-triggerers*)2313 (slatex.inline-protected2314 'resultintext2315 in2316 out2317 #f))2318 ((member cs slatex.*display-triggerers*)2319 (slatex.inline-protected2320 'plaindisplay2321 in2322 out2323 cs))2324 ((member cs slatex.*box-triggerers*)2325 (slatex.inline-protected 'plainbox in out cs))2326 ((member cs slatex.*region-triggerers*)2327 (slatex.inline-protected 'plainregion in out cs))2328 ((member cs slatex.*input-triggerers*)2329 (slatex.inline-protected 'input in out cs))2330 (else (display "\\" out) (display cs out)))))2331 (else (display c out))))2332 (loop)))))))23332334(define slatex.inline-protected2335 (lambda (typ in out env)2336 (cond ((eq? typ 'envregion)2337 (display "\\begin{" out)2338 (display env out)2339 (display "}" out)2340 (slatex.dump-display in out (string-append "\\end{" env "}"))2341 (display "\\end{" out)2342 (display env out)2343 (display "}" out))2344 ((eq? typ 'plainregion)2345 (display "\\" out)2346 (display env out)2347 (slatex.dump-display in out (string-append "\\end" env))2348 (display "\\end" out)2349 (display env out))2350 (else2351 (let ((f (car slatex.*protected-files*)))2352 (set! slatex.*protected-files* (cdr slatex.*protected-files*))2353 (call-with-input-file2354 f2355 (lambda (in) (slatex.inline-protected-files in out)))2356 (slatex.delete-file f))2357 (cond ((memq typ '(intext resultintext)) (slatex.dump-intext in #f))2358 ((memq typ '(envdisplay envbox))2359 (slatex.dump-display in #f (string-append "\\end{" env "}")))2360 ((memq typ '(plaindisplay plainbox))2361 (slatex.dump-display in #f (string-append "\\end" env)))2362 ((eq? typ 'input) (slatex.read-filename in))2363 (else (slatex.error 'slatex.inline-protected 1)))))))23642365(define (main . args)2366 (run-benchmark2367 "slatex"2368 slatex-iters2369 (lambda (result) #t)2370 (lambda (filename) (lambda () (slatex.process-main-tex-file filename)))2371 "test"))23722373(main)