f5de8bdabf
Anyone using the sole export from slatex.rkt should really be using the functions provided by slatex-wrapper.rkt instead, which I imagine is why this has never been documented.
2432 lines
91 KiB
Racket
2432 lines
91 KiB
Racket
(module slatex mzscheme
|
|
(provide slatex::process-main-tex-file)
|
|
|
|
(define-syntax slatex::setf
|
|
(lambda (so)
|
|
(datum->syntax-object
|
|
so
|
|
(let ((so-d (syntax-object->datum so)))
|
|
(let ((l (cadr so-d)) (r (caddr so-d)))
|
|
(if (symbol? l)
|
|
`(set! ,l ,r)
|
|
(let ((a (car l)))
|
|
(if (eq? a 'list-ref)
|
|
(error "no") ; `(set-car! (list-tail ,@(cdr l)) ,r)
|
|
`(,(cond
|
|
((eq? a 'string-ref) 'string-set!)
|
|
((eq? a 'vector-ref) 'vector-set!)
|
|
((eq? a 'slatex::of) 'slatex::the-setter-for-of)
|
|
(else (error "setf ~s ~s is ill-formed\n" l r)))
|
|
,@(cdr l)
|
|
,r)))))))))
|
|
|
|
|
|
;Configured for Scheme dialect plt by scmxlate, v 0m,
|
|
;(c) Dorai Sitaram,
|
|
;http://www.ccs.neu.edu/~dorai/scmxlate/scmxlate.html
|
|
|
|
(define slatex::*slatex-version* "20050609")
|
|
|
|
(define slatex::*operating-system* (if (getenv "COMSPEC") 'windows 'unix))
|
|
|
|
(define-syntax slatex::defenum
|
|
(lambda (so)
|
|
(datum->syntax-object
|
|
so
|
|
(let ((so-d (syntax-object->datum so)))
|
|
(let loop ((z (cdr so-d)) (i 0) (r '()))
|
|
(if (null? z)
|
|
`(begin ,@r)
|
|
(loop
|
|
(cdr z)
|
|
(+ i 1)
|
|
(cons `(define ,(car z) (integer->char ,i)) r))))))))
|
|
|
|
(define-syntax slatex::defrecord
|
|
(lambda (so)
|
|
(datum->syntax-object
|
|
so
|
|
(let ((so-d (syntax-object->datum so)))
|
|
(let ((name (cadr so-d)) (fields (cddr so-d)))
|
|
(let loop ((fields fields) (i 0) (r '()))
|
|
(if (null? fields)
|
|
`(begin (define ,name (lambda () (make-vector ,i))) ,@r)
|
|
(loop
|
|
(cdr fields)
|
|
(+ i 1)
|
|
(cons `(define ,(car fields) ,i) r)))))))))
|
|
|
|
(define-syntax slatex::the-setter-for-of
|
|
(lambda (so)
|
|
(datum->syntax-object
|
|
so
|
|
(let ((so-d (syntax-object->datum so)))
|
|
(let ((r (cadr so-d))
|
|
(i (caddr so-d))
|
|
(j (cadddr so-d))
|
|
(z (cddddr so-d)))
|
|
(cond
|
|
((null? z) `(vector-set! ,r ,i ,j))
|
|
((and (eq? i '/) (= (length z) 1)) `(string-set! ,r ,j ,(car z)))
|
|
(else `(slatex::the-setter-for-of (vector-ref ,r ,i) ,j ,@z))))))))
|
|
|
|
(define-syntax slatex::of
|
|
(lambda (so)
|
|
(datum->syntax-object
|
|
so
|
|
(let ((so-d (syntax-object->datum so)))
|
|
(let ((r (cadr so-d)) (i (caddr so-d)) (z (cdddr so-d)))
|
|
(cond
|
|
((null? z) `(vector-ref ,r ,i))
|
|
((and (eq? i '/) (= (length z) 1)) `(string-ref ,r ,(car z)))
|
|
(else `(slatex::of (vector-ref ,r ,i) ,@z))))))))
|
|
|
|
(define slatex::ormapcdr
|
|
(lambda (f l)
|
|
(let loop ((l l)) (if (null? l) #f (or (f l) (loop (cdr l)))))))
|
|
|
|
(define slatex::list-prefix?
|
|
(lambda (pfx l)
|
|
(cond
|
|
((null? pfx) #t)
|
|
((null? l) #f)
|
|
((eqv? (car pfx) (car l)) (slatex::list-prefix? (cdr pfx) (cdr l)))
|
|
(else #f))))
|
|
|
|
(define slatex::string-suffix?
|
|
(lambda (sfx s)
|
|
(let ((sfx-len (string-length sfx)) (s-len (string-length s)))
|
|
(if (> sfx-len s-len)
|
|
#f
|
|
(let loop ((i (- sfx-len 1)) (j (- s-len 1)))
|
|
(if (< i 0)
|
|
#t
|
|
(and (char=? (string-ref sfx i) (string-ref s j))
|
|
(loop (- i 1) (- j 1)))))))))
|
|
|
|
(define slatex::mapcan
|
|
(lambda (f l)
|
|
(let loop ((l l))
|
|
(if (null? l) '() (append (f (car l)) (loop (cdr l)))))))
|
|
|
|
(define slatex::lassoc
|
|
(lambda (x al eq)
|
|
(let loop ((al al))
|
|
(if (null? al)
|
|
#f
|
|
(let ((c (car al))) (if (eq (car c) x) c (loop (cdr al))))))))
|
|
|
|
(define slatex::lmember
|
|
(lambda (x l eq)
|
|
(let loop ((l l)) (if (null? l) #f (if (eq (car l) x) l (loop (cdr l)))))))
|
|
|
|
(define slatex::delete
|
|
(lambda (x l eq)
|
|
(let loop ((l l))
|
|
(cond
|
|
((null? l) l)
|
|
((eq (car l) x) (loop (cdr l)))
|
|
(else (cons (car l) (loop (cdr l))))))))
|
|
|
|
(define slatex::adjoin
|
|
(lambda (x l eq) (if (slatex::lmember x l eq) l (cons x l))))
|
|
|
|
(define slatex::delete-if
|
|
(lambda (p s)
|
|
(let loop ((s s))
|
|
(cond
|
|
((null? s) s)
|
|
((p (car s)) (loop (cdr s)))
|
|
(else (cons (car s) (loop (cdr s))))))))
|
|
|
|
(define slatex::string-prefix?
|
|
(lambda (s1 s2 i)
|
|
(let loop ((j 0))
|
|
(if (= j i)
|
|
#t
|
|
(and (char=? (string-ref s1 j) (string-ref s2 j)) (loop (+ j 1)))))))
|
|
|
|
(define slatex::sublist
|
|
(lambda (l i f)
|
|
(let loop ((l (list-tail l i)) (k i) (r '()))
|
|
(cond
|
|
((>= k f) (reverse r))
|
|
((null? l) (slatex::slatex-error "sublist: List too small"))
|
|
(else (loop (cdr l) (+ k 1) (cons (car l) r)))))))
|
|
|
|
(define slatex::position-char
|
|
(lambda (c l)
|
|
(let loop ((l l) (i 0))
|
|
(cond
|
|
((null? l) #f)
|
|
((char=? (car l) c) i)
|
|
(else (loop (cdr l) (+ i 1)))))))
|
|
|
|
(define slatex::string-position-right
|
|
(lambda (c s)
|
|
(let ((n (string-length s)))
|
|
(let loop ((i (- n 1)))
|
|
(cond
|
|
((< i 0) #f)
|
|
((char=? (string-ref s i) c) i)
|
|
(else (loop (- i 1))))))))
|
|
|
|
(define slatex::*return* (integer->char 13))
|
|
|
|
(define slatex::*tab* (integer->char 9))
|
|
|
|
(define slatex::slatex-error
|
|
(lambda (where . what)
|
|
(display "Error: ")
|
|
(display where)
|
|
(newline)
|
|
(for-each (lambda (v) (write v) (newline)) what)
|
|
(error "slatex-error")))
|
|
|
|
(define slatex::exit-slatex (lambda () (exit)))
|
|
|
|
(define slatex::*slatex-case-sensitive?* #t)
|
|
|
|
(define slatex::keyword-tokens
|
|
(list
|
|
"=>"
|
|
"%"
|
|
"abort"
|
|
"and"
|
|
"begin"
|
|
"begin0"
|
|
"case"
|
|
"case-lambda"
|
|
"cond"
|
|
"define"
|
|
"define!"
|
|
"define-macro!"
|
|
"define-syntax"
|
|
"defmacro"
|
|
"defrec!"
|
|
"delay"
|
|
"do"
|
|
"else"
|
|
"extend-syntax"
|
|
"fluid-let"
|
|
"if"
|
|
"lambda"
|
|
"let"
|
|
"let*"
|
|
"letrec"
|
|
"let-syntax"
|
|
"letrec-syntax"
|
|
"or"
|
|
"quasiquote"
|
|
"quote"
|
|
"rec"
|
|
"record-case"
|
|
"record-evcase"
|
|
"recur"
|
|
"set!"
|
|
"sigma"
|
|
"struct"
|
|
"syntax"
|
|
"syntax-rules"
|
|
"trace"
|
|
"trace-lambda"
|
|
"trace-let"
|
|
"trace-recur"
|
|
"unless"
|
|
"unquote"
|
|
"unquote-splicing"
|
|
"untrace"
|
|
"when"
|
|
"with"))
|
|
|
|
(define slatex::variable-tokens '())
|
|
|
|
(define slatex::constant-tokens '())
|
|
|
|
(define slatex::data-tokens '())
|
|
|
|
(define slatex::special-symbols
|
|
(reverse
|
|
(reverse
|
|
'(("." . ".")
|
|
("..." . "{\\dots}")
|
|
("-" . "$-$")
|
|
("1-" . "\\va{1$-$}")
|
|
("-1+" . "\\va{$-$1$+$}")))))
|
|
|
|
(define slatex::macro-definers
|
|
'("define-syntax" "syntax-rules" "defmacro" "extend-syntax" "define-macro!"))
|
|
|
|
(define slatex::case-and-ilk '("case" "record-case"))
|
|
|
|
(define slatex::tex-analog
|
|
(lambda (c)
|
|
(case c
|
|
((#\$ #\& #\% #\# #\_) (string #\\ c))
|
|
((#\{ #\}) (string #\$ #\\ c #\$))
|
|
((#\\) "$\\backslash$")
|
|
((#\+) "$+$")
|
|
((#\*) "$\\ast$")
|
|
((#\=) "$=$")
|
|
((#\<) "$\\lt$")
|
|
((#\>) "$\\gt$")
|
|
((#\^) "\\^{}")
|
|
((#\|) "$\\vert$")
|
|
((#\~) "\\~{}")
|
|
((#\@) "{\\atsign}")
|
|
((#\") "{\\dq}")
|
|
(else (string c)))))
|
|
|
|
(define slatex::token=?
|
|
(lambda (t1 t2)
|
|
((if slatex::*slatex-case-sensitive?* string=? string-ci=?) t1 t2)))
|
|
|
|
(define slatex::*slatex-enabled?* #t)
|
|
|
|
(define slatex::*slatex-reenabler* "UNDEFINED")
|
|
|
|
(define slatex::*intext-triggerers* (list "scheme"))
|
|
|
|
(define slatex::*resultintext-triggerers* (list "schemeresult"))
|
|
|
|
(define slatex::*display-triggerers* (list "schemedisplay"))
|
|
|
|
(define slatex::*response-triggerers* (list "schemeresponse"))
|
|
|
|
(define slatex::*respbox-triggerers* (list "schemeresponsebox"))
|
|
|
|
(define slatex::*box-triggerers* (list "schemebox"))
|
|
|
|
(define slatex::*topbox-triggerers* (list "schemetopbox"))
|
|
|
|
(define slatex::*input-triggerers* (list "schemeinput"))
|
|
|
|
(define slatex::*region-triggerers* (list "schemeregion"))
|
|
|
|
(define slatex::*math-triggerers* '())
|
|
|
|
(define slatex::*slatex-in-protected-region?* #f)
|
|
|
|
(define slatex::*protected-files* '())
|
|
|
|
(define slatex::*include-onlys* 'all)
|
|
|
|
(define slatex::*latex?* #t)
|
|
|
|
(define slatex::*slatex-separate-includes?* #f)
|
|
|
|
(define slatex::*tex-calling-directory* "")
|
|
|
|
(define slatex::*max-line-length* 300)
|
|
|
|
(slatex::defenum
|
|
&void-space
|
|
&plain-space
|
|
&init-space
|
|
&init-plain-space
|
|
&paren-space
|
|
&bracket-space
|
|
"e-space
|
|
&inner-space)
|
|
|
|
(slatex::defenum &void-tab &set-tab &move-tab &tabbed-crg-ret &plain-crg-ret)
|
|
|
|
(slatex::defenum
|
|
&void-notab
|
|
&begin-comment
|
|
&mid-comment
|
|
&begin-string
|
|
&mid-string
|
|
&end-string
|
|
&begin-math
|
|
&mid-math
|
|
&end-math)
|
|
|
|
(slatex::defrecord
|
|
slatex::make-raw-line
|
|
slatex::=rtedge
|
|
slatex::=char
|
|
slatex::=space
|
|
slatex::=tab
|
|
slatex::=notab)
|
|
|
|
(define slatex::make-line
|
|
(lambda ()
|
|
(let ((l (slatex::make-raw-line)))
|
|
(slatex::setf (slatex::of l slatex::=rtedge) 0)
|
|
(slatex::setf
|
|
(slatex::of l slatex::=char)
|
|
(make-string slatex::*max-line-length* #\space))
|
|
(slatex::setf
|
|
(slatex::of l slatex::=space)
|
|
(make-string slatex::*max-line-length* &void-space))
|
|
(slatex::setf
|
|
(slatex::of l slatex::=tab)
|
|
(make-string slatex::*max-line-length* &void-tab))
|
|
(slatex::setf
|
|
(slatex::of l slatex::=notab)
|
|
(make-string slatex::*max-line-length* &void-notab))
|
|
l)))
|
|
|
|
(define slatex::*line1* (slatex::make-line))
|
|
|
|
(define slatex::*line2* (slatex::make-line))
|
|
|
|
(slatex::defrecord
|
|
slatex::make-case-frame
|
|
slatex::=in-ctag-tkn
|
|
slatex::=in-bktd-ctag-exp
|
|
slatex::=in-case-exp)
|
|
|
|
(slatex::defrecord
|
|
slatex::make-bq-frame
|
|
slatex::=in-comma
|
|
slatex::=in-bq-tkn
|
|
slatex::=in-bktd-bq-exp)
|
|
|
|
(define slatex::*latex-paragraph-mode?* 'fwd1)
|
|
|
|
(define slatex::*intext?* 'fwd2)
|
|
|
|
(define slatex::*code-env-spec* "UNDEFINED")
|
|
|
|
(define slatex::*in* 'fwd3)
|
|
|
|
(define slatex::*out* 'fwd4)
|
|
|
|
(define slatex::*in-qtd-tkn* 'fwd5)
|
|
|
|
(define slatex::*in-bktd-qtd-exp* 'fwd6)
|
|
|
|
(define slatex::*in-mac-tkn* 'fwd7)
|
|
|
|
(define slatex::*in-bktd-mac-exp* 'fwd8)
|
|
|
|
(define slatex::*case-stack* 'fwd9)
|
|
|
|
(define slatex::*bq-stack* 'fwd10)
|
|
|
|
(define slatex::display-space
|
|
(lambda (s p)
|
|
(cond
|
|
((eq? s &plain-space) (display #\space p))
|
|
((eq? s &init-plain-space) (display #\space p))
|
|
((eq? s &init-space) (display "\\HL " p))
|
|
((eq? s &paren-space) (display "\\PRN " p))
|
|
((eq? s &bracket-space) (display "\\BKT " p))
|
|
((eq? s "e-space) (display "\\QUO " p))
|
|
((eq? s &inner-space) (display "\\ " p)))))
|
|
|
|
(define slatex::display-tab
|
|
(lambda (tab p)
|
|
(cond
|
|
((eq? tab &set-tab) (display "\\=" p))
|
|
((eq? tab &move-tab) (display "\\>" p)))))
|
|
|
|
(define slatex::display-notab
|
|
(lambda (notab p)
|
|
(cond
|
|
((eq? notab &begin-string) (display "\\dt{" p))
|
|
((eq? notab &end-string) (display "}" p)))))
|
|
|
|
(define slatex::prim-data-token?
|
|
(lambda (token)
|
|
(or (char=? (string-ref token 0) #\#) (string->number token))))
|
|
|
|
(define slatex::set-keyword
|
|
(lambda (x)
|
|
(if (not (slatex::lmember x slatex::keyword-tokens slatex::token=?))
|
|
(begin
|
|
(set! slatex::constant-tokens
|
|
(slatex::delete x slatex::constant-tokens slatex::token=?))
|
|
(set! slatex::variable-tokens
|
|
(slatex::delete x slatex::variable-tokens slatex::token=?))
|
|
(set! slatex::data-tokens
|
|
(slatex::delete x slatex::data-tokens slatex::token=?))
|
|
(set! slatex::keyword-tokens (cons x slatex::keyword-tokens))))))
|
|
|
|
(define slatex::set-constant
|
|
(lambda (x)
|
|
(if (not (slatex::lmember x slatex::constant-tokens slatex::token=?))
|
|
(begin
|
|
(set! slatex::keyword-tokens
|
|
(slatex::delete x slatex::keyword-tokens slatex::token=?))
|
|
(set! slatex::variable-tokens
|
|
(slatex::delete x slatex::variable-tokens slatex::token=?))
|
|
(set! slatex::data-tokens
|
|
(slatex::delete x slatex::data-tokens slatex::token=?))
|
|
(set! slatex::constant-tokens (cons x slatex::constant-tokens))))))
|
|
|
|
(define slatex::set-variable
|
|
(lambda (x)
|
|
(if (not (slatex::lmember x slatex::variable-tokens slatex::token=?))
|
|
(begin
|
|
(set! slatex::keyword-tokens
|
|
(slatex::delete x slatex::keyword-tokens slatex::token=?))
|
|
(set! slatex::constant-tokens
|
|
(slatex::delete x slatex::constant-tokens slatex::token=?))
|
|
(set! slatex::data-tokens
|
|
(slatex::delete x slatex::data-tokens slatex::token=?))
|
|
(set! slatex::variable-tokens (cons x slatex::variable-tokens))))))
|
|
|
|
(define slatex::set-data
|
|
(lambda (x)
|
|
(if (not (slatex::lmember x slatex::data-tokens slatex::token=?))
|
|
(begin
|
|
(set! slatex::keyword-tokens
|
|
(slatex::delete x slatex::keyword-tokens slatex::token=?))
|
|
(set! slatex::constant-tokens
|
|
(slatex::delete x slatex::constant-tokens slatex::token=?))
|
|
(set! slatex::variable-tokens
|
|
(slatex::delete x slatex::variable-tokens slatex::token=?))
|
|
(set! slatex::data-tokens (cons x slatex::data-tokens))))))
|
|
|
|
(define slatex::set-special-symbol
|
|
(lambda (x transl)
|
|
(set! slatex::special-symbols
|
|
(cons (cons x transl)
|
|
(slatex::delete x slatex::special-symbols
|
|
(lambda (a x) (slatex::token=? (car a) x)))))))
|
|
|
|
(define slatex::unset-special-symbol
|
|
(lambda (x)
|
|
(set! slatex::special-symbols
|
|
(slatex::delete-if
|
|
(lambda (c) (slatex::token=? (car c) x))
|
|
slatex::special-symbols))))
|
|
|
|
(define slatex::texify (lambda (s) (list->string (slatex::texify-aux s))))
|
|
|
|
(define slatex::texify-data
|
|
(lambda (s)
|
|
(let loop ((l (slatex::texify-aux s)) (r '()))
|
|
(if (null? l)
|
|
(list->string (reverse r))
|
|
(let ((c (car l)))
|
|
(loop
|
|
(cdr l)
|
|
(if (char=? c #\-) (append (list #\$ c #\$) r) (cons c r))))))))
|
|
|
|
(define slatex::texify-aux
|
|
(let ((arrow (string->list "-$>$"))
|
|
(em-dash (string->list "---"))
|
|
(en-dash (string->list "--"))
|
|
(arrow2 (reverse (string->list "$\\to$")))
|
|
(em-dash-2 (reverse (string->list "${-}{-}{-}$")))
|
|
(en-dash-2 (reverse (string->list "${-}{-}$"))))
|
|
(lambda (s)
|
|
(let ((texified-sl
|
|
(slatex::mapcan
|
|
(lambda (c) (string->list (slatex::tex-analog c)))
|
|
(string->list s))))
|
|
(let loop ((d texified-sl) (a null))
|
|
(cond
|
|
((null? d) (reverse a))
|
|
((slatex::list-prefix? arrow d)
|
|
(loop (list-tail d 4)
|
|
(append arrow2 a)))
|
|
((slatex::list-prefix? em-dash d)
|
|
(loop (list-tail d 3)
|
|
(append em-dash-2 a)))
|
|
((slatex::list-prefix? en-dash d)
|
|
(loop (list-tail d 2)
|
|
(append en-dash-2 a)))
|
|
(else (loop (cdr d) (cons (car d) a)))))))))
|
|
|
|
(define slatex::display-begin-sequence
|
|
(lambda (out)
|
|
(if (or slatex::*intext?* (not slatex::*latex?*))
|
|
(begin
|
|
(display "\\" out)
|
|
(display slatex::*code-env-spec* out)
|
|
(newline out))
|
|
(begin
|
|
(display "\\begin{" out)
|
|
(display slatex::*code-env-spec* out)
|
|
(display "}%" out)
|
|
(newline out)))))
|
|
|
|
(define slatex::display-end-sequence
|
|
(lambda (out)
|
|
(cond
|
|
(slatex::*intext?*
|
|
(display "\\end" out)
|
|
(display slatex::*code-env-spec* out)
|
|
(newline out))
|
|
(slatex::*latex?*
|
|
(display "\\end{" out)
|
|
(display slatex::*code-env-spec* out)
|
|
(display "}" out)
|
|
(newline out))
|
|
(else
|
|
(display "\\end" out)
|
|
(display slatex::*code-env-spec* out)
|
|
(newline out)))))
|
|
|
|
(define slatex::display-tex-char
|
|
(lambda (c p) (display (if (char? c) (slatex::tex-analog c) c) p)))
|
|
|
|
(define slatex::display-token
|
|
(lambda (s typ p)
|
|
(cond
|
|
((eq? typ 'syntax)
|
|
(display "\\sy{" p)
|
|
(display (slatex::texify s) p)
|
|
(display "}" p))
|
|
((eq? typ 'variable)
|
|
(display "\\va{" p)
|
|
(display (slatex::texify s) p)
|
|
(display "}" p))
|
|
((eq? typ 'constant)
|
|
(display "\\cn{" p)
|
|
(display (slatex::texify s) p)
|
|
(display "}" p))
|
|
((eq? typ 'data)
|
|
(display "\\dt{" p)
|
|
(display (slatex::texify-data s) p)
|
|
(display "}" p))
|
|
(else
|
|
(slatex::slatex-error
|
|
'slatex::display-token
|
|
"Unknown token type"
|
|
typ)))))
|
|
|
|
(define slatex::get-line
|
|
(let ((curr-notab &void-notab))
|
|
(lambda (line)
|
|
(let ((graphic-char-seen? #f))
|
|
(let loop ((i 0))
|
|
(let ((c (read-char slatex::*in*)))
|
|
(cond
|
|
(graphic-char-seen? (void))
|
|
((or (eof-object? c)
|
|
(char=? c slatex::*return*)
|
|
(char=? c #\newline)
|
|
(char=? c #\space)
|
|
(char=? c slatex::*tab*))
|
|
(void))
|
|
(else (set! graphic-char-seen? #t)))
|
|
(cond
|
|
((eof-object? c)
|
|
(cond
|
|
((eq? curr-notab &mid-string)
|
|
(if (> i 0)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / (- i 1))
|
|
&end-string)))
|
|
((eq? curr-notab &mid-comment) (set! curr-notab &void-notab))
|
|
((eq? curr-notab &mid-math)
|
|
(slatex::slatex-error
|
|
'slatex::get-line
|
|
"Found eof inside math")))
|
|
(slatex::setf (slatex::of line slatex::=char / i) #\newline)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &void-notab)
|
|
(slatex::setf (slatex::of line slatex::=rtedge) i)
|
|
(if (eq? (slatex::of line slatex::=notab / 0) &mid-string)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / 0)
|
|
&begin-string))
|
|
(if (= i 0) #f #t))
|
|
((or (char=? c slatex::*return*) (char=? c #\newline))
|
|
(if (and (memv
|
|
slatex::*operating-system*
|
|
'(dos windows os2 os2fat))
|
|
(char=? c slatex::*return*))
|
|
(if (char=? (peek-char slatex::*in*) #\newline)
|
|
(read-char slatex::*in*)))
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &void-notab)
|
|
(cond
|
|
((eq? curr-notab &mid-string)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / i)
|
|
&end-string))
|
|
((eq? curr-notab &mid-comment) (set! curr-notab &void-notab))
|
|
((eq? curr-notab &mid-math)
|
|
(slatex::slatex-error
|
|
'slatex::get-line
|
|
"Sorry, you can't split "
|
|
"math formulas across lines in Scheme code")))
|
|
(slatex::setf (slatex::of line slatex::=char / i) #\newline)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=tab / i)
|
|
(cond
|
|
((eof-object? (peek-char slatex::*in*)) &plain-crg-ret)
|
|
(slatex::*intext?* &plain-crg-ret)
|
|
(else &tabbed-crg-ret)))
|
|
(slatex::setf (slatex::of line slatex::=rtedge) i)
|
|
(if (eq? (slatex::of line slatex::=notab / 0) &mid-string)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / 0)
|
|
&begin-string))
|
|
#t)
|
|
((eq? curr-notab &mid-comment)
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
(cond
|
|
((char=? c #\space) &plain-space)
|
|
((char=? c slatex::*tab*) &plain-space)
|
|
(else &void-space)))
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &mid-comment)
|
|
(loop (+ i 1)))
|
|
((char=? c #\\)
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) curr-notab)
|
|
(let ((i+1 (+ i 1)) (c+1 (read-char slatex::*in*)))
|
|
(if (char=? c+1 slatex::*tab*) (set! c+1 #\space))
|
|
(slatex::setf (slatex::of line slatex::=char / i+1) c+1)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i+1)
|
|
(if (char=? c+1 #\space) &plain-space &void-space))
|
|
(slatex::setf (slatex::of line slatex::=tab / i+1) &void-tab)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / i+1)
|
|
curr-notab)
|
|
(loop (+ i+1 1))))
|
|
((eq? curr-notab &mid-math)
|
|
(if (char=? c slatex::*tab*) (set! c #\space))
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
(if (char=? c #\space) &plain-space &void-space))
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(cond
|
|
((memv c slatex::*math-triggerers*)
|
|
(slatex::setf (slatex::of line slatex::=char / i) #\$)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &end-math)
|
|
(slatex::setf curr-notab &void-notab))
|
|
(else
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &mid-math)))
|
|
(loop (+ i 1)))
|
|
((eq? curr-notab &mid-string)
|
|
(if (char=? c slatex::*tab*) (set! c #\space))
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
(if (char=? c #\space) &inner-space &void-space))
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / i)
|
|
(cond
|
|
((char=? c #\") (set! curr-notab &void-notab) &end-string)
|
|
(else &mid-string)))
|
|
(loop (+ i 1)))
|
|
((char=? c #\space)
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
(cond
|
|
(slatex::*intext?* &plain-space)
|
|
(graphic-char-seen? &inner-space)
|
|
(else &init-space)))
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &void-notab)
|
|
(loop (+ i 1)))
|
|
((char=? c slatex::*tab*)
|
|
(let loop1 ((i i) (j 0))
|
|
(if (< j 8)
|
|
(begin
|
|
(slatex::setf (slatex::of line slatex::=char / i) #\space)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
(cond
|
|
(slatex::*intext?* &plain-space)
|
|
(graphic-char-seen? &inner-space)
|
|
(else &init-space)))
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / i)
|
|
&void-notab)
|
|
(loop1 (+ i 1) (+ j 1)))))
|
|
(loop (+ i 8)))
|
|
((char=? c #\")
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &begin-string)
|
|
(set! curr-notab &mid-string)
|
|
(loop (+ i 1)))
|
|
((char=? c #\;)
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / i)
|
|
&begin-comment)
|
|
(set! curr-notab &mid-comment)
|
|
(loop (+ i 1)))
|
|
((memv c slatex::*math-triggerers*)
|
|
(slatex::setf (slatex::of line slatex::=char / i) #\$)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &begin-math)
|
|
(set! curr-notab &mid-math)
|
|
(loop (+ i 1)))
|
|
(else
|
|
(slatex::setf (slatex::of line slatex::=char / i) c)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=notab / i) &void-notab)
|
|
(loop (+ i 1))))))))))
|
|
|
|
(define slatex::peephole-adjust
|
|
(lambda (curr prev)
|
|
(if (or (slatex::blank-line? curr) (slatex::flush-comment-line? curr))
|
|
(if (not slatex::*latex-paragraph-mode?*)
|
|
(begin
|
|
(set! slatex::*latex-paragraph-mode?* #t)
|
|
(if (not slatex::*intext?*)
|
|
(begin
|
|
(slatex::remove-some-tabs prev 0)
|
|
(let ((prev-rtedge (slatex::of prev slatex::=rtedge)))
|
|
(if (eq?
|
|
(slatex::of prev slatex::=tab / prev-rtedge)
|
|
&tabbed-crg-ret)
|
|
(slatex::setf
|
|
(slatex::of
|
|
prev
|
|
slatex::=tab
|
|
/
|
|
(slatex::of prev slatex::=rtedge))
|
|
&plain-crg-ret)))))))
|
|
(begin
|
|
(if slatex::*latex-paragraph-mode?*
|
|
(set! slatex::*latex-paragraph-mode?* #f)
|
|
(if (not slatex::*intext?*)
|
|
(let ((remove-tabs-from #f))
|
|
(let loop ((i 0))
|
|
(cond
|
|
((char=? (slatex::of curr slatex::=char / i) #\newline)
|
|
(set! remove-tabs-from i))
|
|
((char=? (slatex::of prev slatex::=char / i) #\newline)
|
|
(set! remove-tabs-from #f))
|
|
((eq? (slatex::of curr slatex::=space / i) &init-space)
|
|
(if (eq? (slatex::of prev slatex::=notab / i) &void-notab)
|
|
(begin
|
|
(cond
|
|
((or (char=? (slatex::of prev slatex::=char / i) #\()
|
|
(eq?
|
|
(slatex::of prev slatex::=space / i)
|
|
&paren-space))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=space / i)
|
|
&paren-space))
|
|
((or (char=? (slatex::of prev slatex::=char / i) #\[)
|
|
(eq?
|
|
(slatex::of prev slatex::=space / i)
|
|
&bracket-space))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=space / i)
|
|
&bracket-space))
|
|
((or (memv
|
|
(slatex::of prev slatex::=char / i)
|
|
'(#\' #\` #\,))
|
|
(eq?
|
|
(slatex::of prev slatex::=space / i)
|
|
"e-space))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=space / i)
|
|
"e-space)))
|
|
(if (memq
|
|
(slatex::of prev slatex::=tab / i)
|
|
(list &set-tab &move-tab))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=tab / i)
|
|
&move-tab))))
|
|
(loop (+ i 1)))
|
|
((= i 0) (set! remove-tabs-from 0))
|
|
((not (eq? (slatex::of prev slatex::=tab / i) &void-tab))
|
|
(set! remove-tabs-from (+ i 1))
|
|
(if (memq
|
|
(slatex::of prev slatex::=tab / i)
|
|
(list &set-tab &move-tab))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=tab / i)
|
|
&move-tab)))
|
|
((memq
|
|
(slatex::of prev slatex::=space / i)
|
|
(list
|
|
&init-space
|
|
&init-plain-space
|
|
&paren-space
|
|
&bracket-space
|
|
"e-space))
|
|
(set! remove-tabs-from (+ i 1)))
|
|
((and (char=?
|
|
(slatex::of prev slatex::=char / (- i 1))
|
|
#\space)
|
|
(eq?
|
|
(slatex::of prev slatex::=notab / (- i 1))
|
|
&void-notab))
|
|
(set! remove-tabs-from (+ i 1))
|
|
(slatex::setf (slatex::of prev slatex::=tab / i) &set-tab)
|
|
(slatex::setf (slatex::of curr slatex::=tab / i) &move-tab))
|
|
(else
|
|
(set! remove-tabs-from (+ i 1))
|
|
(let loop1 ((j (- i 1)))
|
|
(cond
|
|
((<= j 0) 'exit-loop1)
|
|
((not (eq? (slatex::of curr slatex::=tab / j) &void-tab))
|
|
'exit-loop1)
|
|
((memq
|
|
(slatex::of curr slatex::=space / j)
|
|
(list &paren-space &bracket-space "e-space))
|
|
(loop1 (- j 1)))
|
|
((or (not
|
|
(eq?
|
|
(slatex::of prev slatex::=notab / j)
|
|
&void-notab))
|
|
(char=? (slatex::of prev slatex::=char / j) #\space))
|
|
(let ((k (+ j 1)))
|
|
(if (not
|
|
(memq
|
|
(slatex::of prev slatex::=notab / k)
|
|
(list
|
|
&mid-comment
|
|
&mid-math
|
|
&end-math
|
|
&mid-string
|
|
&end-string)))
|
|
(begin
|
|
(if (eq?
|
|
(slatex::of prev slatex::=tab / k)
|
|
&void-tab)
|
|
(slatex::setf
|
|
(slatex::of prev slatex::=tab / k)
|
|
&set-tab))
|
|
(slatex::setf
|
|
(slatex::of curr slatex::=tab / k)
|
|
&move-tab)))))
|
|
(else 'anything-else?))))))
|
|
(slatex::remove-some-tabs prev remove-tabs-from))))
|
|
(if (not slatex::*intext?*) (slatex::add-some-tabs curr))
|
|
(slatex::clean-init-spaces curr)
|
|
(slatex::clean-inner-spaces curr)))))
|
|
|
|
(define slatex::add-some-tabs
|
|
(lambda (line)
|
|
(let loop ((i 1) (succ-parens? #f))
|
|
(let ((c (slatex::of line slatex::=char / i)))
|
|
(cond
|
|
((char=? c #\newline) 'exit-loop)
|
|
((not (eq? (slatex::of line slatex::=notab / i) &void-notab))
|
|
(loop (+ i 1) #f))
|
|
((char=? c #\[)
|
|
(if (eq? (slatex::of line slatex::=tab / i) &void-tab)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &set-tab))
|
|
(loop (+ i 1) #f))
|
|
((char=? c #\()
|
|
(if (eq? (slatex::of line slatex::=tab / i) &void-tab)
|
|
(if (not succ-parens?)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &set-tab)))
|
|
(loop (+ i 1) #t))
|
|
(else (loop (+ i 1) #f)))))))
|
|
|
|
(define slatex::remove-some-tabs
|
|
(lambda (line i)
|
|
(if i
|
|
(let loop ((i i))
|
|
(cond
|
|
((char=? (slatex::of line slatex::=char / i) #\newline) 'exit)
|
|
((eq? (slatex::of line slatex::=tab / i) &set-tab)
|
|
(slatex::setf (slatex::of line slatex::=tab / i) &void-tab)
|
|
(loop (+ i 1)))
|
|
(else (loop (+ i 1))))))))
|
|
|
|
(define slatex::clean-init-spaces
|
|
(lambda (line)
|
|
(let loop ((i (slatex::of line slatex::=rtedge)))
|
|
(cond
|
|
((< i 0) 'exit-loop)
|
|
((eq? (slatex::of line slatex::=tab / i) &move-tab)
|
|
(let loop1 ((i (- i 1)))
|
|
(cond
|
|
((< i 0) 'exit-loop1)
|
|
((memq
|
|
(slatex::of line slatex::=space / i)
|
|
(list &init-space &paren-space &bracket-space "e-space))
|
|
(slatex::setf
|
|
(slatex::of line slatex::=space / i)
|
|
&init-plain-space)
|
|
(loop1 (- i 1)))
|
|
(else (loop1 (- i 1))))))
|
|
(else (loop (- i 1)))))))
|
|
|
|
(define slatex::clean-inner-spaces
|
|
(lambda (line)
|
|
(let loop ((i 0) (succ-inner-spaces? #f))
|
|
(cond
|
|
((char=? (slatex::of line slatex::=char / i) #\newline) 'exit-loop)
|
|
((eq? (slatex::of line slatex::=space / i) &inner-space)
|
|
(if (not succ-inner-spaces?)
|
|
(slatex::setf (slatex::of line slatex::=space / i) &plain-space))
|
|
(loop (+ i 1) #t))
|
|
(else (loop (+ i 1) #f))))))
|
|
|
|
(define slatex::blank-line?
|
|
(lambda (line)
|
|
(let loop ((i 0))
|
|
(let ((c (slatex::of line slatex::=char / i)))
|
|
(cond
|
|
((char=? c #\space)
|
|
(if (eq? (slatex::of line slatex::=notab / i) &void-notab)
|
|
(loop (+ i 1))
|
|
#f))
|
|
((char=? c #\newline)
|
|
(let loop1 ((j (- i 1)))
|
|
(if (not (<= j 0))
|
|
(begin
|
|
(slatex::setf (slatex::of line slatex::=space / i) &void-space)
|
|
(loop1 (- j 1)))))
|
|
#t)
|
|
(else #f))))))
|
|
|
|
(define slatex::flush-comment-line?
|
|
(lambda (line)
|
|
(and (char=? (slatex::of line slatex::=char / 0) #\;)
|
|
(eq? (slatex::of line slatex::=notab / 0) &begin-comment)
|
|
(not (char=? (slatex::of line slatex::=char / 1) #\;)))))
|
|
|
|
(define slatex::display-tex-line
|
|
(lambda (line)
|
|
(cond
|
|
(else
|
|
(let loop ((i (if (slatex::flush-comment-line? line) 1 0)))
|
|
(let ((c (slatex::of line slatex::=char / i)))
|
|
(if (char=? c #\newline)
|
|
(if (not (eq? (slatex::of line slatex::=tab / i) &void-tab))
|
|
(newline slatex::*out*))
|
|
(begin (write-char c slatex::*out*) (loop (+ i 1))))))))))
|
|
|
|
(define slatex::display-scm-line
|
|
(lambda (line)
|
|
(let loop ((i 0))
|
|
(let ((c (slatex::of line slatex::=char / i)))
|
|
(cond
|
|
((char=? c #\newline)
|
|
(let ((notab (slatex::of line slatex::=notab / i))
|
|
(tab (slatex::of line slatex::=tab / i)))
|
|
(if (eq? notab &end-string) (display "}" slatex::*out*))
|
|
(cond
|
|
((eq? tab &tabbed-crg-ret)
|
|
(display "\\\\%" slatex::*out*)
|
|
(newline slatex::*out*))
|
|
((eq? tab &plain-crg-ret) (newline slatex::*out*))
|
|
((eq? tab &void-tab)
|
|
(write-char #\% slatex::*out*)
|
|
(newline slatex::*out*)))))
|
|
((eq? (slatex::of line slatex::=notab / i) &begin-comment)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &mid-comment)
|
|
(write-char c slatex::*out*)
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &begin-string)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(display "\\dt{" slatex::*out*)
|
|
(if (char=? c #\space)
|
|
(slatex::display-space
|
|
(slatex::of line slatex::=space / i)
|
|
slatex::*out*)
|
|
(slatex::display-tex-char c slatex::*out*))
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &mid-string)
|
|
(if (char=? c #\space)
|
|
(slatex::display-space
|
|
(slatex::of line slatex::=space / i)
|
|
slatex::*out*)
|
|
(slatex::display-tex-char c slatex::*out*))
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &end-string)
|
|
(if (char=? c #\space)
|
|
(slatex::display-space
|
|
(slatex::of line slatex::=space / i)
|
|
slatex::*out*)
|
|
(slatex::display-tex-char c slatex::*out*))
|
|
(write-char #\} slatex::*out*)
|
|
(if slatex::*in-qtd-tkn*
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(if slatex::*in-mac-tkn* (set! slatex::*in-mac-tkn* #f)))
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &begin-math)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &mid-math)
|
|
(write-char c slatex::*out*)
|
|
(loop (+ i 1)))
|
|
((eq? (slatex::of line slatex::=notab / i) &end-math)
|
|
(write-char c slatex::*out*)
|
|
(if slatex::*in-qtd-tkn*
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(if slatex::*in-mac-tkn* (set! slatex::*in-mac-tkn* #f)))
|
|
(loop (+ i 1)))
|
|
((char=? c #\space)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(slatex::display-space
|
|
(slatex::of line slatex::=space / i)
|
|
slatex::*out*)
|
|
(loop (+ i 1)))
|
|
((char=? c #\')
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(if (or slatex::*in-qtd-tkn*
|
|
(> slatex::*in-bktd-qtd-exp* 0)
|
|
(and (pair? slatex::*bq-stack*)
|
|
(not
|
|
(slatex::of
|
|
(car slatex::*bq-stack*)
|
|
slatex::=in-comma))))
|
|
#f
|
|
(set! slatex::*in-qtd-tkn* #t))
|
|
(loop (+ i 1)))
|
|
((char=? c #\`)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(if (or (null? slatex::*bq-stack*)
|
|
(slatex::of (car slatex::*bq-stack*) slatex::=in-comma))
|
|
(set! slatex::*bq-stack*
|
|
(cons
|
|
(let ((f (slatex::make-bq-frame)))
|
|
(slatex::setf (slatex::of f slatex::=in-comma) #f)
|
|
(slatex::setf (slatex::of f slatex::=in-bq-tkn) #t)
|
|
(slatex::setf (slatex::of f slatex::=in-bktd-bq-exp) 0)
|
|
f)
|
|
slatex::*bq-stack*)))
|
|
(loop (+ i 1)))
|
|
((char=? c #\,)
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(if (not
|
|
(or (null? slatex::*bq-stack*)
|
|
(slatex::of (car slatex::*bq-stack*) slatex::=in-comma)))
|
|
(set! slatex::*bq-stack*
|
|
(cons
|
|
(let ((f (slatex::make-bq-frame)))
|
|
(slatex::setf (slatex::of f slatex::=in-comma) #t)
|
|
(slatex::setf (slatex::of f slatex::=in-bq-tkn) #t)
|
|
(slatex::setf (slatex::of f slatex::=in-bktd-bq-exp) 0)
|
|
f)
|
|
slatex::*bq-stack*)))
|
|
(if (char=? (slatex::of line slatex::=char / (+ i 1)) #\@)
|
|
(begin (slatex::display-tex-char #\@ slatex::*out*) (loop (+ 2 i)))
|
|
(loop (+ i 1))))
|
|
((memv c '(#\( #\[))
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(cond
|
|
(slatex::*in-qtd-tkn*
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(set! slatex::*in-bktd-qtd-exp* 1))
|
|
((> slatex::*in-bktd-qtd-exp* 0)
|
|
(set! slatex::*in-bktd-qtd-exp* (+ slatex::*in-bktd-qtd-exp* 1))))
|
|
(cond
|
|
(slatex::*in-mac-tkn*
|
|
(set! slatex::*in-mac-tkn* #f)
|
|
(set! slatex::*in-bktd-mac-exp* 1))
|
|
((> slatex::*in-bktd-mac-exp* 0)
|
|
(set! slatex::*in-bktd-mac-exp* (+ slatex::*in-bktd-mac-exp* 1))))
|
|
(if (not (null? slatex::*bq-stack*))
|
|
(let ((top (car slatex::*bq-stack*)))
|
|
(cond
|
|
((slatex::of top slatex::=in-bq-tkn)
|
|
(slatex::setf (slatex::of top slatex::=in-bq-tkn) #f)
|
|
(slatex::setf (slatex::of top slatex::=in-bktd-bq-exp) 1))
|
|
((> (slatex::of top slatex::=in-bktd-bq-exp) 0)
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-bktd-bq-exp)
|
|
(+ (slatex::of top slatex::=in-bktd-bq-exp) 1))))))
|
|
(if (not (null? slatex::*case-stack*))
|
|
(let ((top (car slatex::*case-stack*)))
|
|
(cond
|
|
((slatex::of top slatex::=in-ctag-tkn)
|
|
(slatex::setf (slatex::of top slatex::=in-ctag-tkn) #f)
|
|
(slatex::setf (slatex::of top slatex::=in-bktd-ctag-exp) 1))
|
|
((> (slatex::of top slatex::=in-bktd-ctag-exp) 0)
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-bktd-ctag-exp)
|
|
(+ (slatex::of top slatex::=in-bktd-ctag-exp) 1)))
|
|
((> (slatex::of top slatex::=in-case-exp) 0)
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-case-exp)
|
|
(+ (slatex::of top slatex::=in-case-exp) 1))
|
|
(if (= (slatex::of top slatex::=in-case-exp) 2)
|
|
(set! slatex::*in-qtd-tkn* #t))))))
|
|
(loop (+ i 1)))
|
|
((memv c '(#\) #\]))
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(write-char c slatex::*out*)
|
|
(if (> slatex::*in-bktd-qtd-exp* 0)
|
|
(set! slatex::*in-bktd-qtd-exp* (- slatex::*in-bktd-qtd-exp* 1)))
|
|
(if (> slatex::*in-bktd-mac-exp* 0)
|
|
(set! slatex::*in-bktd-mac-exp* (- slatex::*in-bktd-mac-exp* 1)))
|
|
(if (not (null? slatex::*bq-stack*))
|
|
(let ((top (car slatex::*bq-stack*)))
|
|
(if (> (slatex::of top slatex::=in-bktd-bq-exp) 0)
|
|
(begin
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-bktd-bq-exp)
|
|
(- (slatex::of top slatex::=in-bktd-bq-exp) 1))
|
|
(if (= (slatex::of top slatex::=in-bktd-bq-exp) 0)
|
|
(set! slatex::*bq-stack* (cdr slatex::*bq-stack*)))))))
|
|
(let loop ()
|
|
(if (not (null? slatex::*case-stack*))
|
|
(let ((top (car slatex::*case-stack*)))
|
|
(cond
|
|
((> (slatex::of top slatex::=in-bktd-ctag-exp) 0)
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-bktd-ctag-exp)
|
|
(- (slatex::of top slatex::=in-bktd-ctag-exp) 1))
|
|
(if (= (slatex::of top slatex::=in-bktd-ctag-exp) 0)
|
|
(slatex::setf (slatex::of top slatex::=in-case-exp) 1)))
|
|
((> (slatex::of top slatex::=in-case-exp) 0)
|
|
(slatex::setf
|
|
(slatex::of top slatex::=in-case-exp)
|
|
(- (slatex::of top slatex::=in-case-exp) 1))
|
|
(if (= (slatex::of top slatex::=in-case-exp) 0)
|
|
(begin
|
|
(set! slatex::*case-stack* (cdr slatex::*case-stack*))
|
|
(loop))))))))
|
|
(loop (+ i 1)))
|
|
(else
|
|
(slatex::display-tab
|
|
(slatex::of line slatex::=tab / i)
|
|
slatex::*out*)
|
|
(loop (slatex::do-token line i))))))))
|
|
|
|
(define slatex::do-all-lines
|
|
(lambda ()
|
|
(let loop ((line1 slatex::*line1*) (line2 slatex::*line2*))
|
|
(let* ((line2-paragraph? slatex::*latex-paragraph-mode?*)
|
|
(more? (slatex::get-line line1)))
|
|
(slatex::peephole-adjust line1 line2)
|
|
((if line2-paragraph?
|
|
slatex::display-tex-line
|
|
slatex::display-scm-line)
|
|
line2)
|
|
(if (not (eq? line2-paragraph? slatex::*latex-paragraph-mode?*))
|
|
((if slatex::*latex-paragraph-mode?*
|
|
slatex::display-end-sequence
|
|
slatex::display-begin-sequence)
|
|
slatex::*out*))
|
|
(if more? (loop line2 line1))))))
|
|
|
|
(define slatex::scheme2tex
|
|
(lambda (inport outport)
|
|
(set! slatex::*in* inport)
|
|
(set! slatex::*out* outport)
|
|
(set! slatex::*latex-paragraph-mode?* #t)
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(set! slatex::*in-bktd-qtd-exp* 0)
|
|
(set! slatex::*in-mac-tkn* #f)
|
|
(set! slatex::*in-bktd-mac-exp* 0)
|
|
(set! slatex::*case-stack* '())
|
|
(set! slatex::*bq-stack* '())
|
|
(let ((flush-line
|
|
(lambda (line)
|
|
(slatex::setf (slatex::of line slatex::=rtedge) 0)
|
|
(slatex::setf (slatex::of line slatex::=char / 0) #\newline)
|
|
(slatex::setf (slatex::of line slatex::=space / 0) &void-space)
|
|
(slatex::setf (slatex::of line slatex::=tab / 0) &void-tab)
|
|
(slatex::setf
|
|
(slatex::of line slatex::=notab / 0)
|
|
&void-notab))))
|
|
(flush-line slatex::*line1*)
|
|
(flush-line slatex::*line2*))
|
|
(slatex::do-all-lines)))
|
|
|
|
(define slatex::do-token
|
|
(let ((token-delims
|
|
(list
|
|
#\(
|
|
#\)
|
|
#\[
|
|
#\]
|
|
#\space
|
|
slatex::*return*
|
|
#\"
|
|
#\'
|
|
#\`
|
|
#\newline
|
|
#\,
|
|
#\;)))
|
|
(lambda (line i)
|
|
(let loop ((buf '()) (i i))
|
|
(let ((c (slatex::of line slatex::=char / i)))
|
|
(cond
|
|
((char=? c #\\)
|
|
(loop
|
|
(cons (slatex::of line slatex::=char / (+ i 1)) (cons c buf))
|
|
(+ i 2)))
|
|
((or (memv c token-delims) (memv c slatex::*math-triggerers*))
|
|
(slatex::output-token (list->string (reverse buf)))
|
|
i)
|
|
((char? c)
|
|
(loop (cons (slatex::of line slatex::=char / i) buf) (+ i 1)))
|
|
(else
|
|
(slatex::slatex-error
|
|
'slatex::do-token
|
|
"token contains non-char?"
|
|
c))))))))
|
|
|
|
(define slatex::output-token
|
|
(lambda (token)
|
|
(if (not (null? slatex::*case-stack*))
|
|
(let ((top (car slatex::*case-stack*)))
|
|
(if (slatex::of top slatex::=in-ctag-tkn)
|
|
(begin
|
|
(slatex::setf (slatex::of top slatex::=in-ctag-tkn) #f)
|
|
(slatex::setf (slatex::of top slatex::=in-case-exp) 1)))))
|
|
(if (slatex::lassoc token slatex::special-symbols slatex::token=?)
|
|
(begin
|
|
(if slatex::*in-qtd-tkn*
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(if slatex::*in-mac-tkn* (set! slatex::*in-mac-tkn* #f)))
|
|
(display
|
|
(cdr (slatex::lassoc token slatex::special-symbols slatex::token=?))
|
|
slatex::*out*))
|
|
(slatex::display-token
|
|
token
|
|
(cond
|
|
(slatex::*in-qtd-tkn*
|
|
(set! slatex::*in-qtd-tkn* #f)
|
|
(cond
|
|
((equal? token "else") 'syntax)
|
|
((slatex::lmember token slatex::data-tokens slatex::token=?) 'data)
|
|
((slatex::lmember token slatex::constant-tokens slatex::token=?)
|
|
'constant)
|
|
((slatex::lmember token slatex::variable-tokens slatex::token=?)
|
|
'constant)
|
|
((slatex::lmember token slatex::keyword-tokens slatex::token=?)
|
|
'constant)
|
|
((slatex::prim-data-token? token) 'data)
|
|
(else 'constant)))
|
|
((> slatex::*in-bktd-qtd-exp* 0) 'constant)
|
|
((and (not (null? slatex::*bq-stack*))
|
|
(not (slatex::of (car slatex::*bq-stack*) slatex::=in-comma)))
|
|
'constant)
|
|
(slatex::*in-mac-tkn*
|
|
(set! slatex::*in-mac-tkn* #f)
|
|
(slatex::set-keyword token)
|
|
'syntax)
|
|
((> slatex::*in-bktd-mac-exp* 0) (slatex::set-keyword token) 'syntax)
|
|
((slatex::lmember token slatex::data-tokens slatex::token=?) 'data)
|
|
((slatex::lmember token slatex::constant-tokens slatex::token=?)
|
|
'constant)
|
|
((slatex::lmember token slatex::variable-tokens slatex::token=?)
|
|
'variable)
|
|
((slatex::lmember token slatex::keyword-tokens slatex::token=?)
|
|
(cond
|
|
((slatex::token=? token "quote") (set! slatex::*in-qtd-tkn* #t))
|
|
((slatex::lmember token slatex::macro-definers slatex::token=?)
|
|
(set! slatex::*in-mac-tkn* #t))
|
|
((slatex::lmember token slatex::case-and-ilk slatex::token=?)
|
|
(set! slatex::*case-stack*
|
|
(cons
|
|
(let ((f (slatex::make-case-frame)))
|
|
(slatex::setf (slatex::of f slatex::=in-ctag-tkn) #t)
|
|
(slatex::setf (slatex::of f slatex::=in-bktd-ctag-exp) 0)
|
|
(slatex::setf (slatex::of f slatex::=in-case-exp) 0)
|
|
f)
|
|
slatex::*case-stack*))))
|
|
'syntax)
|
|
((slatex::prim-data-token? token) 'data)
|
|
(else 'variable))
|
|
slatex::*out*))
|
|
(if (and (not (null? slatex::*bq-stack*))
|
|
(slatex::of (car slatex::*bq-stack*) slatex::=in-bq-tkn))
|
|
(set! slatex::*bq-stack* (cdr slatex::*bq-stack*)))))
|
|
|
|
(define slatex::directory-namestring
|
|
(lambda (f)
|
|
(let ((p (slatex::string-position-right slatex::*directory-mark* f)))
|
|
(if p (substring f 0 (+ p 1)) ""))))
|
|
|
|
(define slatex::basename
|
|
(lambda (f)
|
|
(let ((p (slatex::string-position-right slatex::*directory-mark* f)))
|
|
(if p (set! f (substring f (+ p 1) (string-length f))))
|
|
(let ((p (slatex::string-position-right #\. f)))
|
|
(if p (substring f 0 p) f)))))
|
|
|
|
(define slatex::*texinputs* "")
|
|
|
|
(define slatex::*texinputs-list* #f)
|
|
|
|
(define slatex::*path-separator*
|
|
(cond
|
|
((eq? slatex::*operating-system* 'unix) #\:)
|
|
((eq? slatex::*operating-system* 'mac-os) (integer->char 0))
|
|
((memq slatex::*operating-system* '(windows os2 dos os2fat)) #\;)
|
|
(else
|
|
(slatex::slatex-error "Couldn't determine path separator character."))))
|
|
|
|
(define slatex::*directory-mark*
|
|
(cond
|
|
((eq? slatex::*operating-system* 'unix) #\/)
|
|
((eq? slatex::*operating-system* 'mac-os) #\:)
|
|
((memq slatex::*operating-system* '(windows os2 dos os2fat)) #\\)
|
|
(else (slatex::slatex-error "Couldn't determine directory mark."))))
|
|
|
|
(define slatex::*directory-mark-string*
|
|
(list->string (list slatex::*directory-mark*)))
|
|
|
|
(define slatex::*file-hider*
|
|
(cond
|
|
((memq slatex::*operating-system* '(windows os2 unix mac-os)) ".")
|
|
((memq slatex::*operating-system* '(dos os2fat)) "x")
|
|
(else ".")))
|
|
|
|
(define slatex::path-to-list
|
|
(lambda (p)
|
|
(let loop ((p (string->list p)) (r (list "")))
|
|
(let ((separator-pos (slatex::position-char slatex::*path-separator* p)))
|
|
(if separator-pos
|
|
(loop
|
|
(list-tail p (+ separator-pos 1))
|
|
(cons (list->string (slatex::sublist p 0 separator-pos)) r))
|
|
(reverse (cons (list->string p) r)))))))
|
|
|
|
(define slatex::find-some-file
|
|
(lambda (path . files)
|
|
(let loop ((path path))
|
|
(if (null? path)
|
|
#f
|
|
(let ((dir (car path)))
|
|
(let loop1 ((files
|
|
(if (or (string=? dir "") (string=? dir "."))
|
|
files
|
|
(map
|
|
(lambda (file)
|
|
(string-append
|
|
dir
|
|
slatex::*directory-mark-string*
|
|
file))
|
|
files))))
|
|
(if (null? files)
|
|
(loop (cdr path))
|
|
(let ((file (car files)))
|
|
(if (file-exists? file) file (loop1 (cdr files)))))))))))
|
|
|
|
(define slatex::file-extension
|
|
(lambda (filename)
|
|
(let ((i (slatex::string-position-right #\. filename)))
|
|
(if i (substring filename i (string-length filename)) #f))))
|
|
|
|
(define slatex::full-texfile-name
|
|
(lambda (filename)
|
|
(let ((extn (slatex::file-extension filename)))
|
|
(if (and extn (or (string=? extn ".sty") (string=? extn ".tex")))
|
|
(slatex::find-some-file slatex::*texinputs-list* filename)
|
|
(slatex::find-some-file
|
|
slatex::*texinputs-list*
|
|
(string-append filename ".tex")
|
|
filename)))))
|
|
|
|
(define slatex::full-styfile-name
|
|
(lambda (filename)
|
|
(slatex::find-some-file
|
|
slatex::*texinputs-list*
|
|
(string-append filename ".sty"))))
|
|
|
|
(define slatex::full-clsfile-name
|
|
(lambda (filename)
|
|
(slatex::find-some-file
|
|
slatex::*texinputs-list*
|
|
(string-append filename ".cls"))))
|
|
|
|
(define slatex::full-scmfile-name
|
|
(lambda (filename)
|
|
(apply
|
|
slatex::find-some-file
|
|
slatex::*texinputs-list*
|
|
filename
|
|
(map
|
|
(lambda (extn) (string-append filename extn))
|
|
'(".scm" ".ss" ".s")))))
|
|
|
|
(define slatex::subjobname 'fwd)
|
|
|
|
(define slatex::primary-aux-file-count -1)
|
|
|
|
(define slatex::new-primary-aux-file
|
|
(lambda (e)
|
|
(set! slatex::primary-aux-file-count (+ slatex::primary-aux-file-count 1))
|
|
(string-append
|
|
slatex::*tex-calling-directory*
|
|
slatex::*file-hider*
|
|
"Z"
|
|
(number->string slatex::primary-aux-file-count)
|
|
slatex::subjobname
|
|
e)))
|
|
|
|
(define slatex::new-secondary-aux-file
|
|
(let ((n -1))
|
|
(lambda (e)
|
|
(set! n (+ n 1))
|
|
(string-append
|
|
slatex::*tex-calling-directory*
|
|
slatex::*file-hider*
|
|
"ZZ"
|
|
(number->string n)
|
|
slatex::subjobname
|
|
e))))
|
|
|
|
(define slatex::new-aux-file
|
|
(lambda e
|
|
(let ((e (if (pair? e) (car e) "")))
|
|
((if slatex::*slatex-in-protected-region?*
|
|
slatex::new-secondary-aux-file
|
|
slatex::new-primary-aux-file)
|
|
e))))
|
|
|
|
(define slatex::eat-till-newline
|
|
(lambda (in)
|
|
(let loop ()
|
|
(let ((c (read-char in)))
|
|
(cond
|
|
((eof-object? c) 'done)
|
|
((char=? c #\newline) 'done)
|
|
(else (loop)))))))
|
|
|
|
(define slatex::read-ctrl-seq
|
|
(lambda (in)
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error "read-ctrl-exp: \\ followed by eof."))
|
|
(if (char-alphabetic? c)
|
|
(list->string
|
|
(reverse
|
|
(let loop ((s (list c)))
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c) s)
|
|
((char-alphabetic? c) (read-char in) (loop (cons c s)))
|
|
((char=? c #\%) (slatex::eat-till-newline in) (loop s))
|
|
(else s))))))
|
|
(string c)))))
|
|
|
|
(define slatex::eat-tabspace
|
|
(lambda (in)
|
|
(let loop ()
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c) 'done)
|
|
((or (char=? c #\space) (char=? c slatex::*tab*))
|
|
(read-char in)
|
|
(loop))
|
|
(else 'done))))))
|
|
|
|
(define slatex::eat-whitespace
|
|
(lambda (in)
|
|
(let loop ()
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c) 'done)
|
|
((char-whitespace? c) (read-char in) (loop))
|
|
(else 'done))))))
|
|
|
|
(define slatex::eat-tex-whitespace
|
|
(lambda (in)
|
|
(let loop ()
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c) 'done)
|
|
((char-whitespace? c) (read-char in) (loop))
|
|
((char=? c #\%) (slatex::eat-till-newline in))
|
|
(else 'done))))))
|
|
|
|
(define slatex::chop-off-whitespace
|
|
(lambda (l)
|
|
(slatex::ormapcdr (lambda (d) (if (char-whitespace? (car d)) #f d)) l)))
|
|
|
|
(define slatex::read-grouped-latexexp
|
|
(lambda (in)
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-grouped-latexexp: ~\nExpected { but found eof."))
|
|
(if (not (char=? c #\{))
|
|
(slatex::slatex-error
|
|
"read-grouped-latexexp: ~\nExpected { but found ~a."
|
|
c))
|
|
(slatex::eat-tex-whitespace in)
|
|
(list->string
|
|
(reverse
|
|
(slatex::chop-off-whitespace
|
|
(let loop ((s '()) (nesting 0) (escape? #f))
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-groupted-latexexp: ~\nFound eof inside {...}."))
|
|
(cond
|
|
(escape? (loop (cons c s) nesting #f))
|
|
((char=? c #\\) (loop (cons c s) nesting #t))
|
|
((char=? c #\%)
|
|
(slatex::eat-till-newline in)
|
|
(loop s nesting #f))
|
|
((char=? c #\{) (loop (cons c s) (+ nesting 1) #f))
|
|
((char=? c #\})
|
|
(if (= nesting 0) s (loop (cons c s) (- nesting 1) #f)))
|
|
(else (loop (cons c s) nesting #f)))))))))))
|
|
|
|
(define slatex::read-filename
|
|
(let ((filename-delims
|
|
(list
|
|
#\{
|
|
#\}
|
|
#\[
|
|
#\]
|
|
#\(
|
|
#\)
|
|
#\#
|
|
#\%
|
|
#\\
|
|
#\,
|
|
#\space
|
|
slatex::*return*
|
|
#\newline
|
|
slatex::*tab*
|
|
#\\)))
|
|
(lambda (in)
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (peek-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-filename: ~\nExpected filename but found eof."))
|
|
(if (char=? c #\{)
|
|
(slatex::read-grouped-latexexp in)
|
|
(list->string
|
|
(reverse
|
|
(let loop ((s '()) (escape? #f))
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c)
|
|
(if escape?
|
|
(slatex::slatex-error
|
|
"read-filename: ~\n\\ followed by eof.")
|
|
s))
|
|
(escape? (read-char in) (loop (cons c s) #f))
|
|
((char=? c #\\) (read-char in) (loop (cons c s) #t))
|
|
((memv c filename-delims) s)
|
|
(else (read-char in) (loop (cons c s) #f))))))))))))
|
|
|
|
(define slatex::read-schemeid
|
|
(let ((schemeid-delims
|
|
(list
|
|
#\{
|
|
#\}
|
|
#\[
|
|
#\]
|
|
#\(
|
|
#\)
|
|
#\space
|
|
slatex::*return*
|
|
#\newline
|
|
slatex::*tab*)))
|
|
(lambda (in)
|
|
(slatex::eat-whitespace in)
|
|
(list->string
|
|
(reverse
|
|
(let loop ((s '()) (escape? #f))
|
|
(let ((c (peek-char in)))
|
|
(cond
|
|
((eof-object? c) s)
|
|
(escape? (read-char in) (loop (cons c s) #f))
|
|
((char=? c #\\) (read-char in) (loop (cons c s) #t))
|
|
((memv c schemeid-delims) s)
|
|
(else (read-char in) (loop (cons c s) #f))))))))))
|
|
|
|
(define slatex::read-delimed-commaed-filenames
|
|
(lambda (in lft-delim rt-delim)
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-delimed-commaed-filenames: ~\nExpected filename(s) but found eof."))
|
|
(if (not (char=? c lft-delim))
|
|
(slatex::slatex-error
|
|
"read-delimed-commaed-filenames: ~\nLeft delimiter ~a not found."
|
|
lft-delim))
|
|
(let loop ((s '()))
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (peek-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-delimed-commaed-filenames: ~\nFound eof inside filename(s)."))
|
|
(if (char=? c rt-delim)
|
|
(begin (read-char in) (reverse s))
|
|
(let ((s (cons (slatex::read-filename in) s)))
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (peek-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-delimed-commaed-filenames: ~\nFound eof inside filename(s)."))
|
|
(cond
|
|
((char=? c #\,) (read-char in))
|
|
((char=? c rt-delim) (void))
|
|
(else
|
|
(slatex::slatex-error
|
|
"read-delimed-commaed-filenames: ~\nBad filename(s) syntax.")))
|
|
(loop s)))))))))
|
|
|
|
(define slatex::read-grouped-commaed-filenames
|
|
(lambda (in) (slatex::read-delimed-commaed-filenames in #\{ #\})))
|
|
|
|
(define slatex::read-bktd-commaed-filenames
|
|
(lambda (in) (slatex::read-delimed-commaed-filenames in #\[ #\])))
|
|
|
|
(define slatex::read-grouped-schemeids
|
|
(lambda (in)
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-grouped-schemeids: ~\nExpected Scheme identifiers but found eof."))
|
|
(if (not (char=? c #\{))
|
|
(slatex::slatex-error
|
|
"read-grouped-schemeids: ~\nExpected { but found ~a."
|
|
c))
|
|
(let loop ((s '()))
|
|
(slatex::eat-whitespace in)
|
|
(let ((c (peek-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"read-grouped-schemeids:\nFound eof inside Scheme identifiers."))
|
|
(if (char=? c #\})
|
|
(begin (read-char in) (reverse s))
|
|
(loop (cons (slatex::read-schemeid in) s))))))))
|
|
|
|
(define slatex::eat-delimed-text
|
|
(lambda (in lft-delim rt-delim)
|
|
(slatex::eat-tex-whitespace in)
|
|
(let ((c (peek-char in)))
|
|
(if (eof-object? c)
|
|
'exit
|
|
(if (char=? c lft-delim)
|
|
(let loop ()
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
'exit
|
|
(if (char=? c rt-delim) 'exit (loop))))))))))
|
|
|
|
(define slatex::eat-bktd-text
|
|
(lambda (in) (slatex::eat-delimed-text in #\[ #\])))
|
|
|
|
(define slatex::eat-grouped-text
|
|
(lambda (in) (slatex::eat-delimed-text in #\{ #\})))
|
|
|
|
(define slatex::ignore2 (lambda (i ii) 'void))
|
|
|
|
(define slatex::disable-slatex-temply
|
|
(lambda (in)
|
|
(set! slatex::*slatex-enabled?* #f)
|
|
(set! slatex::*slatex-reenabler* (slatex::read-grouped-latexexp in))))
|
|
|
|
(define slatex::enable-slatex-again
|
|
(lambda ()
|
|
(set! slatex::*slatex-enabled?* #t)
|
|
(set! slatex::*slatex-reenabler* "UNDEFINED")))
|
|
|
|
(define slatex::add-to-slatex-db
|
|
(lambda (in categ)
|
|
(if (memq categ '(keyword constant variable))
|
|
(slatex::add-to-slatex-db-basic in categ)
|
|
(slatex::add-to-slatex-db-special in categ))))
|
|
|
|
(define slatex::add-to-slatex-db-basic
|
|
(lambda (in categ)
|
|
(let ((setter
|
|
(cond
|
|
((eq? categ 'keyword) slatex::set-keyword)
|
|
((eq? categ 'constant) slatex::set-constant)
|
|
((eq? categ 'variable) slatex::set-variable)
|
|
(else
|
|
(slatex::slatex-error
|
|
"add-to-slatex-db-basic: ~\nUnknown category ~s."
|
|
categ))))
|
|
(ids (slatex::read-grouped-schemeids in)))
|
|
(for-each setter ids))))
|
|
|
|
(define slatex::add-to-slatex-db-special
|
|
(lambda (in what)
|
|
(let ((ids (slatex::read-grouped-schemeids in)))
|
|
(cond
|
|
((eq? what 'unsetspecialsymbol)
|
|
(for-each slatex::unset-special-symbol ids))
|
|
((eq? what 'setspecialsymbol)
|
|
(if (not (= (length ids) 1))
|
|
(slatex::slatex-error
|
|
"add-to-slatex-db-special: ~\n\\setspecialsymbol takes one arg exactly."))
|
|
(let ((transl (slatex::read-grouped-latexexp in)))
|
|
(slatex::set-special-symbol (car ids) transl)))
|
|
(else
|
|
(slatex::slatex-error
|
|
"add-to-slatex-db-special: ~\nUnknown command ~s."
|
|
what))))))
|
|
|
|
(define slatex::process-slatex-alias
|
|
(lambda (in what which)
|
|
(let ((triggerer (slatex::read-grouped-latexexp in)))
|
|
(case which
|
|
((intext)
|
|
(set! slatex::*intext-triggerers*
|
|
(what triggerer slatex::*intext-triggerers* string=?)))
|
|
((resultintext)
|
|
(set! slatex::*resultintext-triggerers*
|
|
(what triggerer slatex::*resultintext-triggerers* string=?)))
|
|
((display)
|
|
(set! slatex::*display-triggerers*
|
|
(what triggerer slatex::*display-triggerers* string=?)))
|
|
((response)
|
|
(set! slatex::*response-triggerers*
|
|
(what triggerer slatex::*response-triggerers* string=?)))
|
|
((respbox)
|
|
(set! slatex::*respbox-triggerers*
|
|
(what triggerer slatex::*respbox-triggerers* string=?)))
|
|
((box)
|
|
(set! slatex::*box-triggerers*
|
|
(what triggerer slatex::*box-triggerers* string=?)))
|
|
((input)
|
|
(set! slatex::*input-triggerers*
|
|
(what triggerer slatex::*input-triggerers* string=?)))
|
|
((region)
|
|
(set! slatex::*region-triggerers*
|
|
(what triggerer slatex::*region-triggerers* string=?)))
|
|
((mathescape)
|
|
(if (not (= (string-length triggerer) 1))
|
|
(slatex::slatex-error
|
|
"process-slatex-alias: ~\nMath escape should be character."))
|
|
(set! slatex::*math-triggerers*
|
|
(what (string-ref triggerer 0) slatex::*math-triggerers* char=?)))
|
|
(else
|
|
(slatex::slatex-error
|
|
"process-slatex-alias:\nUnknown command ~s."
|
|
which))))))
|
|
|
|
(define slatex::decide-latex-or-tex
|
|
(lambda (latex?)
|
|
(set! slatex::*latex?* latex?)
|
|
(let ((pltexchk.jnk "pltexchk.jnk"))
|
|
(if (file-exists? pltexchk.jnk) (delete-file pltexchk.jnk))
|
|
(if (not slatex::*latex?*)
|
|
(call-with-output-file
|
|
pltexchk.jnk
|
|
(lambda (outp) (display 'junk outp) (newline outp)))))))
|
|
|
|
(define slatex::process-include-only
|
|
(lambda (in)
|
|
(set! slatex::*include-onlys* '())
|
|
(for-each
|
|
(lambda (filename)
|
|
(let ((filename (slatex::full-texfile-name filename)))
|
|
(if filename
|
|
(set! slatex::*include-onlys*
|
|
(slatex::adjoin filename slatex::*include-onlys* string=?)))))
|
|
(slatex::read-grouped-commaed-filenames in))))
|
|
|
|
(define slatex::process-documentstyle
|
|
(lambda (in)
|
|
(slatex::eat-tex-whitespace in)
|
|
(if (char=? (peek-char in) #\[)
|
|
(for-each
|
|
(lambda (filename)
|
|
(fluid-let
|
|
((slatex::*slatex-in-protected-region?* #f))
|
|
(slatex::process-tex-file (string-append filename ".sty"))))
|
|
(slatex::read-bktd-commaed-filenames in)))))
|
|
|
|
(define slatex::process-documentclass
|
|
(lambda (in) (slatex::eat-bktd-text in) (slatex::eat-grouped-text in)))
|
|
|
|
(define slatex::process-case-info
|
|
(lambda (in)
|
|
(let ((bool (slatex::read-grouped-latexexp in)))
|
|
(set! slatex::*slatex-case-sensitive?*
|
|
(cond
|
|
((string-ci=? bool "true") #t)
|
|
((string-ci=? bool "false") #f)
|
|
(else
|
|
(slatex::slatex-error
|
|
"process-case-info: ~\n\\schemecasesensitive's arg should be true or false.")))))))
|
|
|
|
(define slatex::seen-first-command? #f)
|
|
|
|
(define slatex::process-main-tex-file
|
|
(lambda (filename)
|
|
(display "SLaTeX v. ")
|
|
(display slatex::*slatex-version*)
|
|
(newline)
|
|
(set! slatex::primary-aux-file-count -1)
|
|
(set! slatex::*slatex-separate-includes?* #f)
|
|
(if (or (not slatex::*texinputs-list*) (null? slatex::*texinputs-list*))
|
|
(set! slatex::*texinputs-list*
|
|
(if slatex::*texinputs*
|
|
(slatex::path-to-list slatex::*texinputs*)
|
|
'(""))))
|
|
(let ((file-hide-file "xZfilhid.tex"))
|
|
(if (file-exists? file-hide-file) (delete-file file-hide-file))
|
|
(if (memq slatex::*operating-system* '(dos os2fat))
|
|
(call-with-output-file
|
|
file-hide-file
|
|
(lambda (out) (display "\\def\\filehider{x}" out) (newline out)))))
|
|
(display "typesetting code")
|
|
(set! slatex::*tex-calling-directory*
|
|
(slatex::directory-namestring filename))
|
|
(set! slatex::subjobname (slatex::basename filename))
|
|
(set! slatex::seen-first-command? #f)
|
|
(slatex::process-tex-file filename)
|
|
(display "done")
|
|
(newline)))
|
|
|
|
(define slatex::dump-intext
|
|
(lambda (in out)
|
|
(let* ((write-char (if out write-char slatex::ignore2))
|
|
(delim-char (begin (slatex::eat-whitespace in) (read-char in)))
|
|
(delim-char (cond ((char=? delim-char #\{) #\}) (else delim-char))))
|
|
(if (eof-object? delim-char)
|
|
(slatex::slatex-error
|
|
"dump-intext: Expected delimiting character ~\nbut found eof."))
|
|
(let loop ()
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"dump-intext: Found eof inside Scheme code."))
|
|
(if (char=? c delim-char)
|
|
'done
|
|
(begin (write-char c out) (loop))))))))
|
|
|
|
(define slatex::dump-display
|
|
(lambda (in out ender)
|
|
(slatex::eat-tabspace in)
|
|
(let ((write-char (if out write-char slatex::ignore2))
|
|
(ender-lh (string-length ender))
|
|
(c (peek-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"dump-display: Found eof inside displayed code."))
|
|
(if (char=? c #\newline) (read-char in))
|
|
(let loop ((i 0))
|
|
(if (= i ender-lh)
|
|
'done
|
|
(let ((c (read-char in)))
|
|
(if (eof-object? c)
|
|
(slatex::slatex-error
|
|
"dump-display: Found eof inside displayed code."))
|
|
(if (char=? c (string-ref ender i))
|
|
(loop (+ i 1))
|
|
(let loop2 ((j 0))
|
|
(if (< j i)
|
|
(begin (write-char (string-ref ender j) out) (loop2 (+ j 1)))
|
|
(begin (write-char c out) (loop 0)))))))))))
|
|
|
|
(define slatex::debug? #f)
|
|
|
|
(define slatex::process-tex-file
|
|
(lambda (raw-filename)
|
|
(if slatex::debug?
|
|
(begin (display "begin ") (display raw-filename) (newline)))
|
|
(let ((filename (slatex::full-texfile-name raw-filename)))
|
|
(if (not filename)
|
|
(begin
|
|
(display "[")
|
|
(display raw-filename)
|
|
(display "]")
|
|
(flush-output))
|
|
(call-with-input-file
|
|
filename
|
|
(lambda (in)
|
|
(let ((done? #f))
|
|
(let loop ()
|
|
(if done?
|
|
'exit-loop
|
|
(begin
|
|
(let ((c (read-char in)))
|
|
(cond
|
|
((eof-object? c) (set! done? #t))
|
|
((char=? c #\%) (slatex::eat-till-newline in))
|
|
((char=? c #\\)
|
|
(let ((cs (slatex::read-ctrl-seq in)))
|
|
(if (not slatex::seen-first-command?)
|
|
(begin
|
|
(set! slatex::seen-first-command? #t)
|
|
(slatex::decide-latex-or-tex
|
|
(or (string=? cs "documentstyle")
|
|
(string=? cs "documentclass")
|
|
(string=? cs "RequirePackage")
|
|
(string=? cs "NeedsTeXFormat")))))
|
|
(cond
|
|
((not slatex::*slatex-enabled?*)
|
|
(if (string=? cs slatex::*slatex-reenabler*)
|
|
(slatex::enable-slatex-again)))
|
|
((string=? cs "slatexignorecurrentfile")
|
|
(set! done? #t))
|
|
((string=? cs "slatexseparateincludes")
|
|
(if slatex::*latex?*
|
|
(set! slatex::*slatex-separate-includes?* #t)))
|
|
((string=? cs "slatexdisable")
|
|
(slatex::disable-slatex-temply in))
|
|
((string=? cs "begin")
|
|
(slatex::eat-tex-whitespace in)
|
|
(if (eqv? (peek-char in) #\{)
|
|
(let ((cs (slatex::read-grouped-latexexp in)))
|
|
(cond
|
|
((member cs slatex::*display-triggerers*)
|
|
(slatex::trigger-scheme2tex
|
|
'envdisplay
|
|
in
|
|
cs))
|
|
((member cs slatex::*response-triggerers*)
|
|
(slatex::trigger-scheme2tex
|
|
'envresponse
|
|
in
|
|
cs))
|
|
((member cs slatex::*respbox-triggerers*)
|
|
(slatex::trigger-scheme2tex
|
|
'envrespbox
|
|
in
|
|
cs))
|
|
((member cs slatex::*box-triggerers*)
|
|
(slatex::trigger-scheme2tex 'envbox in cs))
|
|
((member cs slatex::*topbox-triggerers*)
|
|
(slatex::trigger-scheme2tex
|
|
'envtopbox
|
|
in
|
|
cs))
|
|
((member cs slatex::*region-triggerers*)
|
|
(slatex::trigger-region
|
|
'envregion
|
|
in
|
|
cs))))))
|
|
((member cs slatex::*intext-triggerers*)
|
|
(slatex::trigger-scheme2tex 'intext in #f))
|
|
((member cs slatex::*resultintext-triggerers*)
|
|
(slatex::trigger-scheme2tex 'resultintext in #f))
|
|
((member cs slatex::*display-triggerers*)
|
|
(slatex::trigger-scheme2tex 'plaindisplay in cs))
|
|
((member cs slatex::*response-triggerers*)
|
|
(slatex::trigger-scheme2tex 'plainresponse in cs))
|
|
((member cs slatex::*respbox-triggerers*)
|
|
(slatex::trigger-scheme2tex 'plainrespbox in cs))
|
|
((member cs slatex::*box-triggerers*)
|
|
(slatex::trigger-scheme2tex 'plainbox in cs))
|
|
((member cs slatex::*topbox-triggerers*)
|
|
(slatex::trigger-scheme2tex 'plaintopbox in cs))
|
|
((member cs slatex::*region-triggerers*)
|
|
(slatex::trigger-region 'plainregion in cs))
|
|
((member cs slatex::*input-triggerers*)
|
|
(slatex::process-scheme-file
|
|
(slatex::read-filename in)))
|
|
((string=? cs "input")
|
|
(let ((f (slatex::read-filename in)))
|
|
(if (not (string=? f ""))
|
|
(fluid-let
|
|
((slatex::*slatex-in-protected-region?* #f))
|
|
(slatex::process-tex-file f)))))
|
|
((string=? cs "usepackage")
|
|
(fluid-let
|
|
((slatex::*slatex-in-protected-region?* #f))
|
|
(slatex::process-tex-file
|
|
(string-append
|
|
(slatex::read-filename in)
|
|
".sty"))))
|
|
((string=? cs "include")
|
|
(if slatex::*latex?*
|
|
(let ((f
|
|
(slatex::full-texfile-name
|
|
(slatex::read-filename in))))
|
|
(if (and f
|
|
(or (eq? slatex::*include-onlys* 'all)
|
|
(member
|
|
f
|
|
slatex::*include-onlys*)))
|
|
(fluid-let
|
|
((slatex::*slatex-in-protected-region?*
|
|
#f))
|
|
(if slatex::*slatex-separate-includes?*
|
|
(fluid-let
|
|
((slatex::subjobname
|
|
(slatex::basename f))
|
|
(slatex::primary-aux-file-count -1))
|
|
(slatex::process-tex-file f))
|
|
(slatex::process-tex-file f)))))))
|
|
((string=? cs "includeonly")
|
|
(if slatex::*latex?*
|
|
(slatex::process-include-only in)))
|
|
((string=? cs "documentstyle")
|
|
(if slatex::*latex?*
|
|
(slatex::process-documentstyle in)))
|
|
((string=? cs "documentclass")
|
|
(if slatex::*latex?*
|
|
(slatex::process-documentclass in)))
|
|
((string=? cs "schemecasesensitive")
|
|
(slatex::process-case-info in))
|
|
((string=? cs "defschemetoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'intext))
|
|
((string=? cs "undefschemetoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'intext))
|
|
((string=? cs "defschemeresulttoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'resultintext))
|
|
((string=? cs "undefschemeresulttoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'resultintext))
|
|
((string=? cs "defschemeresponsetoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'response))
|
|
((string=? cs "undefschemeresponsetoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'response))
|
|
((string=? cs "defschemeresponseboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'respbox))
|
|
((string=? cs "undefschemeresponseboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'respbox))
|
|
((string=? cs "defschemedisplaytoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'display))
|
|
((string=? cs "undefschemedisplaytoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'display))
|
|
((string=? cs "defschemeboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'box))
|
|
((string=? cs "undefschemeboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'box))
|
|
((string=? cs "defschemetopboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'topbox))
|
|
((string=? cs "undefschemetopboxtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'topbox))
|
|
((string=? cs "defschemeinputtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'input))
|
|
((string=? cs "undefschemeinputtoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'input))
|
|
((string=? cs "defschemeregiontoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'region))
|
|
((string=? cs "undefschemeregiontoken")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'region))
|
|
((string=? cs "defschememathescape")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::adjoin
|
|
'mathescape))
|
|
((string=? cs "undefschememathescape")
|
|
(slatex::process-slatex-alias
|
|
in
|
|
slatex::delete
|
|
'mathescape))
|
|
((string=? cs "setkeyword")
|
|
(slatex::add-to-slatex-db in 'keyword))
|
|
((string=? cs "setconstant")
|
|
(slatex::add-to-slatex-db in 'constant))
|
|
((string=? cs "setvariable")
|
|
(slatex::add-to-slatex-db in 'variable))
|
|
((string=? cs "setspecialsymbol")
|
|
(slatex::add-to-slatex-db in 'setspecialsymbol))
|
|
((string=? cs "unsetspecialsymbol")
|
|
(slatex::add-to-slatex-db
|
|
in
|
|
'unsetspecialsymbol)))))))
|
|
(loop)))))))))
|
|
(if slatex::debug?
|
|
(begin (display "end ") (display raw-filename) (newline)))))
|
|
|
|
(define slatex::process-scheme-file
|
|
(lambda (raw-filename)
|
|
(let ((filename (slatex::full-scmfile-name raw-filename)))
|
|
(if (not filename)
|
|
(begin
|
|
(display "process-scheme-file: ")
|
|
(display raw-filename)
|
|
(display " doesn't exist")
|
|
(newline))
|
|
(let ((aux.tex (slatex::new-aux-file ".tex")))
|
|
(display ".")
|
|
(flush-output)
|
|
(if (file-exists? aux.tex) (delete-file aux.tex))
|
|
(call-with-input-file
|
|
filename
|
|
(lambda (in)
|
|
(call-with-output-file
|
|
aux.tex
|
|
(lambda (out)
|
|
(fluid-let
|
|
((slatex::*intext?* #f)
|
|
(slatex::*code-env-spec* "ZZZZschemedisplay"))
|
|
(slatex::scheme2tex in out))))))
|
|
(if slatex::*slatex-in-protected-region?*
|
|
(set! slatex::*protected-files*
|
|
(cons aux.tex slatex::*protected-files*)))
|
|
(slatex::process-tex-file filename))))))
|
|
|
|
(define slatex::trigger-scheme2tex
|
|
(lambda (typ in env)
|
|
(let* ((aux (slatex::new-aux-file))
|
|
(aux.scm (string-append aux ".scm"))
|
|
(aux.tex (string-append aux ".tex")))
|
|
(if (file-exists? aux.scm) (delete-file aux.scm))
|
|
(if (file-exists? aux.tex) (delete-file aux.tex))
|
|
(display ".")
|
|
(flush-output)
|
|
(call-with-output-file
|
|
aux.scm
|
|
(lambda (out)
|
|
(cond
|
|
((memq typ '(intext resultintext)) (slatex::dump-intext in out))
|
|
((memq typ '(envdisplay envresponse envrespbox envbox envtopbox))
|
|
(slatex::dump-display in out (string-append "\\end{" env "}")))
|
|
((memq
|
|
typ
|
|
'(plaindisplay plainresponse plainrespbox plainbox plaintopbox))
|
|
(slatex::dump-display in out (string-append "\\end" env)))
|
|
(else
|
|
(slatex::slatex-error
|
|
"trigger-scheme2tex: ~\n Unknown triggerer ~s."
|
|
typ)))))
|
|
(call-with-input-file
|
|
aux.scm
|
|
(lambda (in)
|
|
(call-with-output-file
|
|
aux.tex
|
|
(lambda (out)
|
|
(fluid-let
|
|
((slatex::*intext?* (memq typ '(intext resultintext)))
|
|
(slatex::*code-env-spec*
|
|
(cond
|
|
((eq? typ 'intext) "ZZZZschemecodeintext")
|
|
((eq? typ 'resultintext) "ZZZZschemeresultintext")
|
|
((memq typ '(envdisplay plaindisplay)) "ZZZZschemedisplay")
|
|
((memq typ '(envresponse plainresponse))
|
|
"ZZZZschemeresponse")
|
|
((memq typ '(envrespbox plainrespbox))
|
|
"ZZZZschemeresponsebox")
|
|
((memq typ '(envbox plainbox)) "ZZZZschemebox")
|
|
((memq typ '(envtopbox plaintopbox)) "ZZZZschemetopbox")
|
|
(else
|
|
(slatex::slatex-error
|
|
"trigger-scheme2tex: ~\n Unknown triggerer ~s."
|
|
typ)))))
|
|
(slatex::scheme2tex in out))))))
|
|
(if slatex::*slatex-in-protected-region?*
|
|
(set! slatex::*protected-files*
|
|
(cons aux.tex slatex::*protected-files*)))
|
|
(if (memq
|
|
typ
|
|
'(envdisplay plaindisplay envbox plainbox envtopbox plaintopbox))
|
|
(slatex::process-tex-file aux.tex))
|
|
(delete-file aux.scm))))
|
|
|
|
(define slatex::trigger-region
|
|
(lambda (typ in env)
|
|
(let ((aux.tex (slatex::new-primary-aux-file ".tex"))
|
|
(aux2.tex (slatex::new-secondary-aux-file ".tex")))
|
|
(if (file-exists? aux2.tex) (delete-file aux2.tex))
|
|
(if (file-exists? aux.tex) (delete-file aux.tex))
|
|
(display ".")
|
|
(flush-output)
|
|
(fluid-let
|
|
((slatex::*slatex-in-protected-region?* #t)
|
|
(slatex::*protected-files* '()))
|
|
(call-with-output-file
|
|
aux2.tex
|
|
(lambda (out)
|
|
(cond
|
|
((eq? typ 'envregion)
|
|
(slatex::dump-display in out (string-append "\\end{" env "}")))
|
|
((eq? typ 'plainregion)
|
|
(slatex::dump-display in out (string-append "\\end" env)))
|
|
(else
|
|
(slatex::slatex-error
|
|
"trigger-region: ~\nUnknown triggerer ~s."
|
|
typ)))))
|
|
(slatex::process-tex-file aux2.tex)
|
|
(set! slatex::*protected-files* (reverse slatex::*protected-files*))
|
|
(call-with-input-file
|
|
aux2.tex
|
|
(lambda (in)
|
|
(call-with-output-file
|
|
aux.tex
|
|
(lambda (out) (slatex::inline-protected-files in out)))))
|
|
(delete-file aux2.tex)))))
|
|
|
|
(define slatex::inline-protected-files
|
|
(lambda (in out)
|
|
(let ((done? #f))
|
|
(let loop ()
|
|
(if done?
|
|
'exit-loop
|
|
(begin
|
|
(let ((c (read-char in)))
|
|
(cond
|
|
((eof-object? c) (set! done? #t))
|
|
((or (char=? c slatex::*return*) (char=? c #\newline))
|
|
(let ((c2 (peek-char in)))
|
|
(if (not (eof-object? c2)) (write-char c out))))
|
|
((char=? c #\%)
|
|
(write-char c out)
|
|
(newline out)
|
|
(slatex::eat-till-newline in))
|
|
((char=? c #\\)
|
|
(let ((cs (slatex::read-ctrl-seq in)))
|
|
(cond
|
|
((string=? cs "begin")
|
|
(let ((cs (slatex::read-grouped-latexexp in)))
|
|
(cond
|
|
((member cs slatex::*display-triggerers*)
|
|
(slatex::inline-protected 'envdisplay in out cs))
|
|
((member cs slatex::*response-triggerers*)
|
|
(slatex::inline-protected 'envresponse in out cs))
|
|
((member cs slatex::*respbox-triggerers*)
|
|
(slatex::inline-protected 'envrespbox in out cs))
|
|
((member cs slatex::*box-triggerers*)
|
|
(slatex::inline-protected 'envbox in out cs))
|
|
((member cs slatex::*topbox-triggerers*)
|
|
(slatex::inline-protected 'envtopbox in out cs))
|
|
((member cs slatex::*region-triggerers*)
|
|
(slatex::inline-protected 'envregion in out cs))
|
|
(else
|
|
(display "\\begin{" out)
|
|
(display cs out)
|
|
(display "}" out)))))
|
|
((member cs slatex::*intext-triggerers*)
|
|
(slatex::inline-protected 'intext in out #f))
|
|
((member cs slatex::*resultintext-triggerers*)
|
|
(slatex::inline-protected 'resultintext in out #f))
|
|
((member cs slatex::*display-triggerers*)
|
|
(slatex::inline-protected 'plaindisplay in out cs))
|
|
((member cs slatex::*response-triggerers*)
|
|
(slatex::inline-protected 'plainresponse in out cs))
|
|
((member cs slatex::*respbox-triggerers*)
|
|
(slatex::inline-protected 'plainrespbox in out cs))
|
|
((member cs slatex::*box-triggerers*)
|
|
(slatex::inline-protected 'plainbox in out cs))
|
|
((member cs slatex::*topbox-triggerers*)
|
|
(slatex::inline-protected 'plaintopbox in out cs))
|
|
((member cs slatex::*region-triggerers*)
|
|
(slatex::inline-protected 'plainregion in out cs))
|
|
((member cs slatex::*input-triggerers*)
|
|
(slatex::inline-protected 'input in out cs))
|
|
(else (display "\\" out) (display cs out)))))
|
|
(else (write-char c out))))
|
|
(loop)))))))
|
|
|
|
(define slatex::inline-protected
|
|
(lambda (typ in out env)
|
|
(cond
|
|
((eq? typ 'envregion)
|
|
(display "\\begin{" out)
|
|
(display env out)
|
|
(display "}" out)
|
|
(slatex::dump-display in out (string-append "\\end{" env "}"))
|
|
(display "\\end{" out)
|
|
(display env out)
|
|
(display "}" out))
|
|
((eq? typ 'plainregion)
|
|
(display "\\" out)
|
|
(display env out)
|
|
(slatex::dump-display in out (string-append "\\end" env))
|
|
(display "\\end" out)
|
|
(display env out))
|
|
(else
|
|
(let ((f (car slatex::*protected-files*)))
|
|
(set! slatex::*protected-files* (cdr slatex::*protected-files*))
|
|
(call-with-input-file
|
|
f
|
|
(lambda (in) (slatex::inline-protected-files in out)))
|
|
(delete-file f))
|
|
(cond
|
|
((memq typ '(intext resultintext))
|
|
(display "{}" out)
|
|
(slatex::dump-intext in #f))
|
|
((memq typ '(envrespbox envbox envtopbox))
|
|
(if (not slatex::*latex?*) (display "{}" out))
|
|
(slatex::dump-display in #f (string-append "\\end{" env "}")))
|
|
((memq typ '(plainrespbox plainbox plaintopbox))
|
|
(display "{}" out)
|
|
(slatex::dump-display in #f (string-append "\\end" env)))
|
|
((memq typ '(envdisplay envresponse))
|
|
(slatex::dump-display in #f (string-append "\\end{" env "}")))
|
|
((memq typ '(plaindisplay plainresponse))
|
|
(slatex::dump-display in #f (string-append "\\end" env)))
|
|
((eq? typ 'input) (slatex::read-filename in))
|
|
(else
|
|
(slatex::slatex-error
|
|
"inline-protected: ~\nUnknown triggerer ~s."
|
|
typ)))))))
|
|
|
|
|
|
)
|
|
|