":";exec csi -batch -no-init $0 -- $1
(define *scheme-version* "Chicken")

(declare (uses extras srfi-1 posix))

(define get-arg1 (lambda () (let ((aa (command-line-arguments)) (n (cond-expand (compiling 1) (else 5)))) (and (>= (length aa) n) (list-ref aa (sub1 n))))))

(define eof (end-of-file))

(define leap? (lambda (y) (or (and (= (modulo y 4) 0) (> (modulo y 100) 0)) (= (modulo y 400) 0))))

(define *days-in-a-mo* (vector 31 28 31 30 31 30 31 31 30 31 30 31))

(define *year0* 1970)

(define *dow0* 3)

(define decode-universal-time (lambda (s . tz) (if (pair? tz) (set! s (- s (* 3600 (car tz))))) (let* ((s-in-days (/ s 86400)) (d (inexact->exact (floor s-in-days))) (dow (modulo (+ d *dow0*) 7)) (s (- s (* d 86400))) (h (quotient s 3600)) (s (remainder s 3600)) (min (quotient s 60)) (s (remainder s 60))) (let loop ((d d) (y *year0*)) (if (< d 0) (let ((y-1 (- y 1))) (loop (+ d (if (leap? y-1) 366 365)) y-1)) (let* ((l? (leap? y)) (d2 (if l? 366 365))) (if (>= d d2) (loop (- d d2) (+ y 1)) (let loop ((d d) (mo 0)) (let ((d2 (vector-ref *days-in-a-mo* mo))) (if (and (= mo 1) l?) (set! d2 (+ d2 1))) (if (> d d2) (loop (- d d2) (+ mo 1)) (vector s min h (+ d 1) (+ mo 1) y dow)))))))))))

(define seconds->human-time (lambda (secs) (let ((ht (decode-universal-time secs))) (let ((h (vector-ref ht 2)) (m (vector-ref ht 1))) (string-append (alphabetic-week-day (vector-ref ht 6)) ", " (alphabetic-month (vector-ref ht 4)) " " (number->string (vector-ref ht 3)) ", " (number->string (vector-ref ht 5)) ", " (number->string (non-military-hour h)) ":" (if (< m 10) "0" "") (number->string m) " " (meridiem h) " " (get-time-zone))))))

; ensure shell-magic above
;Configured for Scheme dialect chicken by scmxlate, v 1a2,
;(c) Dorai Sitaram, 
;http://www.ccs.neu.edu/~dorai/scmxlate/scmxlate.html

(define *operating-system* (if (getenv "COMSPEC") (quote windows) (quote unix)))

(define *path-separator* (if (eqv? *operating-system* (quote windows)) #\; #\:))

(define *directory-separator* (if (eqv? *operating-system* (quote windows)) "\\" "/"))

(define *ghostscript* (case *operating-system* ((unix) "gs") ((windows) (ormap (lambda (f) (and (file-exists? f) f)) (quote ("c:\\aladdin\\gs6.01\\bin\\gswin32c.exe" "d:\\aladdin\\gs6.01\\bin\\gswin32c.exe")))) (else "gs")))

(define *metapost* (case *operating-system* ((unix) "mpost") ((windows) "mp") (else "mpost")))

(define *bye-tex* (case *operating-system* ((windows) " \\bye") ((unix) " \\\\bye") (else " \\\\bye")))

(define *use-closing-p-tag?* #t)

(define *tex2page-version* "4p7")

(define *tex2page-website* "http://www.ccs.neu.edu/~dorai/tex2page/tex2page-doc.html")

(define *img-format* (quote gif))

(define *img-magnification* 1)

(define *int-corresp-to-0* (char->integer #\0))

(define *aux-file-suffix* "-Z-A")

(define *bib-aux-file-suffix* "--h")

(define *css-file-suffix* "-Z-S")

(define *eval-file-suffix* "-Z-E-")

(define *html-page-suffix* "-Z-H-")

(define *img-file-suffix* "-Z-G-")

(define *imgdef-file-suffix* "D-")

(define *index-file-suffix* "--h")

(define *label-file-suffix* "-Z-L")

(define *mfpic-file-suffix* "-Z-M-")

(define *toc-file-suffix* "-Z-C")

(define *output-extn* ".html")

(define *invisible-space* (list (quote *invisible-space*)))

(define *the-days* (vector "Sun" "Mon" "Tues" "Wed" "Thurs" "Fri" "Sat"))

(define *the-months* (vector "Jan" "Feb" "March" "April" "May" "June" "July" "Aug" "Sept" "Oct" "Nov" "Dec"))

(define *use-img-for-display-math?* #t)

(define *use-img-for-in-text-math?* #t)

(define *use-img-for-math?* #t)

(define *use-ligatures?* #f)

(define *html-bull* "&curren;")

(define *html-dagger* "&plusmn;")

(define *html-ddagger* "&plusmn;&plusmn;")

(define *html-ldquo* "``")

(define *html-lsquo* "`")

(define *html-mdash* " -- ")

(define *html-ndash* "-")

(define *html-rdquo* "''")

(define *html-rsquo* "'")

(when *use-ligatures?* (set! *html-bull* "&#8226;") (set! *html-dagger* "&#8224;") (set! *html-ddagger* "&#8225;") (set! *html-ldquo* "&#8220;") (set! *html-lsquo* "&#8216;") (set! *html-mdash* "&#8212;") (set! *html-ndash* "&#8211;") (set! *html-rdquo* "&#8221;") (set! *html-rsquo* "&#8217;"))

(define *filename-delims* (quote ()))

(define *scm-token-delims* (list #\( #\) #\[ #\] #\{ #\} #\' #\` #\" #\; #\, #\|))

(define *tex-extra-letters* (quote ()))

(define *return* (integer->char 13))

(define *tab* (integer->char 9))

(define *after-eval* #f)

(define *aux-dir* #f)

(define *aux-dir/* "")

(define *aux-port* #f)

(define *bibitem-num* 0)

(define *comment-char* #\%)

(define *css-port* #f)

(define *current-mfpic-file-stem* #f)

(define *current-mfpic-file-num* #f)

(define *current-tex2page-input* #f)

(define *current-tex-file* #f)

(define *current-tex-line-number* #f)

(define *display-justification* (quote center))

(define *doing-urlh?* #f)

(define *dotted-counters* #f)

(define *esc-char* #\\)

(define *esc-char-std* #\\)

(define *esc-char-verb* #\|)

(define *eval-file-count* 0)

(define *eval-file-stem* #f)

(define *external-label-tables* #f)

(define *external-programs* (quote ()))

(define *figure-stack* (quote ()))

(define *footnote-list* (quote ()))

(define *footnote-sym* 0)

(define *global-texframe* #f)

(define *graphics-file-extensions* (quote ()))

(define *html* #f)

(define *html-head* #f)

(define *html-only* #f)

(define *html-page* #f)

(define *html-page-count* #f)

(define *img-file-count* 0)

(define *img-file-extn* "")

(define *img-file-tally* 0)

(define *imgdef-file-count* 0)

(define *imgpreamble* "")

(define *in-alltt?* #f)

(define *in-display-math?* #f)

(define *in-para?* #f)

(define *in-small-caps?* #f)

(define *includeonly-list* #f)

(define *index-alist* #f)

(define *index-count* #f)

(define *index-page* #f)

(define *index-port* #f)

(define *infructuous-calls-to-tex2page* #f)

(define *input-dirs* #f)

(define *inputting-boilerplate?* #f)

(define *inside-appendix?* #f)

(define *jobname* "texput")

(define *label-port* #f)

(define *label-table* #f)

(define *last-modification-time* #f)

(define *last-page-number* #f)

(define *latex-probability* #f)

(define *ligatures?* #f)

(define *loading-external-labels?* #f)

(define *log-file* #f)

(define *log-port* #f)

(define *main-tex-file* #f)

(define *math-mode?* #f)

(define *math-script-mode?* #f)

(define *math-roman-mode?* #f)

(define *missing-pieces* #f)

(define *not-processing?* #f)

(define *recent-node-name* #f)

(define *scm-dribbling?* #f)

(define *scm-port* #f)

(define *section-counters* #f)

(define *section-counter-dependencies* #f)

(define *self-promote?* #f)

(define *slatex-like-comments?* #f)

(define *slatex-math-escape* #f)

(define *stylesheets* #f)

(define *subjobname* *jobname*)

(define *tabular-stack* (quote ()))

(define *temp-string-count* #f)

(define *tex2page-inputs* #f)

(define *tex-aux-port* #f)

(define *tex-env* (quote ()))

(define *tex-format* #f)

(define *tex-if-stack* (quote ()))

(define *timestamp?* #f)

(define *title* #f)

(define *toc-list* #f)

(define *toc-page* #f)

(define *tracingcommands?* #f)

(define *tracingmacros?* #f)

(define *unresolved-xrefs* #f)

(define *using-chapters?* #f)

(define *verb-port* #f)

(define alphabetic-week-day (lambda (i) (vector-ref *the-days* i)))

(define alphabetic-month (lambda (i) (vector-ref *the-months* (- i 1))))

(define non-military-hour (lambda (h) (let ((h (modulo h 12))) (if (= h 0) 12 h))))

(define meridiem (lambda (h) (if (<= 0 h 11) "am" "pm")))

(define get-time-zone (lambda () (let ((tz (getenv "TZ"))) (if tz (string-append " " tz) ""))))

(define number->roman (lambda (n upcase?) (unless (and (integer? n) (>= n 0)) (terror (quote number->roman) "Missing number")) (let ((roman-digits (quote ((1000 #\m 100) (500 #\d 100) (100 #\c 10) (50 #\l 10) (10 #\x 1) (5 #\v 1) (1 #\i 0)))) (approp-case (lambda (c) (if upcase? (char-upcase c) c)))) (let loop ((n n) (dd roman-digits) (s (quote ()))) (if (null? dd) (if (null? s) "0" (list->string (reverse! s))) (let* ((d (car dd)) (val (car d)) (char (approp-case (cadr d))) (nextval (caddr d))) (let loop2 ((q (quotient n val)) (r (remainder n val)) (s s)) (if (= q 0) (if (>= r (- val nextval)) (loop (remainder r nextval) (cdr dd) (cons char (cons (approp-case (cadr (assv nextval dd))) s))) (loop r (cdr dd) s)) (loop2 (- q 1) r (cons char s))))))))))

(define sort! (lambda (s <<) (let quicksort ((j 0) (k (- (length s) 1))) (when (< j k) (let ((s_j (list-ref s j))) (let loop ((i j) (r (+ j 1))) (cond ((<= r k) (loop (let ((s_r (list-ref s r))) (if (<< s_r s_j) (begin (set-car! (list-tail s r) (list-ref s i)) (set-car! (list-tail s i) s_r) (+ i 1)) i)) (+ r 1))) (else (quicksort j (- i 1)) (quicksort (if (= i j) (+ i 1) i) k)))))) s)))

(define string-index (lambda (s c) (let ((n (string-length s))) (let loop ((i 0)) (cond ((>= i n) #f) ((char=? (string-ref s i) c) i) (else (loop (+ i 1))))))))

(define string-reverse-index (lambda (s c) (let loop ((i (- (string-length s) 1))) (cond ((< i 0) #f) ((char=? (string-ref s i) c) i) (else (loop (- i 1)))))))

(define substring? (lambda (s1 s2) (let* ((s1-len (string-length s1)) (s2-len (string-length s2)) (n-give-up (+ 1 (- s2-len s1-len)))) (let loop ((i 0)) (if (< i n-give-up) (let loop2 ((j 0) (k i)) (if (< j s1-len) (if (char=? (string-ref s1 j) (string-ref s2 k)) (loop2 (+ j 1) (+ k 1)) (loop (+ i 1))) i)) #f)))))

(define list-position (lambda (x s) (let loop ((s s) (i 0)) (cond ((null? s) #f) ((eq? (car s) x) i) (else (loop (cdr s) (+ i 1)))))))

(define-macro defstruct (lambda _args (let ((datum->syntax-object (lambda (x y) y)) (syntax-object->datum (lambda (x) x))) ((lambda (so) (datum->syntax-object so (let ((so-d (syntax-object->datum so))) (let ((s (cadr so-d)) (ff (cddr so-d))) (let ((s-s (symbol->string s)) (n (length ff))) (let* ((n+1 (+ n 1)) (vv (make-vector n+1))) (let loop ((i 1) (ff ff)) (if (< i n+1) (let ((f (car ff))) (vector-set! vv i (if (pair? f) (cadr f) (quote (if #f #f)))) (loop (+ i 1) (cdr ff))))) (let ((ff (map (lambda (f) (if (pair? f) (car f) f)) ff))) (quasiquote (begin (define (unquote (string->symbol (string-append "make-" s-s))) (lambda fvfv (let ((st (make-vector (unquote n+1))) (ff (quote (unquote ff)))) (vector-set! st 0 (quote (unquote s))) (unquote-splicing (let loop ((i 1) (r (quote ()))) (if (>= i n+1) r (loop (+ i 1) (cons (quasiquote (vector-set! st (unquote i) (unquote (vector-ref vv i)))) r))))) (let loop ((fvfv fvfv)) (unless (null? fvfv) (vector-set! st (+ (list-position (car fvfv) ff) 1) (cadr fvfv)) (loop (cddr fvfv)))) st))) (unquote-splicing (let loop ((i 1) (procs (quote ()))) (if (>= i n+1) procs (loop (+ i 1) (let ((f (symbol->string (list-ref ff (- i 1))))) (cons (quasiquote (define (unquote (string->symbol (string-append s-s "." f))) (lambda (x) (vector-ref x (unquote i))))) (cons (quasiquote (define (unquote (string->symbol (string-append "set!" s-s "." f))) (lambda (x v) (vector-set! x (unquote i) v)))) procs))))))) (define (unquote (string->symbol (string-append s-s "?"))) (lambda (x) (and (vector? x) (eq? (vector-ref x 0) (quote (unquote s))))))))))))))) (cons (quote defstruct) _args)))))

(defstruct table (equ eqv?) (alist (quote ())))

(define table-get (lambda (tbl k . d) (cond ((lassoc k (table.alist tbl) (table.equ tbl)) => cdr) ((pair? d) (car d)) (else #f))))

(define table-put! (lambda (tbl k v) (let ((al (table.alist tbl))) (let ((c (lassoc k al (table.equ tbl)))) (if c (set-cdr! c v) (set!table.alist tbl (cons (cons k v) al)))))))

(define table-for-each (lambda (tbl p) (for-each (lambda (c) (p (car c) (cdr c))) (table.alist tbl))))

(define lassoc (lambda (k al equ?) (let loop ((al al)) (if (null? al) #f (let ((c (car al))) (if (equ? (car c) k) c (loop (cdr al))))))))

(define ldelete (lambda (y xx equ?) (let loop ((xx xx) (r (quote ()))) (if (null? xx) (reverse! r) (let ((x (car xx))) (loop (cdr xx) (if (equ? x y) r (cons x r))))))))

(defstruct counter (value 0) (within #f))

(defstruct tocentry level number page label header)

(define string-trim-blanks (lambda (s) (let ((orig-n (string-length s))) (let ((i 0) (n orig-n)) (let loop ((k i)) (cond ((>= k n) (set! i n)) ((char-whitespace? (string-ref s k)) (loop (+ k 1))) (else (set! i k)))) (let loop ((k (- n 1))) (cond ((<= k i) (set! n (+ k 1))) ((char-whitespace? (string-ref s k)) (loop (- k 1))) (else (set! n (+ k 1))))) (if (and (= i 0) (= n orig-n)) s (substring s i n))))))

(define char-tex-alphabetic? (lambda (c) (or (char-alphabetic? c) (ormap (lambda (d) (char=? c d)) *tex-extra-letters*))))

(define gen-temp-string (lambda () (set! *temp-string-count* (+ *temp-string-count* 1)) (string-append "Temp_" (number->string *temp-string-count*))))

(define file-stem-name (lambda (f) (let ((slash (string-reverse-index f #\/))) (if slash (set! f (substring f (+ slash 1) (string-length f)))) (let ((dot (string-reverse-index f #\.))) (if dot (substring f 0 dot) f)))))

(define file-extension (lambda (f) (let ((slash (string-reverse-index f #\/)) (dot (string-reverse-index f #\.))) (if (and dot (not (= dot 0)) (or (not slash) (< (+ slash 1) dot))) (substring f dot (string-length f)) #f))))

(define ensure-file-deleted (lambda (f) (if (file-exists? f) (delete-file f))))

(define write-aux (lambda (e) (write e *aux-port*) (newline *aux-port*)))

(define write-label (lambda (e) (unless *label-port* (let ((f (string-append *aux-dir/* *jobname* *label-file-suffix* ".scm"))) (ensure-file-deleted f) (set! *label-port* (open-output-file f)))) (write e *label-port*) (newline *label-port*)))

(define write-bib-aux (lambda (x) (unless *tex-aux-port* (let ((f (string-append *aux-dir/* *jobname* *bib-aux-file-suffix* ".aux"))) (ensure-file-deleted f) (set! *tex-aux-port* (open-output-file f)))) (display x *tex-aux-port*)))

(define *write-log-max* 55)

(define *write-log-index* 0)

(define write-log (lambda (x) (unless *log-port* (set! *log-file* (string-append *aux-dir/* *jobname* ".hlog")) (ensure-file-deleted *log-file*) (set! *log-port* (open-output-file *log-file*))) (when (> *write-log-index* *write-log-max*) (unless (or (and (char? x) (not (char-whitespace? x)) (not (char=? x #\()) (not (char=? x #\[)) (not (char=? x #\{))) (number? x)) (newline *log-port*) (newline) (set! *write-log-index* 0))) (unless (and (= *write-log-index* 0) (char? x) (char-whitespace? x)) (display x *log-port*) (display x) (flush-output)) (set! *write-log-index* (+ *write-log-index* (cond ((and (= *write-log-index* 0) (char? x) (char-whitespace? x)) 0) ((char? x) (if (char=? x #\newline) (- *write-log-index*) 1)) ((number? x) (if (< x 10) 1 2)) ((string? x) (string-length x)) (else 1))))))

(define terror (lambda (where . args) (write-log #\newline) (write-log "! ") (for-each write-log args) (write-log #\newline) (when *current-tex-line-number* (write-log "l.") (write-log *current-tex-line-number*) (write-log #\space)) (error where)))

(define trace-if (lambda (write? . args) (when write? (write-log #\newline) (when *current-tex-line-number* (write-log "l.") (write-log *current-tex-line-number*) (write-log #\space)) (for-each write-log args) (write-log #\newline))))

(define do-message (lambda () (write-log (tex-string->html-string (get-group))) (write-log #\space)))

(define do-errmessage (lambda () (write-log #\newline) (write-log "! ") (write-log (tex-string->html-string (get-group))) (write-log #\newline) (terror "\\errmessage")))

(define do-tracingall (lambda () (do-tracingcommands #t) (do-tracingmacros #t)))

(define do-tracingcommands (lambda (unconditional-set?) (set! *tracingcommands?* (or unconditional-set? (begin (get-equal-sign) (> (get-number) 0))))))

(define do-tracingmacros (lambda (unconditional-set?) (set! *tracingmacros?* (or unconditional-set? (begin (get-equal-sign) (> (get-number) 0))))))

(defstruct bport (port #f) (buffer (quote ())))

(define call-with-input-file/buffered (lambda (f th) (unless (file-exists? f) (terror (quote call-with-input-file/buffered) "I can't find file `" f #\')) (call-with-input-file f (lambda (i) (fluid-let ((*current-tex2page-input* (make-bport (quote port) i)) (*current-tex-file* f) (*current-tex-line-number* 1)) (th))))))

(define call-with-input-string/buffered (lambda (s th) (fluid-let ((*current-tex2page-input* (make-bport (quote buffer) (string->list s))) (*current-tex-line-number* 1)) (th))))

(define call-with-input-string (lambda (s p) (let* ((i (open-input-string s)) (r (p i))) (close-input-port i) r)))

(define eval1 eval)

(define snoop-char (lambda () (let ((c (get-char))) (toss-back-char c) c)))

(define get-char (lambda () (let ((c (let ((b (bport.buffer *current-tex2page-input*))) (if (null? b) (let ((p (bport.port *current-tex2page-input*))) (if (not p) eof (let ((c (read-char p))) (cond ((eof-object? c) c) ((char=? c #\newline) (set! *current-tex-line-number* (+ *current-tex-line-number* 1)) c) (else c))))) (let ((c (car b))) (set!bport.buffer *current-tex2page-input* (cdr b)) c))))) c)))

(define toss-back-string (lambda (s) (set!bport.buffer *current-tex2page-input* (append! (string->list s) (bport.buffer *current-tex2page-input*)))))

(define toss-back-char (lambda (c) (set!bport.buffer *current-tex2page-input* (cons c (bport.buffer *current-tex2page-input*)))))

(define emit (lambda (s) (display s *html*)))

(define emit-newline (lambda () (newline *html*)))

(define invisible-space? (lambda (x) (eq? x *invisible-space*)))

(define snoop-actual-char (lambda () (let ((c (snoop-char))) (cond ((invisible-space? c) (get-char) (snoop-actual-char)) (else c)))))

(define get-actual-char (lambda () (let ((c (get-char))) (cond ((invisible-space? c) (get-actual-char)) (else c)))))

(define get-line (lambda () (let loop ((r (quote ()))) (let ((c (get-actual-char))) (cond ((eof-object? c) (if (null? r) c (list->string (reverse! r)))) ((char=? c #\newline) (list->string (reverse! r))) ((and (char-whitespace? c) (let ((c2 (snoop-actual-char))) (or (eof-object? c2) (char=? c2 #\newline)))) (get-actual-char) (list->string (reverse! r))) (else (loop (cons c r))))))))

(define ignorespaces (lambda () (if (find-chardef #\space) (when (= (the-count "\\TIIPobeyspacestrictly") 0) (let ((c (snoop-actual-char))) (cond ((eof-object? c) #t) ((char-whitespace? c) (get-actual-char)) (else #t)))) (let ((newline-active? (or (find-chardef #\newline))) (newline-already-read? #f)) (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) #t) ((char=? c #\newline) (cond (newline-active? #t) (newline-already-read? (set! *current-tex-line-number* (- *current-tex-line-number* 1)) (toss-back-char #\newline)) (else (get-actual-char) (set! newline-already-read? #t) (loop)))) ((char-whitespace? c) (get-actual-char) (loop)) (else #t))))))))

(define ignore-all-whitespace (lambda () (let loop () (let ((c (snoop-actual-char))) (unless (eof-object? c) (when (char-whitespace? c) (get-actual-char) (loop)))))))

(define ignore-same-line-space (lambda () (let loop () (let ((c (snoop-actual-char))) (unless (eof-object? c) (when (or (char=? c #\space) (char=? c *tab*)) (get-actual-char) (loop)))))))

(define munch-newlines (lambda () (let loop ((n 0)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) n) ((char=? c #\newline) (get-actual-char) (loop (+ n 1))) ((char-whitespace? c) (get-actual-char) (loop n)) (else n))))))

(define munched-a-newline? (lambda () (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) #f) ((char=? c #\newline) (get-actual-char) #t) ((char-whitespace? c) (get-actual-char) (loop)) (else #f))))))

(define do-relax (lambda () #t))

(define get-ctl-seq (lambda () (let ((bs (get-actual-char))) (unless (char=? bs *esc-char*) (terror (quote get-ctl-seq) "Missing control sequence (" bs ")"))) (let ((c (get-char))) (cond ((eof-object? c) "\\ ") ((invisible-space? c) "\\ ") ((char-tex-alphabetic? c) (list->string (reverse! (let loop ((s (list c #\\))) (let ((c (snoop-char))) (cond ((eof-object? c) s) ((invisible-space? c) s) ((char-alphabetic? c) (get-char) (loop (cons c s))) (else (unless (or *math-mode?* *not-processing?*) ((if (eqv? *tex-format* (quote texinfo)) ignore-same-line-space ignorespaces))) s))))))) (else (string #\\ c))))))

(define get-char-as-ctl-seq (lambda () (let* ((cs (get-ctl-seq)) (c (string-ref cs 1))) (if (char=? c #\^) (let ((c2 (snoop-actual-char))) (if (char=? c2 #\^) (begin (get-actual-char) (let ((c3 (get-actual-char))) (case c3 ((#\M) #\newline) ((#\I) *tab*) (else (terror (quote get-char-as-ctl-seq)))))) c)) c))))

(define ctl-seq? (lambda (z) (char=? (string-ref z 0) #\\)))

(define if-aware-ctl-seq? (lambda (z) (or (ormap (lambda (y) (string=? z y)) (quote ("\\else" "\\fi" "\\eval" "\\let" "\\end" "\\csname"))) (and (>= (string-length z) 3) (char=? (string-ref z 1) #\i) (char=? (string-ref z 2) #\f)))))

(define get-group (lambda () (ignorespaces) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote get-group) "Runaway argument?")) (unless (char=? c #\{) (terror (quote get-group) "Missing {")) (list->string (reverse! (let loop ((s (list c)) (nesting 0) (escape? #f)) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote get-group) "Runaway argument?")) (cond (escape? (loop (cons c s) nesting #f)) ((char=? c *esc-char*) (loop (cons c s) nesting #t)) ((char=? c #\{) (loop (cons c s) (+ nesting 1) #f)) ((char=? c #\}) (if (= nesting 0) (cons c s) (loop (cons c s) (- nesting 1) #f))) (else (loop (cons c s) nesting #f))))))))))

(define get-grouped-environment-name-if-any (lambda () (let ((c (snoop-actual-char))) (if (or (eof-object? c) (not (char=? c #\{))) #f (begin (get-actual-char) (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((or (char-alphabetic? c) (char=? c #\*)) (get-actual-char) (loop (cons c s))) ((and (pair? s) (char=? c #\})) (get-actual-char) (list->string (reverse! s))) (else (for-each toss-back-char s) (toss-back-char #\{) #f)))))))))

(define get-bracketed-text-if-any (lambda () (ignorespaces) (let ((c (snoop-actual-char))) (if (or (eof-object? c) (not (char=? c #\[))) #f (begin (get-actual-char) (list->string (reverse! (let loop ((s (quote ())) (nesting 0) (escape? #f)) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote get-bracketed-text-if-any) "Runaway argument?")) (cond (escape? (loop (cons c s) nesting #f)) ((char=? c *esc-char*) (loop (cons c s) nesting #t)) ((char=? c #\{) (loop (cons c s) (+ nesting 1) #f)) ((char=? c #\}) (loop (cons c s) (- nesting 1) #f)) ((char=? c #\]) (if (= nesting 0) s (loop (cons c s) nesting #f))) (else (loop (cons c s) nesting #f))))))))))))

(define ungroup (lambda (s) (let* ((n (string-length s)) (n-1 (- n 1))) (if (or (< n 2) (not (char=? (string-ref s 0) #\{)) (not (char=? (string-ref s n-1) #\}))) s (substring s 1 n-1)))))

(define get-filename (lambda () (ignorespaces) (list->string (reverse! (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((or (eof-object? c) (char-whitespace? c) (and *comment-char* (char=? c *comment-char*)) (ormap (lambda (d) (char=? c d)) *filename-delims*)) (unless *not-processing?* (ignorespaces)) s) ((and *esc-char* (char=? c *esc-char*)) (let ((x (get-ctl-seq))) (if (string=? x "\\jobname") (loop (append! (reverse! (string->list *jobname*)) s)) (begin (toss-back-char *invisible-space*) (toss-back-string x) s)))) (else (get-actual-char) (loop (cons c s))))))))))

(define get-integer (lambda (base) (ignorespaces) (string->number (list->string (reverse! (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((eof-object? c) s) ((or (char-numeric? c) (and (= base 16) (char-alphabetic? c))) (get-actual-char) (loop (cons c s))) (else (ignorespaces) s)))))) base)))

(define get-real (lambda () (ignorespaces) (string->number (list->string (reverse! (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((eof-object? c) s) ((or (char-numeric? c) (char=? c #\.)) (get-actual-char) (loop (cons c s))) (else (ignorespaces) s)))))))))

(define get-dimen (lambda () (let* ((n (get-real)) (c1 (get-actual-char)) (c2 (get-actual-char))) (if (and (char-alphabetic? c1) (char-alphabetic? c2)) (list n (string->symbol (string c1 c2))) (begin (eat-dimen) (list 0 (quote pt)))))))

(define get-equal-sign (lambda () (ignorespaces) (when (char=? (snoop-actual-char) #\=) (get-actual-char))))

(define get-by (lambda () (ignorespaces) (when (char=? (snoop-actual-char) #\b) (get-actual-char) (if (char=? (snoop-actual-char) #\y) (get-actual-char) (toss-back-char #\b)))))

(define get-to (lambda () (ignorespaces) (when (char=? (snoop-actual-char) #\t) (get-actual-char) (if (char=? (snoop-actual-char) #\o) (get-actual-char) (toss-back-char #\t)))))

(define get-number (lambda () (ignorespaces) (let ((c (snoop-actual-char))) (cond ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x "\\the") (cadr (find-count (get-ctl-seq)))) ((string=? x "\\active") 13) ((string=? x "\\pageno") *html-page-count*) ((string=? x "\\footnotenumber") (get-gcount "\\footnotenumber")) ((string=? x "\\figurenumber") (counter.value (table-get *dotted-counters* "figure"))) ((string=? x "\\sectiondnumber") (table-get *section-counters* (string->number (ungroup (get-token))) 0)) ((find-count x) => cadr) (else (string->number (resolve-defs x)))))) ((char=? c #\') (get-actual-char) (get-integer 8)) ((char=? c #\") (get-actual-char) (get-integer 16)) ((char=? c #\`) (get-actual-char) (ignorespaces) (char->integer (if (char=? (snoop-actual-char) *esc-char*) (string-ref (get-ctl-seq) 1) (get-actual-char)))) ((char=? c #\-) (get-actual-char) (- (get-integer 10))) ((char-numeric? c) (get-integer 10)) (else (terror (quote get-number)))))))

(define get-tex-char-spec (lambda () (ignorespaces) (case (snoop-actual-char) ((#\`) (get-actual-char) (ignorespaces) (if (char=? (snoop-actual-char) #\\) (get-char-as-ctl-seq) (get-actual-char))) ((#\') (get-actual-char) (integer->char (get-integer 8))) ((#\") (get-actual-char) (integer->char (get-integer 16))) (else (integer->char (get-integer 10))))))

(define get-url (lambda () (ignorespaces) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote get-url) "Missing {")) ((not (char=? c #\{)) (terror (quote get-url) "Missing {"))) (string-trim-blanks (list->string (reverse! (let loop ((s (quote ()))) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote get-url) "Missing }")) ((and *comment-char* (char=? c *comment-char*)) (let ((c1 (snoop-actual-char))) (loop (if (and (char? c1) (char-whitespace? c1)) (begin (ignore-all-whitespace) s) (cons c s))))) ((char=? c #\}) s) (else (loop (cons c s))))))))))))

(define get-csv (lambda () (ignorespaces) (let ((rev-lbl (let loop ((s (quote ())) (nesting 0)) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote get-csv) "Runaway argument of \\cite, " "\\nocite, \\expandhtmlindex?") s) ((and (char=? c #\,) (= nesting 0)) s) ((char=? c #\{) (loop (cons c s) (+ nesting 1))) ((char=? c #\}) (if (= nesting 0) (begin (toss-back-char c) s) (loop (cons c s) (- nesting 1)))) (else (loop (cons c s) nesting))))))) (if (null? rev-lbl) #f (list->string (reverse! rev-lbl))))))

(define get-raw-token (lambda () (let ((c (snoop-actual-char))) (cond ((eof-object? c) c) ((char=? c *esc-char*) (get-ctl-seq)) (else (string (get-actual-char)))))))

(define get-raw-token/is (lambda () (ignorespaces) (let ((c (snoop-actual-char))) (cond ((eof-object? c) c) ((char=? c *esc-char*) (get-ctl-seq)) ((and *comment-char* (char=? c *comment-char*)) (eat-till-eol) (get-raw-token/is)) (else (string (get-actual-char)))))))

(define get-token (lambda () (ignorespaces) (let ((c (snoop-actual-char))) (cond ((eof-object? c) c) ((char=? c *esc-char*) (get-ctl-seq)) ((char=? c #\{) (get-group)) ((and *comment-char* (char=? c *comment-char*)) (eat-till-eol) (get-token)) (else (string (get-actual-char)))))))

(define eat-dimen (lambda () (get-equal-sign) (fluid-let ((*not-processing?* #t)) (let loop ((first? #t)) (let ((x (get-filename))) (if (string=? x "") (quote done) (let ((x0 (string-ref x 0))) (cond ((or (char=? x0 #\.) (char=? x0 #\-)) (loop #f)) ((char-numeric? x0) (loop #f)) ((char=? x0 *esc-char*) (toss-back-string x)) ((ormap (lambda (z) (string=? x z)) (quote ("by" "ex" "in" "minus" "plus" "pt" "true" "truein"))) (loop #f)) (else (toss-back-string x))))))))))

(define eat-integer (lambda () (fluid-let ((*not-processing?* #t)) (ignorespaces) (get-equal-sign) (get-integer 10))))

(define scm-get-token (lambda () (list->string (reverse! (let loop ((s (quote ())) (esc? #f)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) s) (esc? (get-actual-char) (loop (cons c s) #f)) ((char=? c #\\) (get-actual-char) (loop (cons c s) #t)) ((or (char-whitespace? c) (memv c *scm-token-delims*)) s) (else (get-actual-char) (loop (cons c s) #f)))))))))

(define emit-html-char (lambda (c) (unless (eof-object? c) (case c ((#\<) (emit "&lt;")) ((#\>) (emit "&gt;")) ((#\") (emit "&quot;")) ((#\&) (emit "&amp;")) ((#\newline) (emit-newline)) (else (emit c))))))

(define emit-html-string (lambda (s) (let ((n (string-length s))) (let loop ((i 0)) (unless (>= i n) (emit-html-char (string-ref s i)) (loop (+ i 1)))))))

(define member/string-ci=? (lambda (s ss) (ormap (lambda (x) (string-ci=? x s)) ss)))

(define endenvironment-delims (quote (#\( #\) #\[ #\] #\' #\` #\" #\; #\, #\@ #\|)))

(define check-for-endenvironment (lambda () (list->string (reverse! (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((eof-object? c) s) ((or (char-whitespace? c) (memv c endenvironment-delims)) s) (else (get-actual-char) (loop (cons c s))))))))))

(defstruct texframe (definitions (quote ())) (chardefinitions (quote ())) (counts (quote ())) (toks (quote ())) (dimens (quote ())) (postludes (quote ())) (aftergroups (quote ())))

(set! *global-texframe* (make-texframe))

(define *primitive-texframe* (make-texframe))

(define *math-primitive-texframe* (make-texframe))

(define bgroup (lambda () (set! *tex-env* (cons (make-texframe) *tex-env*))))

(define egroup (lambda () (if (null? *tex-env*) (terror (quote egroup) "Too many }'s")) (perform-postludes) (perform-aftergroups) (set! *tex-env* (cdr *tex-env*))))

(define perform-postludes (lambda () (for-each (lambda (p) (p)) (texframe.postludes (top-texframe)))))

(define perform-aftergroups (lambda () (let ((ags (texframe.aftergroups (top-texframe)))) (unless (null? ags) (toss-back-char *invisible-space*)) (for-each (lambda (ag) (ag)) ags))))

(define add-postlude-to-top-frame (lambda (p) (let ((fr (if (null? *tex-env*) *global-texframe* (car *tex-env*)))) (set!texframe.postludes fr (cons p (texframe.postludes fr))))))

(define add-aftergroup-to-top-frame (lambda (ag) (let ((fr (if (null? *tex-env*) *global-texframe* (car *tex-env*)))) (set!texframe.aftergroups fr (cons ag (texframe.aftergroups fr))))))

(define top-texframe (lambda () (if (null? *tex-env*) *global-texframe* (car *tex-env*))))

(define do-global (lambda () (ignorespaces) (let ((next (get-ctl-seq))) (cond ((ormap (lambda (z) (string=? next z)) (quote ("\\def" "\\edef"))) (do-def #t)) ((string=? next "\\let") (do-let #t)) ((string=? next "\\newcount") (do-newcount #t)) ((string=? next "\\newtoks") (do-newtoks #t)) ((string=? next "\\newdimen") (do-newdimen #t)) ((string=? next "\\advance") (do-advance #t)) ((string=? next "\\multiply") (do-multiply #t)) ((string=? next "\\divide") (do-divide #t)) ((ormap (lambda (z) (string=? next z)) (quote ("\\imgdef" "\\gifdef"))) (make-reusable-img #t)) ((find-count next) (do-count= next #t)) ((find-toks next) (do-toks= next #t)) (else (toss-back-string next))))))

(define do-external-title (lambda () (write-aux (quasiquote (!preferred-title (unquote (tex-string->html-string (get-group))))))))

(define output-external-title (lambda () (emit "<title>") (emit-newline) (bgroup) (tex-def "\\\\" (quote ()) "{}" #f #f) (tex-def "\\thanks" #t "\\TIIPgobblegroup" #f #f) (tex2page-string (or *title* *jobname*)) (emit-newline) (egroup) (emit "</title>") (emit-newline)))

(define output-title (lambda (tit) (emit "<h1 class=title align=center><br><br>") (bgroup) (tex-def "\\\\" (quote ()) "{\\break}" #f #f) (tex2page-string tit) (egroup) (emit "</h1>") (emit-newline)))

(define do-subject (lambda () (do-end-para) (let ((tit (get-group))) (unless *title* (flag-missing-piece (quote document-title))) (write-aux (quasiquote (!default-title (unquote tit)))) (output-title tit))))

(define do-latex-title (lambda () (let ((tit (get-group))) (unless *title* (flag-missing-piece (quote document-title))) (write-aux (quasiquote (!default-title (unquote tit)))) (toss-back-string tit) (toss-back-string "\\def\\TIIPtitle"))))

(define do-title (lambda () ((if (eqv? *tex-format* (quote latex)) do-latex-title do-subject))))

(define do-author (lambda () (toss-back-string "\\def\\TIIPauthor")))

(define do-date (lambda () (toss-back-string "\\def\\TIIPdate")))

(define do-para (lambda () (let ((in-table? (and (not (null? *tabular-stack*)) (memv (car *tabular-stack*) (quote (block)))))) (when *in-para?* (when *use-closing-p-tag?* (emit "</p>"))) (emit-newline) (when in-table? (emit "</td></tr><tr><td>") (emit-newline)) (emit "<p>") (set! *in-para?* #t))))

(define do-end-para (lambda () (when *in-para?* (when *use-closing-p-tag?* (emit "</p>")) (emit-newline) (set! *in-para?* #f))))

(define do-maketitle (lambda () (do-end-para) (bgroup) (tex-def "\\\\" (quote ()) "\\break" #f #f) (tex-def "\\and" (quote ()) "\\break" #f #f) (tex-def "\\thanks" #t "\\symfootnote" #f #f) (output-title "\\TIIPtitle") (do-para) (do-end-para) (emit "<div align=center>") (emit-newline) (tex2page-string "\\TIIPauthor") (do-para) (tex2page-string "\\TIIPdate") (do-end-para) (emit "</div>") (emit-newline) (egroup) (do-para)))

(define do-html-stylesheet (lambda () (when (null? *stylesheets*) (flag-missing-piece (quote stylesheets))) (write-aux (quasiquote (!stylesheet (unquote (ungroup (get-group))))))))

(define do-input-css (lambda () (ignorespaces) (let ((f (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\{)) (ungroup (get-group)) (get-filename))))) (when (null? *stylesheets*) (flag-missing-piece (quote stylesheets))) (write-aux (quasiquote (!stylesheet (unquote f)))))))

(define do-csname (lambda () (ignorespaces) (let loop ((r (list *esc-char*))) (let ((c (snoop-actual-char))) (cond ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x "\\endcsname") (toss-back-char *invisible-space*) (for-each toss-back-char r)) (else (terror (quote do-csname)))))) (else (get-actual-char) (loop (cons c r))))))))

(define do-css-block (lambda () (unless *css-port* (let* ((f (string-append *jobname* *css-file-suffix* ".css")) (real-f (if *aux-dir* (string-append *aux-dir/* f) f))) (when (null? *stylesheets*) (flag-missing-piece (quote stylesheets))) (write-aux (quasiquote (!stylesheet (unquote f)))) (ensure-file-deleted real-f) (set! *css-port* (open-output-file real-f)))) (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-css-block))) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x "\\endcssblock") (quote done)) ((string=? x "\\end") (cond ((get-grouped-environment-name-if-any) => (lambda (e) (unless (string=? e "cssblock") (write-char c *css-port*) (write-char #\{ *css-port*) (display e *css-port*) (write-char #\} *css-port*) (loop)))) (else (display x *css-port*) (loop)))) (else (display x *css-port*) (loop))))) (else (get-actual-char) (write-char c *css-port*) (loop)))))))

(define link-stylesheet (lambda (css) (emit "<link rel=\"stylesheet\" type=\"text/css\" href=\"") (emit css) (emit "\" title=default>") (emit-newline)))

(define increment-section-counter (lambda (seclvl unnumbered?) (unless unnumbered? (table-put! *section-counters* seclvl (+ 1 (table-get *section-counters* seclvl 0)))) (table-for-each *section-counters* (lambda (k v) (if (and (> k seclvl) (> k 0)) (table-put! *section-counters* k 0)))) (for-each (lambda (counter-name) (set!counter.value (table-get *dotted-counters* counter-name) 0)) (table-get *section-counter-dependencies* seclvl (quote ())))))

(define section-counter-value (lambda (seclvl) (if (= seclvl -1) (number->roman (table-get *section-counters* -1) #t) (let ((i (if *using-chapters?* 0 1))) (let ((outermost-secnum (let ((n (table-get *section-counters* i 0))) (if *inside-appendix?* (string (integer->char (+ (char->integer #\A) -1 n))) (number->string n))))) (let loop ((i (+ i 1)) (r outermost-secnum)) (if (> i seclvl) r (loop (+ i 1) (string-append r "." (number->string (table-get *section-counters* i 0)))))))))))

(define section-ctl-seq? (lambda (s) (cond ((string=? s "\\sectiond") (string->number (ungroup (get-token)))) ((string=? s "\\part") -1) ((string=? s "\\chapter") (!using-chapters) (write-aux (quasiquote (!using-chapters))) (if (and (eqv? *tex-format* (quote latex)) (< (get-gcount "\\secnumdepth") -1)) (set-gcount! "\\secnumdepth" 2)) 0) (else (let ((n (string-length s))) (cond ((< n 8) #f) ((and (>= n 10) (string=? (substring s (- n 9) n) "paragraph")) (let ((n-9 (- n 9))) (let loop ((i 1) (i+3 4) (k 4)) (cond ((> i+3 n-9) k) ((string=? (substring s i i+3) "sub") (loop i+3 (+ i+3 3) (+ k 1))) (else #f))))) ((string=? (substring s (- n 7) n) "section") (let ((n-7 (- n 7))) (let loop ((i 1) (i+3 4) (k 1)) (cond ((> i+3 n-7) k) ((string=? (substring s i i+3) "sub") (loop i+3 (+ i+3 3) (+ k 1))) (else #f))))) (else #f)))))))

(define do-heading (lambda (seclvl) (let ((unnumbered? (let ((secnumdepth (get-gcount "\\secnumdepth")) (c (snoop-actual-char))) (cond ((char=? c #\*) (get-actual-char) #t) ((< secnumdepth -1) #f) ((> seclvl secnumdepth) #t) (else #f))))) (if (<= seclvl 0) (do-eject)) (increment-section-counter seclvl unnumbered?) (let* ((htmlnum (max 1 (min 6 (if *using-chapters?* (+ seclvl 1) seclvl)))) (header (get-group)) (lbl-val (if unnumbered? "IGNORE" (section-counter-value seclvl))) (lbl (string-append "%_" (case seclvl ((-1) "part") ((0) "chap") (else "sec")) "_" (if unnumbered? (gen-temp-string) lbl-val)))) (unless unnumbered? (tex-def-toks "\\TIIPrecentlabelname" lbl #f) (tex-def-toks "\\TIIPrecentlabelvalue" lbl-val #f)) (do-end-para) (emit-anchor lbl) (emit-newline) (ignore-all-whitespace) (emit "<h") (emit htmlnum) (case seclvl ((-1) (emit " class=part align=center")) ((0) (emit " class=chapter"))) (emit ">") (let ((write-to-toc? (and *toc-page* (not (and (eqv? *tex-format* (quote latex)) (string=? header "{Contents}")))))) (case seclvl ((-1) (emit "<div class=partheading>") (if unnumbered? (emit-nbsp 1) (begin (when write-to-toc? (emit-page-node-link-start *toc-page* (string-append "%_toc_" lbl))) (emit "Part ") (emit lbl-val) (when write-to-toc? (emit-link-stop)))) (emit "</div><br>") (emit-newline)) ((0) (emit-newline) (emit "<div class=chapterheading>") (if unnumbered? (emit-nbsp 1) (begin (when write-to-toc? (emit-page-node-link-start *toc-page* (string-append "%_toc_" lbl))) (tex2page-string (if *inside-appendix?* "\\appendixname" "\\chaptername")) (emit lbl-val) (when write-to-toc? (emit-link-stop)))) (emit "</div><br>") (emit-newline))) (when write-to-toc? (emit-page-node-link-start *toc-page* (string-append "%_toc_" lbl))) (unless (or (<= seclvl 0) unnumbered?) (emit lbl-val) (emit-nbsp 2)) (fluid-let ((*tabular-stack* (list (quote header)))) (tex2page-string header)) (when write-to-toc? (emit-link-stop)) (emit "</h") (emit htmlnum) (emit ">") (do-para) (let ((tocdepth (get-gcount "\\tocdepth"))) (when (and write-to-toc? (or (< tocdepth -1) (<= seclvl tocdepth))) (write-aux (quasiquote (!toc-entry (unquote (if (= seclvl -1) -1 (if *using-chapters?* seclvl (- seclvl 1)))) (unquote lbl-val) (unquote *html-page-count*) (unquote lbl) (unquote header))))))) (when *recent-node-name* (do-label-aux *recent-node-name*) (set! *recent-node-name* #f))))))

(define do-documentclass (lambda () (probably-latex) (get-bracketed-text-if-any) (let ((x (string-trim-blanks (ungroup (get-group))))) (when (ormap (lambda (z) (string=? x z)) (quote ("report" "book"))) (!using-chapters) (write-aux (quasiquote (!using-chapters)))))))

(define do-beginsection (lambda () (ignorespaces) (let ((header (let loop ((r (quote ())) (newline? #f)) (let ((c (get-actual-char))) (cond ((or (eof-object? c) (and newline? (char=? c #\newline))) (list->string (reverse! r))) (else (loop (cons c r) (if newline? (char-whitespace? c) (char=? c #\newline))))))))) (emit "<h1 class=beginsection>") (bgroup) (fluid-let ((*tabular-stack* (list (quote header)))) (tex2page-string header)) (egroup) (emit "</h1>") (emit-newline))))

(define do-appendix (lambda () (unless *inside-appendix?* (set! *inside-appendix?* #t) (table-put! *section-counters* (if *using-chapters?* 0 1) 0))))

(define do-table-plain (lambda () (do-end-para) (emit "<table width=100%><tr><td>")))

(define do-end-table-plain (lambda () (do-end-para) (emit "</td></tr></table>")))

(define do-table (lambda () (do-end-para) (bgroup) (set! *figure-stack* (cons (quote table) *figure-stack*)) (set! *tabular-stack* (cons (quote table) *tabular-stack*)) (get-bracketed-text-if-any) (let* ((counter (table-get *dotted-counters* "table")) (new-counter-value (+ 1 (counter.value counter)))) (set!counter.value counter new-counter-value) (let* ((tbl-num (cond ((counter.within counter) => (lambda (sec-num) (string-append (section-counter-value sec-num) "." (number->string new-counter-value)))) (else (number->string new-counter-value)))) (tbl-tag (string-append "%_tbl_" tbl-num))) (tex-def-toks "\\TIIPrecentlabelname" tbl-tag #f) (tex-def-toks "\\TIIPrecentlabelvalue" tbl-num #f) (emit-anchor tbl-tag) (emit "<div class=table><table width=100%><tr><td align=") (emit *display-justification*) (emit ">")))))

(define do-figure (lambda () (do-end-para) (bgroup) (when (char=? (snoop-actual-char) #\*) (get-actual-char)) (set! *figure-stack* (cons (quote figure) *figure-stack*)) (set! *tabular-stack* (cons (quote figure) *tabular-stack*)) (get-bracketed-text-if-any) (let ((fig-tag (string-append "%_fig_" (gen-temp-string)))) (tex-def-toks "\\TIIPrecentlabelname" fig-tag #f) (emit-anchor fig-tag) (emit-newline) (emit "<div align=") (emit *display-justification*) (emit "><table width=100%><tr><td>"))))

(define do-end-table (lambda () (do-end-table-plain) (emit "</div>") (set! *figure-stack* (cdr *figure-stack*)) (set! *tabular-stack* (cdr *tabular-stack*)) (egroup) (do-para)))

(define do-marginpar (lambda () (get-bracketed-text-if-any) (emit "<table align=left border=2><tr><td>") (tex2page-string (get-group)) (emit "</td></tr></table>")))

(define do-end-figure (lambda () (cond ((snoop-actual-char) => (lambda (c) (if (char=? c #\*) (get-actual-char))))) (do-end-table)))

(define do-caption (lambda () (let* ((counter (table-get *dotted-counters* "figure")) (new-counter-value (+ 1 (counter.value counter)))) (set!counter.value counter new-counter-value) (let ((fig-num (cond ((counter.within counter) => (lambda (sec-num) (string-append (section-counter-value sec-num) "." (number->string new-counter-value)))) (else (number->string new-counter-value))))) (tex-def-toks "\\TIIPrecentlabelvalue" fig-num #f) (get-bracketed-text-if-any) (do-end-para) (emit "</td></tr><tr><td align=") (emit *display-justification*) (emit "><b>") (if (null? *figure-stack*) (terror (quote do-caption) "Mislaid \\caption") (case (car *figure-stack*) ((figure) (emit "Figure ")) ((table) (emit "Table ")))) (tex2page-string (get-toks "\\TIIPrecentlabelvalue")) (emit ":</b>") (emit-nbsp 2) (tex2page-string (get-group)) (emit "</td></tr><tr><td>")))))

(define do-minipage (lambda () (get-bracketed-text-if-any) (get-group) (let ((in-table? (and (not (null? *tabular-stack*)) (memv (car *tabular-stack*) (quote (block figure table)))))) (if in-table? (emit "</td><td>") (begin (do-para) (do-end-para))) (emit "<div align=left>") (set! *tabular-stack* (cons (quote minipage) *tabular-stack*)))))

(define do-endminipage (lambda () (set! *tabular-stack* (cdr *tabular-stack*)) (let ((in-table? (and (not (null? *tabular-stack*)) (memv (car *tabular-stack*) (quote (block figure table)))))) (emit "</div>") (if in-table? (emit "</td><td>") (do-para)))))

(define do-tabbing (lambda () (set! *tabular-stack* (cons (quote tabbing) *tabular-stack*)) (do-para)))

(define do-end-tabbing (lambda () (set! *tabular-stack* (cdr *tabular-stack*)) (do-para)))

(define indent-n-levels (lambda (n) (let loop ((i -1)) (unless (>= i n) (emit-nbsp 1) (emit " ") (emit-nbsp 1) (emit " ") (loop (+ i 1))))))

(define do-toc (lambda () (fluid-let ((*subjobname* (string-append *jobname* *toc-file-suffix*)) (*img-file-count* 0) (*imgdef-file-count* 0)) (when (eqv? *tex-format* (quote latex)) (tex2page-string (if *using-chapters?* "\\chapter*{Contents}" "\\section*{Contents}"))) (emit-anchor "%_toc_start") (!toc-page *html-page-count*) (write-aux (quasiquote (!toc-page (unquote *html-page-count*)))) (cond ((null? *toc-list*) (flag-missing-piece (quote toc)) (non-fatal-error "Table of contents not generated; rerun TeX2page")) (else (let ((tocdepth (get-gcount "\\tocdepth"))) (for-each (lambda (x) (let* ((lvl (tocentry.level x)) (secnum (tocentry.number x)) (seclabel (tocentry.label x)) (subentries? (or (= lvl -1) (and (= lvl 0) (or (< tocdepth -1) (and *using-chapters?* (> tocdepth 0)) (and (not *using-chapters?*) (> tocdepth 1))))))) (when subentries? (do-para) (emit "<b>") (emit-newline)) (indent-n-levels lvl) (emit-anchor (string-append "%_toc_" seclabel)) (emit-page-node-link-start (tocentry.page x) seclabel) (unless (string=? secnum "IGNORE") (emit secnum) (emit-nbsp 2)) (fluid-let ((*tabular-stack* (list (quote header)))) (tex2page-string (tocentry.header x))) (emit-link-stop) (when subentries? (emit "</b>")) (emit "<br>") (emit-newline))) *toc-list*)))))))

(defstruct footnotev mark text tag caller)

(define do-numbered-footnote (lambda () (let ((num (+ (get-gcount "\\footnotenumber") 1))) (set-gcount! "\\footnotenumber" num) (let ((s (number->string num))) (do-footnote-aux s)))))

(define do-symfootnote (lambda () (set! *footnote-sym* (+ *footnote-sym* 1)) (do-footnote-aux (number->footnote-symbol *footnote-sym*))))

(define number->footnote-symbol (lambda (n) (list-ref (quote ("*" "\\dag" "\\ddag" "\\S" "\\P" "\\Vert" "**" "\\dag\\dag" "\\ddag\\ddag")) (modulo (- n 1) 9))))

(define do-plain-footnote (lambda () (let ((fnmark (get-token))) (do-footnote-aux fnmark))))

(define do-footnote (lambda () ((if (eqv? *tex-format* (quote latex)) do-numbered-footnote do-plain-footnote))))

(define do-footnote-aux (lambda (fnmark) (let* ((fnlabel (gen-temp-string)) (fntag (string-append "footnote_" fnlabel)) (fncalltag (string-append "call_footnote_" fnlabel)) (fn-tmp-port (open-output-string))) (emit-anchor fncalltag) (emit-page-node-link-start #f fntag) (emit "<sup><small>") (tex2page-string fnmark) (emit "</small></sup>") (emit-link-stop) (ignorespaces) (unless (char=? (get-actual-char) #\{) (terror (quote do-footnote-aux) "Missing {")) (bgroup) (let ((old-html *html*)) (set! *html* fn-tmp-port) (tex-def-toks "\\TIIPrecentlabelname" fntag #f) (tex-def-toks "\\TIIPrecentlabelvalue" fnmark #f) (add-aftergroup-to-top-frame (lambda () (set! *footnote-list* (cons (make-footnotev (quote mark) fnmark (quote text) (get-output-string fn-tmp-port) (quote tag) fntag (quote caller) fncalltag) *footnote-list*)) (set! *html* old-html)))))))

(define output-footnotes (lambda () (let ((n (length *footnote-list*))) (unless (= n 0) (do-end-para) (emit "<div class=smallprint><hr></div>") (do-para) (do-end-para) (emit "<div class=footnote>") (let loop ((i (- n 1))) (unless (< i 0) (let ((fv (list-ref *footnote-list* i))) (do-para) (emit-anchor (footnotev.tag fv)) (emit-page-node-link-start #f (footnotev.caller fv)) (emit "<sup><small>") (tex2page-string (footnotev.mark fv)) (emit "</small></sup>") (emit-link-stop) (emit " ") (emit (footnotev.text fv)) (do-end-para) (loop (- i 1))))) (emit "</div>") (emit-newline)))))

(define do-switch (lambda (sw) (ignorespaces) (add-postlude-to-top-frame (cond ((string=? sw "\\rm") (when *math-mode?* (let ((old-math-roman-mode? *math-roman-mode?*)) (set! *math-roman-mode?* #t) (lambda () (set! *math-roman-mode?* old-math-roman-mode?))))) ((string=? sw "\\em") (emit "<em>") (lambda () (emit "</em>"))) ((ormap (lambda (z) (string=? sw z)) (quote ("\\it" "\\itshape" "\\sl"))) (emit "<i>") (lambda () (emit "</i>"))) ((string=? sw "\\bf") (emit "<strong>") (lambda () (emit "</strong>"))) ((string=? sw "\\tt") (let ((old-ligatures? *ligatures?*)) (set! *ligatures?* #f) (emit "<tt>") (lambda () (emit "</tt>") (set! *ligatures?* old-ligatures?)))) ((ormap (lambda (z) (string=? sw z)) (quote ("\\sc" "\\scshape"))) (let ((old-in-small-caps? *in-small-caps?*)) (set! *in-small-caps?* #t) (lambda () (set! *in-small-caps?* old-in-small-caps?)))) ((ormap (lambda (z) (string=? sw z)) (quote ("\\sevenrm" "\\small" "\\scriptsize"))) (emit "<small>") (lambda () (emit "</small>"))) ((string=? sw "\\fiverm") (emit "<font size=-2>") (lambda () (emit "</font>"))) ((string=? sw "\\Huge") (emit "<font size=+4>") (lambda () (emit "</font>"))) ((string=? sw "\\color") (emit "<font color=\"") (let ((color (ungroup (get-group)))) (if (string->number color 16) (emit "#")) (emit color) (emit "\">") (lambda () (emit "</font>")))) ((string=? sw "\\bgcolor") (emit "<font style=\"background-color: ") (let ((color (ungroup (get-group)))) (if (string->number color 16) (emit "#")) (emit color) (emit "\">") (lambda () (emit "</font>")))) ((string=? sw "\\strike") (emit "<strike>") (lambda () (emit "</strike>"))) ((string=? sw "\\narrower") (emit "<blockquote>") (lambda () (emit "</blockquote>"))) (else (terror (quote do-switch) "Unknown switch " sw))))))

(define do-obeylines (lambda () (if (eqv? (snoop-actual-char) #\newline) (get-actual-char)) (tex-def-char #\newline (quote ()) "\\TIIPbr" #f)))

(define do-obeyspaces (lambda () (tex-def-char #\space (quote ()) "\\TIIPnbsp" #f)))

(define do-obeywhitespace (lambda () (do-obeylines) (do-obeyspaces)))

(define do-block (lambda (z) (do-end-para) (emit "<div ") (cond ((string=? z "\\center") (emit "align=center")) ((string=? z "\\flushleft") (emit "align=left")) ((string=? z "\\flushright") (emit "align=right"))) (emit ">") (set! *tabular-stack* (cons (quote block) *tabular-stack*)) (emit "<table><tr><td>") (bgroup) (emit-newline)))

(define do-end-block (lambda () (do-end-para) (egroup) (emit "</td></tr></table></div>") (set! *tabular-stack* (cdr *tabular-stack*)) (emit-newline)))

(define do-function (lambda (fn) (cond ((string=? fn "\\emph") (emit "<em>")) ((string=? fn "\\leftline") (do-end-para) (emit "<div align=left>")) ((string=? fn "\\centerline") (do-end-para) (emit "<div align=center>&nbsp;")) ((string=? fn "\\rightline") (do-end-para) (emit "<div align=right>&nbsp;")) ((string=? fn "\\underline") (emit "<u>")) ((string=? fn "\\textbf") (emit "<b>")) ((ormap (lambda (z) (string=? fn z)) (quote ("\\textit" "\\textsl"))) (emit "<i>")) ((string=? fn "\\texttt") (emit "<tt>")) (else (terror (quote do-function) "Unknown function " fn))) (bgroup) (tex2page-string (get-token)) (egroup) (cond ((string=? fn "\\emph") (emit "</em>")) ((string=? fn "\\rightline") (emit "</div>") (emit-newline)) ((ormap (lambda (z) (string=? fn z)) (quote ("\\leftline" "\\centerline"))) (do-end-para) (emit "&nbsp;</div>") (emit-newline)) ((string=? fn "\\underline") (emit "</u>")) ((string=? fn "\\textbf") (emit "</b>")) ((ormap (lambda (z) (string=? fn z)) (quote ("\\textsl" "\\textit"))) (emit "</i>")) ((string=? fn "\\texttt") (emit "</tt>")))))

(define do-discretionary (lambda () (tex2page-string (get-group)) (get-group) (get-group)))

(define do-aftergroup (lambda () (ignorespaces) (let ((z (get-ctl-seq))) (add-aftergroup-to-top-frame (lambda () (toss-back-string z))))))

(define do-space (lambda () (emit #\space)))

(define do-tab (lambda () (emit-nbsp 8)))

(define emit-nbsp (lambda (n) (let loop ((n n)) (unless (<= n 0) (emit "&nbsp;") (loop (- n 1))))))

(define do-hskip (lambda () (let* ((len (get-dimen)) (qty (car len)) (the-unit (cadr len))) (case the-unit ((pt) (emit-nbsp (/ qty 5))) ((em) (emit-nbsp (* 2 qty))) ((in) (emit-nbsp (* 72.27 0.5 qty))) (else (emit-nbsp 3))))))

(define do-newline (lambda () (when (>= (munch-newlines) 1) (do-para)) (emit-newline)))

(define do-br (lambda () (if (find-chardef #\space) (emit "<br>") (unless (eqv? (snoop-actual-char) #\newline) (emit "<br>"))) (emit-newline)))

(define do-sup (lambda () (emit "<sup>") (fluid-let ((*math-script-mode?* #t)) (tex2page-string (get-token))) (emit "</sup>")))

(define do-sub (lambda () (emit "<sub>") (fluid-let ((*math-script-mode?* #t)) (tex2page-string (get-token))) (emit "</sub>")))

(define do-hyphen (lambda () (cond (*math-mode?* (emit (cond (*math-roman-mode?* "-") (*math-script-mode?* "<tt>-</tt>") (else " <tt>-</tt> ")))) ((not *ligatures?*) (emit #\-)) (else (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\-)) (begin (get-actual-char) (do-ndash)) (emit #\-)))))))

(define do-ndash (lambda () (emit (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\-)) (begin (get-actual-char) *html-mdash*) *html-ndash*)))))

(define do-lsquo (lambda () (emit (if (not *ligatures?*) *html-lsquo* (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\`)) (begin (get-actual-char) *html-ldquo*) *html-lsquo*))))))

(define do-rsquo (lambda () (emit (if (not *ligatures?*) *html-rsquo* (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\')) (begin (get-actual-char) *html-rdquo*) *html-rsquo*))))))

(define htmlize-label (lambda (lbl) (let* ((lbl (string-trim-blanks lbl)) (n (string-length lbl))) (let loop ((i (- n 1)) (space? #f) (r (quote ()))) (if (< i 0) (list->string r) (let ((c (string-ref lbl i))) (cond ((char-whitespace? c) (loop (- i 1) #t (if space? r (cons #\_ r)))) ((char=? c #\?) (loop (- i 1) #f (quasiquote (#\_ #\Q #\_ (unquote-splicing r))))) ((char=? c #\:) (loop (- i 1) #f (quasiquote (#\_ #\C #\_ (unquote-splicing r))))) ((char=? c #\;) (loop (- i 1) #f (quasiquote (#\_ #\S #\_ (unquote-splicing r))))) ((char=? c #\#) (loop (- i 1) #f (quasiquote (#\_ #\H #\_ (unquote-splicing r))))) ((char=? c #\_) (loop (- i 1) #f (quasiquote (#\_ #\U #\_ (unquote-splicing r))))) (else (loop (- i 1) #f (cons c r))))))))))

(define get-label (lambda () (htmlize-label (ungroup (get-group)))))

(define emit-anchor (lambda (lbl) (emit "<a name=\"") (emit lbl) (emit "\"></a>")))

(define emit-link-start (lambda (link) (emit "<a href=\"") (emit link) (emit "\">")))

(define emit-ext-page-node-link-start (lambda (extfile pageno node) (emit "<a href=\"") (unless (and (not extfile) (or (not pageno) (= *html-page-count* pageno))) (emit (or extfile *jobname*)) (unless (= pageno 0) (emit *html-page-suffix*) (emit pageno)) (emit *output-extn*)) (when node (emit "#") (emit node)) (emit "\">")))

(define emit-page-node-link-start (lambda (pageno node) (emit-ext-page-node-link-start #f pageno node)))

(define emit-node-link-start (lambda (node) (emit-ext-page-node-link-start #f #f node)))

(define emit-link-stop (lambda () (emit "</a>")))

(define do-label (lambda () (do-label-aux (get-label))))

(define do-node (lambda () (set! *recent-node-name* (get-label))))

(define do-label-aux (lambda (label) (let ((label-name (get-toks "\\TIIPrecentlabelname")) (label-value (get-toks "\\TIIPrecentlabelvalue"))) (!label label *html-page-count* label-name label-value) (write-label (quasiquote (!label (unquote label) (unquote *html-page-count*) (unquote label-name) (unquote label-value)))))))

(define do-input-external-labels (lambda () (let* ((f (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\{)) (ungroup (get-group)) (get-filename)))) (fq-f (if (fully-qualified-pathname? f) f (string-append *aux-dir/* f))) (ext-label-file (string-append fq-f *label-file-suffix* ".scm")) (ext-label-table (table-get *external-label-tables* f))) (unless ext-label-table (set! ext-label-table (make-table (quote equ) string=?)) (table-put! *external-label-tables* f ext-label-table)) (when (file-exists? ext-label-file) (fluid-let ((*label-table* ext-label-table)) (load-tex2page-data-file ext-label-file))))))

(define !external-labels (lambda (f) #f))

(define do-tag (lambda () (let ((tag-name (get-label))) (do-tag-aux tag-name (get-group)))))

(define do-tag-aux (lambda (tag-name tag-val) (tex-def-toks "\\TIIPrecentlabelname" tag-name #f) (tex-def-toks "\\TIIPrecentlabelvalue" tag-val #f) (emit-anchor tag-name) (do-label-aux tag-name)))

(define do-html-page-label (lambda () (let ((label (get-label))) (!label label *html-page-count* #f #f) (write-label (quasiquote (!label (unquote label) (unquote *html-page-count*) #f #f))))))

(define do-ref (lambda () (do-ref-aux (get-label) #f #f)))

(define do-ref-external (lambda () (let ((ext-file (string-trim-blanks (ungroup (get-group))))) (do-ref-aux (get-label) ext-file #f))))

(define do-ref-aux (lambda (label ext-file link-text) (let* ((label-table (if ext-file (table-get *external-label-tables* ext-file) *label-table*)) (label-vec (label-bound? label label-table)) (label-text (cond (link-text (tex-string->html-string link-text)) (label-vec (tex-string->html-string (vector-ref label-vec 2))) (else label)))) (if label-vec (emit-ext-page-node-link-start ext-file (vector-ref label-vec 0) (vector-ref label-vec 1)) (emit-link-start (string-append *jobname* ".hlog"))) (emit label-text) (emit-link-stop))))

(define maybe-label-page (lambda (label-pageno) (if (= *html-page-count* label-pageno) "#" (string-append *jobname* (if (= label-pageno 0) "" (string-append *html-page-suffix* (number->string label-pageno))) *output-extn*))))

(define hyperize-text (lambda (text label-ref) (when label-ref (emit-page-node-link-start (vector-ref label-ref 0) (vector-ref label-ref 1))) (tex2page-string text) (unless label-ref (non-fatal-error "***")) (when label-ref (emit-link-stop))))

(quote (define do-htmlref (lambda () (let* ((text (get-group)) (lbl (get-label)) (label-ref (label-bound? lbl))) (hyperize-text text label-ref)))))

(define do-htmlref (lambda () (let* ((text (get-group)) (lbl (get-label))) (do-ref-aux lbl #f text))))

(define do-htmlref-external (lambda () (let* ((text (get-group)) (extf (string-trim-blanks (ungroup (get-group)))) (lbl (get-label))) (do-ref-aux lbl extf text))))

(quote (define do-hyperref (lambda () (let* ((text (get-group)) (lbl (begin (get-group) (get-group) (get-label))) (label-ref (label-bound? lbl))) (hyperize-text text label-ref)))))

(define do-hyperref (lambda () (let* ((text (get-group)) (lbl (begin (get-group) (get-group) (get-label)))) (do-ref-aux lbl #f text))))

(define label-bound? (lambda (label label-table) (and label-table (let ((label-ref (table-get label-table label))) (or label-ref (begin (flag-unresolved-xref label) #f))))))

(define flag-unresolved-xref (lambda (xr) (unless (member xr *unresolved-xrefs*) (set! *unresolved-xrefs* (cons xr *unresolved-xrefs*)))))

(define flag-missing-piece (lambda (mp) (unless (member mp *missing-pieces*) (set! *missing-pieces* (cons mp *missing-pieces*)))))

(define show-unresolved-xrefs-and-missing-pieces (lambda () (unless (and (null? *unresolved-xrefs*) (null? *missing-pieces*)) (show-unresolved-xrefs) (show-missing-pieces) (write-log #\newline) (write-log "Rerun: tex2page ") (write-log *main-tex-file*) (write-log #\newline) (write-log "If problem persists, check for ") (write-log "missing \\label's and \\bibitem's"))))

(define show-unresolved-xrefs (lambda () (unless (null? *unresolved-xrefs*) (write-log #\newline) (write-log "Unresolved cross-reference") (if (> (length *unresolved-xrefs*) 1) (write-log "s")) (write-log ": ") (set! *unresolved-xrefs* (sort! *unresolved-xrefs* string-ci<?)) (write-log (car *unresolved-xrefs*)) (for-each (lambda (x) (write-log #\,) (write-log #\space) (write-log x)) (cdr *unresolved-xrefs*)) (write-log #\newline))))

(define show-missing-pieces (lambda () (unless (null? *missing-pieces*) (write-log #\newline) (when (memv (quote document-title) *missing-pieces*) (write-log "Document title not determined") (write-log #\newline)) (when (memv (quote last-modification-time) *missing-pieces*) (write-log "Last modification time not determined") (write-log #\newline)) (when (memv (quote stylesheets) *missing-pieces*) (write-log "Style sheets not determined") (write-log #\newline)) (when (memv (quote html-head) *missing-pieces*) (write-log "HTML header info not determined") (write-log #\newline)) (when (memv (quote toc) *missing-pieces*) (write-log "Table of contents not generated") (write-log #\newline)) (when (memv (quote index) *missing-pieces*) (write-log "Index not generated") (write-log #\newline)) (when (memv (quote bibliography) *missing-pieces*) (write-log "Bibliography not generated") (write-log #\newline)))))

(define do-pageref (lambda () (let ((label-ref (label-bound? (get-label) *label-table*))) (if label-ref (let ((pageno (vector-ref label-ref 0))) (emit-page-node-link-start pageno #f) (emit pageno) (emit-link-stop)) (non-fatal-error "***")))))

(define do-html-page-ref (lambda () (let ((label (get-label))) (let ((label-ref (label-bound? label *label-table*))) (emit "\"") (if label-ref (emit (maybe-label-page (vector-ref label-ref 0))) (emit *log-file*)) (emit "\"")))))

(define fully-qualify-url (lambda (url) (let ((n (string-length url))) (cond ((and (> n 0) (char=? (string-ref url 0) #\#)) (let* ((label (substring url 1 n)) (label-vec (label-bound? label *label-table*))) (if label-vec (string-append (maybe-label-page (vector-ref label-vec 0)) "#" (vector-ref label-vec 1)) url))) ((fully-qualified-url? url) url) (else (ensure-url-reachable url) url)))))

(define do-url (lambda () (let ((url (get-url))) (emit-link-start (fully-qualify-url url)) (emit url) (emit-link-stop))))

(define do-mailto (lambda () (let ((addr (get-url))) (emit-link-start (string-append "mailto:" addr)) (emit addr) (emit-link-stop))))

(define do-urlh (lambda () (emit-link-start (fully-qualify-url (get-url))) (fluid-let ((*doing-urlh?* #t)) (tex2page-string (get-token))) (emit-link-stop)))

(define do-urlhd (lambda () (do-urlh) (get-token)))

(define do-urlp (lambda () (let ((link-text (get-token))) (emit-link-start (fully-qualify-url (get-url))) (tex2page-string link-text) (emit-link-stop))))

(define do-htmladdimg (lambda () (let ((align-info (get-bracketed-text-if-any))) (emit "<img src=\"") (emit (fully-qualify-url (get-url))) (emit "\" border=\"0\" ") (when align-info (tex2page-string align-info)) (emit ">"))))

(define do-cite (lambda () (let ((extra-text (get-bracketed-text-if-any))) (emit "[") (ignorespaces) (unless (char=? (get-actual-char) #\{) (terror (quote do-cite) "Missing {")) (let ((first-key? #t)) (let loop () (cond ((get-csv) => (lambda (key) (if first-key? (set! first-key? #f) (begin (emit ",") (emit-nbsp 1))) (write-bib-aux "\\citation{") (write-bib-aux key) (write-bib-aux "}") (write-bib-aux #\newline) (do-ref-aux (string-append "cite{" (htmlize-label key) "}") #f #f) (loop))) (extra-text (emit ",") (emit-nbsp 1) (tex2page-string extra-text)))) (unless (char=? (get-actual-char) #\}) (terror (quote do-cite) "Missing }")) (if first-key? (terror (quote do-cite) "Empty \\cite"))) (emit "]"))))

(define do-nocite (lambda () (ignorespaces) (unless (char=? (get-actual-char) #\{) (terror (quote do-cite) "Missing {")) (let loop () (cond ((get-csv) => (lambda (key) (write-bib-aux "\\citation{") (write-bib-aux key) (write-bib-aux "}") (write-bib-aux #\newline) (loop))))) (unless (char=? (get-actual-char) #\}) (terror (quote do-nocite) "Missing }"))))

(define do-bibliographystyle (lambda () (let ((s (ungroup (get-token)))) (write-bib-aux "\\bibstyle{") (write-bib-aux s) (write-bib-aux "}") (write-bib-aux #\newline))))

(define do-bibliography (lambda () (let ((bibdata (ungroup (get-token))) (bbl-file (string-append *aux-dir/* *jobname* *bib-aux-file-suffix* ".bbl"))) (write-bib-aux "\\bibdata{") (write-bib-aux bibdata) (write-bib-aux "}") (write-bib-aux #\newline) (write-aux (quasiquote (!using-external-program "bibtex"))) (unless (file-exists? bbl-file) (flag-missing-piece (quote bibliography)) (non-fatal-error "Bibliography not generated; rerun TeX2page")) (set! *bibitem-num* 0) (tex2page-file bbl-file) (emit-newline))))

(define do-thebibliography (lambda () (get-group) (when (eqv? *tex-format* (quote latex)) (tex2page-string (if *using-chapters?* "\\chapter*{Bibliography}" "\\section*{References}"))) (set! *bibitem-num* 0) (tex2page-string "\\let\\em\\it") (tex2page-string "\\def\\newblock{ }") (tex2page-string "\\def\\providecommand#1#2{}") (do-end-para) (emit "<table>") (emit-newline)))

(define do-bibitem (lambda () (let ((label-value (get-bracketed-text-if-any))) (do-end-para) (unless (= *bibitem-num* 0) (emit "</td></tr>") (emit-newline)) (set! *bibitem-num* (+ *bibitem-num* 1)) (unless label-value (set! label-value (number->string *bibitem-num*))) (tex-def-toks "\\TIIPrecentlabelvalue" label-value #f) (emit "<tr><td align=right valign=top>") (let ((key (string-append "cite{" (get-label) "}"))) (tex-def-toks "\\TIIPrecentlabelname" key #f) (emit-anchor key) (emit "[") (tex2page-string label-value) (emit "]") (emit-nbsp 2) (do-label-aux key) (emit "</td><td>") (do-para)))))

(define display-index-entry (lambda (s o) (for-each (lambda (c) (display (if (or (char=? c *return*) (char=? c #\newline)) #\space c) o)) (string->list s))))

(define do-index (lambda () (let ((idx-entry (ungroup (get-group)))) (unless (substring? "|)" idx-entry) (set! *index-count* (+ *index-count* 2)) (set! *index-alist* (cons (cons *index-count* *html-page-count*) *index-alist*)) (let ((tag (string-append "%_idx_" (number->string *index-count*)))) (emit-anchor tag) (unless *index-port* (let ((idx-file (string-append *aux-dir/* *jobname* *index-file-suffix* ".idx"))) (ensure-file-deleted idx-file) (set! *index-port* (open-output-file idx-file)))) (display "\\indexentry{" *index-port*) (cond ((substring? "|see{" idx-entry) (display-index-entry idx-entry *index-port*)) ((substring? "|seealso{" idx-entry) (display-index-entry idx-entry *index-port*)) ((substring? "|(" idx-entry) => (lambda (i) (display-index-entry (substring idx-entry 0 i) *index-port*) (display "|expandhtmlindex" *index-port*))) (else (display-index-entry idx-entry *index-port*) (display "|expandhtmlindex" *index-port*))) (display "}{" *index-port*) (display *index-count* *index-port*) (display "}" *index-port*) (newline *index-port*))))))

(define do-input-index (lambda (insert-heading?) (when insert-heading? (tex2page-string (if *using-chapters?* "\\chapter*{Index}" "\\section*{Index}")) (emit-newline)) (emit-anchor "%_index_start") (!index-page *html-page-count*) (write-aux (quasiquote (!index-page (unquote *html-page-count*)))) (let ((ind-file (string-append *aux-dir/* *jobname* *index-file-suffix* ".ind"))) (write-aux (quasiquote (!using-external-program "makeindex"))) (unless (file-exists? ind-file) (flag-missing-piece (quote index)) (non-fatal-error "Index not generated; rerun TeX2page")) (bgroup) (tex2page-string "\\let\\indexspace\\par") (tex2page-string "\\let\\item\\indexitem") (tex2page-string "\\let\\subitem\\indexsubitem") (tex2page-string "\\let\\subsubitem\\indexsubsubitem") (tex2page-string "\\let\\(\\expandhtmlindex") (tex2page-file ind-file) (egroup))))

(define *remember-index-number* #f)

(define expand-html-index (lambda (item) (ignorespaces) (unless (char=? (get-actual-char) #\{) (terror (quote expand-tex-macro) "Missing {")) (let ((first-link? #t)) (let loop ((i (if item 1 *remember-index-number*))) (cond ((get-csv) => (lambda (s) (let* ((n (string->number s)) (pageno (assv n *index-alist*))) (cond (pageno (if first-link? (set! first-link? #f) (emit ", ")) (emit-page-node-link-start (cdr pageno) (string-append "%_idx_" s)) (if item (tex2page-string item) (begin (emit "[") (emit i) (emit "]"))) (emit-link-stop)) (else (trace-if #t "Bad index entry around " item))) (loop (+ i 1))))) (else (set! *remember-index-number* i))))) (unless (char=? (get-actual-char) #\}) (terror (quote expand-html-index) "Missing }")) (ignorespaces)))

(define do-see-also (lambda () (let* ((other-entry (get-group)) (discard (get-group))) (emit "<em>see also</em> ") (tex2page-string other-entry))))

(define do-index-item (lambda (z) (emit "<br>") (emit-newline) (cond ((string=? z "\\indexsubitem") (emit-nbsp 4)) ((string=? z "\\indexsubsubitem") (emit-nbsp 8))) (let loop ((s (quote ())) (brace-nesting 0)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (tex2page-string (list->string (reverse! s)))) ((and (= brace-nesting 0) (char=? c *esc-char*)) (let ((x (get-ctl-seq))) (cond ((or (string=? x "\\subitem") (string=? x "\\subsubitem")) (tex2page-string (list->string (reverse! s))) (toss-back-char #\space) (toss-back-string x)) (else (let ((xr (reverse! (string->list x)))) (loop (if (char-alphabetic? (car xr)) (cons #\space (append xr s)) (append xr s)) brace-nesting)))))) ((char=? c #\,) (get-actual-char) (if (char-whitespace? (snoop-actual-char)) (begin (ignore-all-whitespace) (if (char=? (snoop-actual-char) *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x "\\expandhtmlindex") (expand-html-index (list->string (reverse! s)))) ((string=? x "\\see") (tex2page-string (list->string (reverse! s))) (emit ", <em>see</em> ") (tex2page-string (get-group)) (get-group)) ((string=? x "\\seealso") (tex2page-string (list->string (reverse! s))) (emit ", <em>see also</em> ") (tex2page-string (get-group)) (get-group)) (else (toss-back-char #\space) (toss-back-string x) (toss-back-char #\space) (loop (cons #\space (cons #\, s)) brace-nesting)))) (loop (cons #\space (cons #\, s)) brace-nesting))) (loop (cons #\, s) brace-nesting))) (else (get-actual-char) (loop (cons c s) (cond ((char=? c #\{) (+ brace-nesting 1)) ((char=? c #\}) (- brace-nesting 1)) (else brace-nesting)))))))))

(define do-description-item (lambda () (do-end-para) (emit "</dd><dt>") (let ((thing (get-bracketed-text-if-any))) (when thing (set! thing (string-trim-blanks thing)) (unless (string=? thing "") (bgroup) (emit "<b>") (tex2page-string thing) (emit "</b>") (egroup)))) (emit "</dt><dd>")))

(define do-regular-item (lambda () (do-end-para) (emit "<li>") (do-para) (let ((thing (get-bracketed-text-if-any))) (when thing (emit "<b>") (bgroup) (tex2page-string thing) (egroup) (emit "</b>") (emit-nbsp 2)))))

(define do-item (lambda () ((if (eqv? (car *tabular-stack*) (quote description)) do-description-item do-regular-item))))

(define do-bigskip (lambda (type) (do-para) (when (ormap (lambda (z) (string=? type z)) (quote ("\\bigskip" "\\bigbreak"))) (emit "<br>") (do-para) (emit "<br>")) (do-para)))

(define do-hspace (lambda () (ignorespaces) (if (eqv? (snoop-actual-char) #\*) (get-actual-char)) (get-group) (emit-nbsp 3)))

(define do-vspace (lambda () (ignorespaces) (if (eqv? (snoop-actual-char) #\*) (get-actual-char)) (get-group) (do-bigskip "vspace")))

(define output-colophon (lambda () (do-end-para) (emit "<div class=smallprint>") (emit-newline) (when (and *timestamp?* *last-modification-time* (> *last-modification-time* 0)) (emit "Last modified: ") (emit (seconds->human-time *last-modification-time*)) (emit "<br>") (emit-newline)) (emit "HTML conversion by ") (when *self-promote?* (emit-link-start "http://www.ccs.neu.edu/~dorai/tex2page/tex2page-doc.html")) (emit "TeX2page ") (emit *tex2page-version*) (when *self-promote?* (emit-link-stop)) (emit "</div>") (emit-newline)))

(define output-navigation-bar (lambda () (let* ((first-page? (= *html-page-count* 0)) (last-page? (= *html-page-count* *last-page-number*)) (toc-page? (and *toc-page* (= *html-page-count* *toc-page*))) (index-page? (and *index-page* (= *html-page-count* *index-page*))) (first-page (string-append *jobname* *output-extn*)) (prev-page (cond (first-page? #f) ((= *html-page-count* 1) first-page) (else (string-append *jobname* *html-page-suffix* (number->string (- *html-page-count* 1)) *output-extn*)))) (next-page (cond (last-page? #f) (else (string-append *jobname* *html-page-suffix* (number->string (+ *html-page-count* 1)) *output-extn*))))) (unless (and first-page? last-page?) (do-end-para) (emit "<div class=navigation>[Go to ") (emit "<span") (when first-page? (emit " class=disable")) (emit ">") (unless first-page? (emit-link-start first-page)) (emit "first") (unless first-page? (emit-link-stop)) (emit ", ") (unless first-page? (emit-link-start prev-page)) (emit "previous") (unless first-page? (emit-link-stop)) (emit "</span>") (emit "<span") (when last-page? (emit " class=disable")) (emit ">") (when first-page? (emit "<span class=disable>")) (emit ", ") (when first-page? (emit "</span>")) (unless last-page? (emit-link-start next-page)) (emit "next") (unless last-page? (emit-link-stop)) (emit "</span>") (emit " page") (when (or *toc-page* *index-page*) (emit "<span") (when (or (and toc-page? (not *index-page*) (not index-page?)) (and index-page? (not *toc-page*) (not toc-page?))) (emit " class=disable")) (emit ">; ") (emit-nbsp 2) (emit "</span>") (when *toc-page* (emit "<span") (when toc-page? (emit " class=disable")) (emit ">") (unless toc-page? (emit-page-node-link-start *toc-page* "%_toc_start")) (emit "contents") (unless toc-page? (emit-link-stop)) (emit "</span>")) (when *index-page* (emit "<span") (when index-page? (emit " class=disable")) (emit ">") (emit "<span") (unless (and *toc-page* (not toc-page?)) (emit " class=disable")) (emit ">") (when *toc-page* (emit "; ") (emit-nbsp 2)) (emit "</span>") (unless index-page? (emit-page-node-link-start *index-page* "%_index_start")) (emit "index") (unless index-page? (emit-link-stop)) (emit "</span>"))) (emit "]</div>") (do-para)))))

(define do-eject (lambda () (unless (and (eof-object? (snoop-actual-char)) (eqv? *current-tex-file* *main-tex-file*)) (unless (> *last-page-number* 0) (flag-missing-piece (quote last-modification-time))) (do-end-page) (set! *html-page-count* (+ *html-page-count* 1)) (set! *html-page* (string-append *aux-dir/* *jobname* *html-page-suffix* (number->string *html-page-count*) *output-extn*)) (ensure-file-deleted *html-page*) (set! *html* (open-output-file *html-page*)) (do-start))))

(define output-html-preamble (lambda (top-level-page?) (emit "<!doctype html public ") (emit "\"-//W3C//DTD HTML 4.0 Transitional//EN\" ") (emit "\"http://www.w3.org/TR/REC-html40/loose.dtd\">") (emit-newline) (emit "<html>") (emit-newline) (emit "<!--") (emit-newline) (emit-newline) (emit-newline) (emit "Generated from TeX source by tex2page, ") (emit "v ") (emit *tex2page-version*) (emit-newline) (emit "(running on ") (emit *scheme-version*) (emit ", ") (emit *operating-system*) (emit "), ") (emit-newline) (emit "(c) Dorai Sitaram, ") (emit-newline) (emit *tex2page-website*) (emit-newline) (emit-newline) (emit-newline) (emit "-->") (emit-newline) (emit "<head>") (emit-newline) (output-external-title) (for-each link-stylesheet *stylesheets*) (emit "<meta name=robots content=\"") (unless (and top-level-page? (= *html-page-count* 0)) (emit "no")) (emit "index,follow\">") (emit-newline) (for-each emit *html-head*) (emit "</head>") (emit-newline) (emit "<body") (if (null? *stylesheets*) (emit " bgcolor=#ffffff text=#000000")) (emit ">") (emit-newline)))

(define output-html-postamble (lambda () (emit "</body>") (emit-newline) (emit "</html>") (emit-newline)))

(define do-start (lambda () (set! *footnote-list* (quote ())) (output-html-preamble #t) (unless (= *html-page-count* 0) (output-navigation-bar))))

(define do-end-page (lambda () (output-footnotes) (output-navigation-bar) (when (= *html-page-count* 0) (output-colophon)) (do-end-para) (output-html-postamble) (write-log #\space) (write-log #\[) (write-log *html-page-count*) (write-log #\]) (close-output-port *html*)))

(define do-bye (lambda () (unless (null? *tex-if-stack*) (terror (quote do-bye) "Incomplete \\if")) (unless (null? *tex-env*) (trace-if #t "\\end occurred inside a group at level " (length *tex-env*))) (perform-postludes) (set! *last-page-number* *html-page-count*) (write-aux (quasiquote (!last-page-number (unquote *last-page-number*)))) (do-end-page) (if *last-modification-time* (write-aux (quasiquote (!last-modification-time (unquote *last-modification-time*))))) (if *aux-port* (close-output-port *aux-port*)) (if *css-port* (close-output-port *css-port*)) (if *index-port* (close-output-port *index-port*)) (if *label-port* (close-output-port *label-port*)) (if *scm-port* (close-output-port *scm-port*)) (if *tex-aux-port* (close-output-port *tex-aux-port*)) (if *verb-port* (close-output-port *verb-port*)) (show-unresolved-xrefs-and-missing-pieces) (let ((num-pages (+ *html-page-count* 1))) (write-log #\newline) (write-log "Output written on ") (write-log (string-append *aux-dir/* *jobname* *output-extn*)) (when (> num-pages 1) (write-log #\,) (write-log #\space) (write-log "...")) (write-log #\space) (write-log #\() (write-log num-pages) (write-log #\space) (write-log "page") (unless (= num-pages 1) (write-log #\s))) (when (> *img-file-tally* 0) (write-log #\,) (write-log #\space) (write-log *img-file-tally*) (write-log #\space) (write-log "image") (unless (= *img-file-tally* 1) (write-log #\s))) (write-log #\)) (write-log #\.) (write-log #\newline) (close-output-port *log-port*)))

(define do-underline (lambda (c) (emit "<u>") (emit c) (emit "</u>")))

(define do-diacritic (lambda (diac) (let* ((x (ungroup (get-token))) (c (if (string=? x "\\i") #\i (case (string-length x) ((0) #\space) ((1) (string-ref x 0)) (else (terror (quote do-diacritic) "`" x "' is not a character")))))) (do-diacritic-aux diac c))))

(define do-diacritic-aux (lambda (diac c) (cond ((and (memv c (quote (#\a #\e #\i #\o #\u #\A #\E #\I #\O #\U))) (ormap (lambda (z) (string=? diac z)) (quote ("acute" "uml" "circ" "grave")))) (emit "&") (emit c) (emit diac) (emit ";")) ((and (memv c (quote (#\a #\n #\o #\A #\N #\O))) (string=? diac "tilde")) (emit "&") (emit c) (emit "tilde;")) ((and (memv c (quote (#\c #\C))) (string=? diac "cedil")) (emit "&") (emit c) (emit "cedil;")) ((char=? c #\space) (emit (cond ((string=? diac "circ") "^") ((string=? diac "tilde") "~") (else "<u>&nbsp;</u>")))) (else (emit "<u>") (emit c) (emit "</u>")))))

(define do-imgless-display-math (lambda () (if *math-mode?* (egroup) (let ((old-in-math? *math-mode?*) (old-in-display-math? *in-display-math?*) (old-tabular-stack *tabular-stack*)) (do-end-para) (emit "<div align=") (emit *display-justification*) (emit "><table><tr><td>") (set! *math-mode?* #t) (set! *in-display-math?* #t) (set! *tabular-stack* (quote ())) (bgroup) (add-postlude-to-top-frame (lambda () (set! *math-mode?* old-in-math?) (set! *in-display-math?* old-in-display-math?) (set! *tabular-stack* old-tabular-stack) (emit "</td></tr></table></div>") (do-para)))))))

(define do-mathdg (lambda () (fluid-let ((*math-mode?* #t) (*in-display-math?* #t) (*tabular-stack* (quote ())) (*ligatures?* #f)) (do-end-para) (emit "<div align=") (emit *display-justification*) (emit "><table><tr><td>") (tex2page-string (get-group)) (emit "</td></tr></table></div>") (do-para))))

(define do-imgless-in-text-math (lambda () (if *math-mode?* (egroup) (let ((old-in-math? *math-mode?*) (old-in-display-math? *in-display-math?*) (old-tabular-stack *tabular-stack*)) (set! *math-mode?* #t) (set! *in-display-math?* #f) (set! *tabular-stack* (quote ())) (bgroup) (add-postlude-to-top-frame (lambda () (set! *math-mode?* old-in-math?) (set! *in-display-math?* old-in-display-math?) (set! *tabular-stack* old-tabular-stack)))))))

(define do-mathg (lambda () (fluid-let ((*math-mode?* #t) (*in-display-math?* #f) (*tabular-stack* (quote ())) (*ligatures?* #f)) (tex2page-string (get-group)))))

(define dump-tex-preamble (lambda (o) (case *tex-format* ((latex) (display "\\documentclass{" o) (display (if *using-chapters?* "report" "article") o) (display "}" o) (newline o) (display *imgpreamble* o) (newline o) (display "\\thispagestyle{empty}" o) (newline o) (display "\\begin{document}" o) (newline o)) (else (display *imgpreamble* o) (newline o) (display "\\nopagenumbers" o) (newline o)))))

(define dump-tex-postamble (lambda (o) (case *tex-format* ((latex) (display "\\end{document}" o) (newline o)) (else (display "\\bye" o) (newline o)))))

(define call-with-image-port (lambda (p) (set! *img-file-count* (+ *img-file-count* 1)) (let* ((img-file-stem (string-append *subjobname* *img-file-suffix* (number->string *img-file-count*))) (aux-tex-file (string-append img-file-stem ".tex"))) (ensure-file-deleted aux-tex-file) (call-with-output-file aux-tex-file (lambda (o) (dump-tex-preamble o) (p o) (dump-tex-postamble o))) (tex-to-img img-file-stem) img-file-stem)))

(define do-img-display-math (lambda () (do-end-para) (emit "<div align=") (emit *display-justification*) (emit ">") (source-img-file (call-with-image-port (lambda (o) (display "$$" o) (dump-till-char #\$ o) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote do-img-display-math))) ((char=? c #\$) #t) (else (terror (quote do-img-display-math))))) (display "$$" o)))) (emit "</div>") (do-para)))

(define do-img-in-text-math (lambda () (source-img-file (call-with-image-port (lambda (o) (display #\$ o) (dump-till-char #\$ o) (display #\$ o))))))

(define do-mathp (lambda () (source-img-file (call-with-image-port (lambda (o) (display #\$ o) (display (get-group) o) (display #\$ o))))))

(define do-latex-in-text-math (lambda () ((if *use-img-for-math?* do-img-latex-in-text-math do-imgless-latex-in-text-math))))

(define do-latex-display-math (lambda () ((if *use-img-for-math?* do-img-latex-display-math do-imgless-latex-display-math))))

(define do-img-latex-in-text-math (lambda () (source-img-file (call-with-image-port (lambda (o) (display #\$ o) (dump-till-ctl-seq "\\)" o) (display #\$ o))))))

(define do-img-latex-display-math (lambda () (do-end-para) (emit "<div align=") (emit *display-justification*) (emit ">") (source-img-file (call-with-image-port (lambda (o) (display "$$" o) (dump-till-ctl-seq "\\]" o) (display "$$" o)))) (emit "</div>") (do-para)))

(define do-imgless-latex-in-text-math (lambda () (let ((old-in-math? *math-mode?*) (old-in-display-math? *in-display-math?*) (old-tabular-stack *tabular-stack*)) (set! *math-mode?* #t) (set! *in-display-math?* #f) (set! *tabular-stack* (quote ())) (bgroup) (add-postlude-to-top-frame (lambda () (set! *math-mode?* old-in-math?) (set! *in-display-math?* old-in-display-math?) (set! *tabular-stack* old-tabular-stack))))))

(define do-imgless-latex-display-math (lambda () (let ((old-in-math? *math-mode?*) (old-in-display-math? *in-display-math?*) (old-tabular-stack *tabular-stack*)) (do-end-para) (emit "<div align=") (emit *display-justification*) (emit "><table><tr><td>") (set! *math-mode?* #t) (set! *in-display-math?* #t) (set! *tabular-stack* (quote ())) (bgroup) (add-postlude-to-top-frame (lambda () (set! *math-mode?* old-in-math?) (set! *in-display-math?* old-in-display-math?) (set! *tabular-stack* old-tabular-stack) (emit "</td></tr></table></div>") (do-para))))))

(define do-math (lambda () (let ((display? #f)) (when (eqv? (snoop-actual-char) #\$) (set! display? #t) (get-actual-char)) ((if *use-img-for-math?* (if display? (if *use-img-for-display-math?* do-img-display-math do-imgless-display-math) (if *use-img-for-in-text-math?* do-img-in-text-math do-imgless-in-text-math)) (if display? do-imgless-display-math do-imgless-in-text-math))))))

(define dump-till-char (lambda (d o) (let loop ((nesting 0) (escape? #f)) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote dump-till-char))) ((and (char=? c d) (= nesting 0)) #t) (else (display c o) (cond (escape? (loop nesting #f)) ((char=? c #\{) (loop (+ nesting 1) #f)) ((char=? c #\}) (loop (- nesting 1) #f)) ((char=? c #\\) (loop nesting #t)) (else (loop nesting #f)))))))))

(define dump-till-ctl-seq (lambda (cs o) (fluid-let ((*not-processing?* #t)) (let loop ((nesting 0)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote dump-till-ctl-seq))) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (if (string=? x cs) #t (begin (display x o) (loop nesting))))) (else (display (get-actual-char) o) (cond ((char=? c #\{) (loop (+ nesting 1))) ((char=? c #\}) (loop (- nesting 1))) (else (loop nesting))))))))))

(define dump-till-end-env (lambda (env o) (let* ((endenv (string-append "\\end" env)) (endenv-prim (find-corresp-prim endenv)) (endenv-prim-th (find-corresp-prim-thunk endenv))) (fluid-let ((*not-processing?* #t)) (let loop ((brace-nesting 0) (env-nesting 0)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote dump-till-end-env) env)) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? (find-corresp-prim x) endenv-prim) #t) ((string=? x "\\begin") (display x o) (let ((g (get-grouped-environment-name-if-any))) (when g (display #\{ o) (display g o) (display #\} o)) (loop brace-nesting (if (and g (string=? g env)) (+ env-nesting 1) env-nesting)))) ((string=? x "\\end") (let ((g (get-grouped-environment-name-if-any))) (unless (and g (= env-nesting 0) (let ((endg (string-append "\\end" g))) (or (string=? (find-corresp-prim endg) endenv-prim) (eqv? (find-corresp-prim-thunk endg) endenv-prim-th)))) (display x o) (when g (display #\{ o) (display g o) (display #\} o)) (loop brace-nesting (if (and g (string=? g env)) (- env-nesting 1) env-nesting))))) (else (display x o) (loop brace-nesting env-nesting))))) ((char=? c *comment-char*) (do-comment) (loop brace-nesting env-nesting)) (else (display (get-actual-char) o) (cond ((char=? c #\{) (loop (+ brace-nesting 1) env-nesting)) ((char=? c #\}) (loop (- brace-nesting 1) env-nesting)) (else (loop brace-nesting env-nesting)))))))))))

(define dump-imgdef (lambda (f) (let ((aux-tex-file (string-append f ".tex"))) (ensure-file-deleted aux-tex-file) (call-with-output-file aux-tex-file (lambda (o) (dump-tex-preamble o) (display (ungroup (get-group)) o) (dump-tex-postamble o))))))

(define do-imgpreamble (lambda () (set! *imgpreamble* (fluid-let ((*not-processing?* #t)) (let loop ((r *imgpreamble*)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-imgpreamble) "Missing \\endimgpreamble")) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((ormap (lambda (z) (string=? x z)) (quote ("\\endimgpreamble" "\\endgifpreamble" "\\endmathpreamble"))) r) (else (loop (string-append r x)))))) (else (get-actual-char) (loop (string-append r (string c)))))))))))

(define do-unknown-if (lambda () (set! *tex-if-stack* (cons (quote ?) *tex-if-stack*))))

(define do-iffalse (lambda () (set! *tex-if-stack* (cons #f *tex-if-stack*))))

(define do-iftrue (lambda () (set! *tex-if-stack* (cons #t *tex-if-stack*))))

(define do-ifx (lambda () (let* ((one (get-raw-token/is)) (two (get-raw-token/is))) ((if (string=? one two) do-iftrue (begin (when (ctl-seq? one) (set! one (cond ((find-def one) => caddr) ((find-math-def one) => (lambda (x) x)) (else (quote undefined))))) (when (ctl-seq? two) (set! two (cond ((find-def two) => caddr) ((find-math-def two) => (lambda (x) x)) (else (quote undefined))))) (if (eqv? one two) do-iftrue do-iffalse)))))))

(define do-if-get-atomic (lambda () (let loop () (let ((x (get-raw-token/is))) (if (ctl-seq? x) (let ((z (resolve-defs x))) (cond ((not (eq? z x)) (toss-back-char *invisible-space*) (toss-back-string z) (loop)) (else x))) x)))))

(define do-if (lambda () (let* ((one (do-if-get-atomic)) (two (do-if-get-atomic))) ((if (or (string=? one two) (and (ctl-seq? one) (ctl-seq? two))) do-iftrue do-iffalse)))))

(define do-ifmmode (lambda () (set! *tex-if-stack* (cons *math-mode?* *tex-if-stack*))))

(define do-ifnum (lambda () (let* ((one (get-number)) (rel (string-ref (get-raw-token/is) 0)) (two (get-number))) ((if ((case rel ((#\<) <) ((#\=) =) ((#\>) >) (else (terror (quote do-ifnum) "Missing relation for \\ifnum"))) one two) do-iftrue do-iffalse)))))

(define do-ifodd (lambda () ((if (odd? (get-number)) do-iftrue do-iffalse))))

(define do-else (lambda () (when (null? *tex-if-stack*) (terror (quote do-else) "Extra \\else")) (let ((top-if (car *tex-if-stack*))) (set-car! *tex-if-stack* (not top-if)))))

(define do-fi (lambda () (when (null? *tex-if-stack*) (terror (quote do-fi) "Extra \\fi")) (set! *tex-if-stack* (cdr *tex-if-stack*))))

(define do-newif (lambda () (let* ((iffoo (get-ctl-seq)) (init-val #f) (foo (string-append "\\" (substring iffoo 3 (string-length iffoo)))) (foo-register (string-append foo "BOOLEANREGISTER"))) (tex-def-count foo-register 0 #f) (tex-def-thunk iffoo (lambda () (set! *tex-if-stack* (cons (> (the-count foo-register) 0) *tex-if-stack*))) #f) (tex-def-thunk (string-append foo "true") (lambda () (tex-def-count foo-register 1 #f)) #f) (tex-def-thunk (string-append foo "false") (lambda () (tex-def-count foo-register 0 #f)) #f))))

(define do-htmlimg (lambda (env) (source-img-file (call-with-image-port (lambda (o) (dump-till-end-env env o))))))

(define find-img-file-extn (lambda () (case *img-format* ((gif) ".gif") ((png) ".png") ((jpeg) ".jpeg") (else (set! *img-format* (quote gif)) ".gif"))))

(define do-html-img-format (lambda () (set! *img-format* (string->symbol (ungroup (get-group)))) (set! *img-file-extn* (find-img-file-extn))))

(define do-html-img-magnification (lambda () (set! *img-magnification* (string->number (ungroup (get-group))))))

(define call-tex (lambda (f) (let ((dvifile (string-append f ".dvi")) (call-to-tex (string-append (if (eq? *tex-format* (quote latex)) "la" "") "tex " f *bye-tex*))) (system call-to-tex) (and (file-exists? dvifile) (let ((logfile (string-append f ".log"))) (or (not (file-exists? logfile)) (let ((i (open-input-file logfile))) (let loop () (let ((x (read-line i))) (cond ((eof-object? x) (close-input-port i) #t) ((substring? "! I can't find file" x) #f) ((substring? "MFpic: Don't forget to process " x) (system (string-append *metapost* " " *jobname* *img-file-suffix* (number->string *img-file-count*) "-M")) (close-input-port i) (system call-to-tex) #t) (else (loop))))))))))))

(define *ghostscript-options* " -q -dBATCH -dNOPAUSE -dNO_PAUSE")

(define ps-to-img/gif (lambda (ps-file f) (system (string-append *ghostscript* *ghostscript-options* " -sDEVICE=ppmraw -sOutputFile=" f ".ppm.1 " ps-file " quit.ps")) (system (string-append "pnmcrop " f ".ppm.1 > " f ".ppm.tmp")) (quote (unless (= *img-magnification* 1) (system (string-append "pbmpscale " (number->string *img-magnification*) " " f-ppm-tmp " > " f-ppm)) (let ((swp f-ppm)) (set! f-ppm f-ppm-tmp) (set! f-ppm-tmp swp)))) (system (string-append "ppmquant 256 < " f ".ppm.tmp > " f ".ppm")) (system (string-append "ppmtogif -transparent rgb:ff/ff/ff < " f ".ppm > " f ".gif")) (for-each (lambda (e) (ensure-file-deleted (string-append f e))) (quote (".ppm" ".ppm.tmp" ".ppm.1")))))

(define ps-to-img/png (lambda (ps-file f) (system (string-append *ghostscript* *ghostscript-options* " -sDEVICE=ppmraw -sOutputFile=" f ".ppm.1 " ps-file " quit.ps")) (system (string-append "pnmcrop " f ".ppm.1 > " f ".ppm.tmp")) (quote (system (string-append "ppmquant 256 < " f ".ppm.tmp > " f ".ppm"))) (system (string-append "pnmtopng -interlace -transparent \"#FFFFFF\" " " < " f ".ppm.tmp > " f ".png")) (for-each (lambda (e) (ensure-file-deleted (string-append f e))) (quote (".ppm.1" ".ppm.tmp" ".ppm")))))

(define ps-to-img/jpeg (lambda (ps-file f) (system (string-append *ghostscript* *ghostscript-options* " -sDEVICE=ppmraw -sOutputFile=" f ".ppm.1 " ps-file " quit.ps")) (system (string-append "pnmcrop " f ".ppm.1 > " f ".ppm.tmp")) (system (string-append "ppmquant 256 < " f ".ppm.tmp > " f ".ppm")) (system (string-append "ppmtojpeg --grayscale < " f ".ppm > " f ".jpeg")) (for-each (lambda (e) (ensure-file-deleted (string-append f e))) (quote (".ppm.1" ".ppm.tmp" ".ppm")))))

(define ps-to-img (lambda (ps-file img-file-stem) ((case *img-format* ((gif) ps-to-img/gif) ((png) ps-to-img/png) ((jpeg) ps-to-img/jpeg)) ps-file img-file-stem)))

(define tex-to-img (lambda (f) (set! *img-file-tally* (+ *img-file-tally* 1)) (let ((f.img (string-append *aux-dir/* f *img-file-extn*))) (unless (file-exists? f.img) (write-log #\space) (write-log #\{) (write-log (string-append *aux-dir/* f ".tex")) (write-log #\space) (write-log "->") (write-log #\space) (cond ((call-tex f) (system (string-append "dvips " f ".dvi -o " f ".ps")) (ps-to-img (string-append f ".ps") f) (write-log f.img) (for-each (lambda (e) (ensure-file-deleted (string-append f e))) (quote (".dvi" ".log" ".aux")))) (else (write-log "failed, try manually"))) (write-log #\})) (move-aux-files-to-aux-dir f))))

(define do-opengraphsfile (lambda () (set! *current-mfpic-file-stem* (string-trim-blanks (ungroup (get-group)))) (set! *current-mfpic-file-num* 0)))

(define do-mfpic (lambda () (source-img-file (call-with-image-port (lambda (o) (fluid-let ((*not-processing?* #t)) (let ((img-file-stem (string-append *current-mfpic-file-stem* *mfpic-file-suffix* (number->string *current-mfpic-file-stem*)))) (display "\\input mfpic" o) (newline o) (display "\\usemetapost" o) (newline o) (display "\\opengraphsfile{" o) (display img-file-stem o) (display "-M}" o) (newline o) (display "\\mfpic" o) (dump-till-end-env "mfpic" o) (quote (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-mfpic) "Eof inside \\mfpic")) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (unless (string=? x "\\endmfpic") (display x o) (loop)))) (else (display (get-actual-char) o) (loop)))))) (display "\\endmfpic" o) (newline o) (display "\\closegraphsfile" o) (newline o))))))))

(define do-epsfbox (lambda () (let ((f (ungroup (get-group)))) (if (file-exists? f) (source-img-file (call-with-image-port (lambda (o) (display "\\epsfbox{" o) (display f o) (display #\} o)))) (non-fatal-error "PostScript file " f " missing")))))

(define do-resizebox (lambda () (let* ((arg1 (get-group)) (arg2 (get-group)) (arg3 (get-group))) (source-img-file (call-with-image-port (lambda (o) (display "\\resizebox" o) (display arg1 o) (display arg2 o) (display arg3 o)))))))

(define do-includegraphics (lambda () (let* ((star? (eat-star)) (b1 (get-bracketed-text-if-any)) (b2 (and b1 (get-bracketed-text-if-any))) (f (ungroup (get-group)))) (set! f (if (file-exists? f) f (ormap (lambda (e) (let ((f2 (string-append f e))) (and (file-exists? f2) f2))) *graphics-file-extensions*))) (if f (source-img-file (call-with-image-port (lambda (o) (display "\\includegraphics" o) (if star? (display #\* o)) (when b1 (display #\[ o) (display b1 o) (display #\] o)) (when b2 (display #\[ o) (display b2 o) (display #\] o)) (display #\{ o) (display f o) (display #\} o)))) (non-fatal-error "Image file " f " missing")))))

(define do-following-latex-env-as-image (lambda () (do-latex-env-as-image (ungroup (get-group)) (quote display))))

(define do-latex-env-as-image (lambda (env inline-or-display?) (when (char=? (snoop-actual-char) #\*) (get-actual-char) (set! env (string-append env "*"))) (egroup) (when (eq? inline-or-display? (quote display)) (do-end-para) (emit "<div align=") (emit *display-justification*) (emit ">")) (source-img-file (call-with-image-port (lambda (o) (fluid-let ((*not-processing?* #t)) (display "\\begin{" o) (display env o) (display "}" o) (dump-till-end-env env o) (display "\\end{" o) (display env o) (display "}" o) (newline o))))) (when (eq? inline-or-display? (quote display)) (emit "</div>") (do-para))))

(define do-latex-picture (lambda () (source-img-file (call-with-image-port (lambda (o) (fluid-let ((*not-processing?* #t)) (display "\\begin{picture}" o) (dump-till-end-env "picture" o) (display "\\end{picture}" o) (newline o)))))))

(define do-box (lambda () (ignorespaces) (get-to) (eat-dimen) (ignorespaces) (let ((c (snoop-actual-char))) (case c ((#\{) #t) ((#\\) (get-ctl-seq)))) (get-actual-char) (bgroup) (add-postlude-to-top-frame (let ((old-math-mode? *math-mode?*) (old-in-display-math? *in-display-math?*) (old-tabular-stack *tabular-stack*) (old-ligatures? *ligatures?*)) (set! *math-mode?* #f) (set! *in-display-math?* #f) (set! *tabular-stack* (quote ())) (set! *ligatures?* #t) (lambda () (set! *math-mode?* old-math-mode?) (set! *in-display-math?* old-in-display-math?) (set! *tabular-stack* old-tabular-stack) (set! *ligatures?* old-ligatures?))))))

(define do-latex-frac (lambda () (emit "(") (tex2page-string (get-token)) (emit "/") (tex2page-string (get-token)) (emit ")")))

(define do-tex-frac (lambda () (ignorespaces) (let ((inner-level? (or (not *in-display-math?*) (not (null? *tabular-stack*))))) (fluid-let ((*tabular-stack* (cons (quote frac) *tabular-stack*))) (cond (inner-level? (emit "<sup>") (tex2page-string (get-till-char #\/)) (emit "</sup>/<sub>") (get-actual-char) (ignorespaces) (tex2page-string (get-token)) (emit "</sub>")) (else (emit "</td><td><table align=left><tr><td align=center>") (tex2page-string (get-till-char #\/)) (get-actual-char) (ignorespaces) (emit "<hr noshade>") (tex2page-string (get-token)) (emit "</td></tr></table></td><td>")))))))

(define do-frac (lambda () ((if (eqv? *tex-format* (quote latex)) do-latex-frac do-tex-frac))))

(define do-eqalign (lambda () (ignorespaces) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote do-eqalign) "Missing {")) (unless (char=? c #\{) (terror (quote do-eqalign) "Missing {")) (bgroup) (set! *tabular-stack* (cons (quote eqalign) *tabular-stack*)) (add-postlude-to-top-frame (lambda () (emit "</td></tr></table>") (when *in-display-math?* (emit "</td><td>")) (emit-newline) (set! *tabular-stack* (cdr *tabular-stack*)))) (when *in-display-math?* (emit "</td><td>")) (emit "<table><tr><td>") (emit-newline))))

(define do-pmatrix (lambda () (ignorespaces) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote do-pmatrix) "Missing {")) (unless (char=? c #\{) (terror (quote do-pmatrix) "Missing {")) (bgroup) (set! *tabular-stack* (cons (quote pmatrix) *tabular-stack*)) (add-postlude-to-top-frame (lambda () (emit "</td></tr></table>") (when *in-display-math?* (emit "</td><td>")) (emit-newline) (set! *tabular-stack* (cdr *tabular-stack*)))) (when *in-display-math?* (emit "</td><td>")) (emit "<table border=1><tr><td>") (emit-newline))))

(define eat-till-eol (lambda () (let loop () (let ((c (get-actual-char))) (unless (or (eof-object? c) (char=? c #\newline)) (loop))))))

(define do-comment (lambda () (eat-till-eol) (if (munched-a-newline?) (begin (toss-back-char #\newline) (toss-back-char #\newline)))))

(define latex-style-file? (lambda (f) (let ((e (file-extension f))) (and e (string-ci=? e ".sty")))))

(define path-to-list (lambda (p) (if (not p) (quote ()) (let loop ((p p) (r (quote ()))) (let ((i (string-index p *path-separator*))) (if i (loop (substring p (+ i 1) (string-length p)) (cons (substring p 0 i) r)) (reverse! (cons p r))))))))

(define find-some-file (lambda (path . files) (or (ormap (lambda (file) (and (file-exists? file) file)) files) (ormap (lambda (dir) (ormap (lambda (file) (let ((qfile (string-append dir *directory-separator* file))) (and (file-exists? qfile) qfile))) files)) path))))

(define actual-tex-filename (lambda (f) (or (find-some-file *tex2page-inputs* (string-append f ".tex") f) f)))

(define ignore-tex-specific-text (lambda (z) (let* ((env (substring z 1 (string-length z))) (endenv (string-append "\\end" env))) (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote ignore-tex-specific-text) "Missing \\end" env)) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x endenv) #t) ((string=? x "\\end") (let ((g (get-grouped-environment-name-if-any))) (unless (and g (string=? g env)) (loop)))) (else (loop))))) (else (get-actual-char) (loop))))))))

(define do-rawhtml (lambda () (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-rawhtml) "Missing \\endrawhtml")) ((char=? c *esc-char*) (let* ((x (get-ctl-seq)) (y (find-corresp-prim x))) (cond ((string=? y "\\endrawhtml") (quote done)) ((and (string=? x "\\end") (get-grouped-environment-name-if-any)) => (lambda (g) (let ((y (find-corresp-prim (string-append x g)))) (if (string=? y "\\endrawhtml") (quote done) (begin (emit "\\end{") (emit g) (emit "}") (loop)))))) ((string=? x "\\\\") (emit c) (toss-back-char c) (loop)) (else (emit x) (loop))))) (else (get-actual-char) (emit c) (loop)))))))

(define do-html-head-only (lambda () (when (null? *html-head*) (flag-missing-piece (quote html-head))) (let loop ((s (quote ()))) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (write-aux (quasiquote (!html-head (unquote (list->string (reverse! s))))))) ((char=? c *esc-char*) (write-aux (quasiquote (!html-head (unquote (list->string (reverse! s)))))) (let ((x (get-ctl-seq))) (cond ((string=? x "\\endhtmlheadonly") (quote done)) ((string=? x "\\input") (let ((f (get-filename))) (call-with-input-file/buffered f (lambda () (do-html-head-only))) (loop (quote ())))) (else (write-aux (quasiquote (!html-head (unquote x)))) (loop (quote ())))))) (else (get-actual-char) (loop (cons c s))))))))

(define resolve-chardefs (lambda (c) (let ((y (find-chardef c))) (if y (caddr y) #f))))

(define resolve-defs (lambda (x) (cond ((find-def x) => (lambda (y) (let ((args (cadr y)) (expn (caddr y)) (opt-arg (cadddr y))) (case args ((:prim) expn) ((:thunk) x) (else (cond ((and (inside-false-world?) (not (if-aware-ctl-seq? x)) (> (length args) 0)) x) (else (expand-tex-macro args expn opt-arg)))))))) (else x))))

(define do-expandafter (lambda () (let* ((first (get-raw-token/is)) (second (get-raw-token/is))) (toss-back-char *invisible-space*) (cond ((ctl-seq? second) (toss-back-string (expand-ctl-seq-into-string second))) (else (toss-back-string second))) (toss-back-char *invisible-space*) (toss-back-string first))))

(define tex-def-char (lambda (char args expansion global?) (let ((frame (if global? *global-texframe* (top-texframe)))) (unless (and (eqv? frame *global-texframe*) (or (char=? char #\space) (char=? char #\newline))) (cond ((assoc char (texframe.chardefinitions frame)) => (lambda (c) (set-car! (cdr c) args) (set-car! (cddr c) expansion))) (else (set!texframe.chardefinitions frame (cons (list char args expansion) (texframe.chardefinitions frame)))))))))

(define tex-def (lambda (name args expansion opt-arg global?) (let ((frame (if global? *global-texframe* (top-texframe)))) (cond ((lassoc name (texframe.definitions frame) string=?) => (lambda (c) (set-car! (cdr c) args) (set-car! (cddr c) expansion) (set-car! (cdddr c) opt-arg))) (else (set!texframe.definitions frame (cons (list name args expansion opt-arg) (texframe.definitions frame))))))))

(define tex-def-prim (lambda (cs th) (set!texframe.definitions *primitive-texframe* (cons (list cs (quote :thunk) th #f) (texframe.definitions *primitive-texframe*)))))

(define tex-let-prim (lambda (cs-new cs-old) (cond ((lassoc cs-old (texframe.definitions *primitive-texframe*) string=?) => (lambda (cs-old-entry) (let ((cs-old-args (cadr cs-old-entry)) (cs-old-expn (caddr cs-old-entry)) (cs-old-optarg (cadddr cs-old-entry))) (cond ((lassoc cs-new (texframe.definitions *primitive-texframe*) string=?) => (lambda (cs-new-entry) (set-car! (cdr cs-new-entry) cs-old-args) (set-car! (cddr cs-new-entry) cs-old-expn) (set-car! (cdddr cs-new-entry) cs-old-optarg))) (else (set!texframe.definitions *primitive-texframe* (cons (list cs-new cs-old-args cs-old-expn cs-old-optarg) (texframe.definitions *primitive-texframe*)))))))) (else (terror (quote tex-let-prim) cs-old " not defined")))))

(define tex-def-thunk (lambda (name thunk global?) (unless (inside-false-world?) (let ((fr (if global? *global-texframe* (top-texframe)))) (cond ((lassoc name (texframe.definitions fr) string=?) => (lambda (c) (set-car! (cdr c) (quote :thunk)) (set-car! (cddr c) thunk) (set-car! (cdddr c) #f))) (else (set!texframe.definitions fr (cons (list name (quote :thunk) thunk #f) (texframe.definitions fr)))))))))

(define tex-def-count (lambda (name num global?) (let ((frame (if global? *global-texframe* (top-texframe)))) (cond ((lassoc name (texframe.counts frame) string=?) => (lambda (c) (set-car! (cdr c) num))) (else (set!texframe.counts frame (cons (list name num) (texframe.counts frame))))))))

(define tex-def-toks (lambda (name tokens global?) (let ((frame (if global? *global-texframe* (top-texframe)))) (cond ((lassoc name (texframe.toks frame) string=?) => (lambda (c) (set-car! (cdr c) tokens))) (else (set!texframe.toks frame (cons (list name tokens) (texframe.toks frame))))))))

(define tex-def-dimen (lambda (name global?) (let ((frame (if global? *global-texframe* (top-texframe)))) (cond ((lassoc name (texframe.dimens frame) string=?) #t) (else (set!texframe.dimens frame (cons (list name) (texframe.dimens frame))))))))

(define initialize-global-texframe (lambda () (tex-def-count "\\language" 256 #t) (tex-def-count "\\tocdepth" -2 #t) (tex-def-count "\\footnotenumber" 0 #t) (tex-def-count "\\TIIPtabularborder" 1 #t) (tex-def-count "\\TIIPnestedtabularborder" 0 #t) (tex-def-count "\\TIIPobeyspacestrictly" 0 #t) (tex-def-toks "\\TIIPrecentlabelname" "" #t) (tex-def-toks "\\TIIPrecentlabelvalue" "" #t) (tex-def-dotted-count "figure" #f) (tex-def-dotted-count "table" #f) (quote (tex-def-thunk "\\pageno" (lambda () (number->string *html-page-count*)) #t))))

(define find-chardef (lambda (char) (or (ormap (lambda (fr) (assoc char (texframe.chardefinitions fr))) *tex-env*) (assoc char (texframe.chardefinitions *global-texframe*)) (assoc char (texframe.chardefinitions *primitive-texframe*)))))

(define find-def (lambda (ctlseq) (or (ormap (lambda (fr) (lassoc ctlseq (texframe.definitions fr) string=?)) *tex-env*) (lassoc ctlseq (texframe.definitions *global-texframe*) string=?) (lassoc ctlseq (texframe.definitions *primitive-texframe*) string=?))))

(define find-math-def (lambda (ctlseq) (let ((c (lassoc ctlseq (texframe.definitions *math-primitive-texframe*) string=?))) (and c (cdr c)))))

(define find-count (lambda (ctlseq) (or (ormap (lambda (fr) (lassoc ctlseq (texframe.counts fr) string=?)) *tex-env*) (lassoc ctlseq (texframe.counts *global-texframe*) string=?) (lassoc ctlseq (texframe.counts *primitive-texframe*) string=?))))

(define find-toks (lambda (ctlseq) (or (ormap (lambda (fr) (lassoc ctlseq (texframe.toks fr) string=?)) *tex-env*) (lassoc ctlseq (texframe.toks *global-texframe*) string=?) (lassoc ctlseq (texframe.toks *primitive-texframe*) string=?))))

(define find-dimen (lambda (ctlseq) (or (ormap (lambda (fr) (lassoc ctlseq (texframe.dimens fr) string=?)) *tex-env*) (lassoc ctlseq (texframe.dimens *global-texframe*) string=?) (lassoc ctlseq (texframe.dimens *primitive-texframe*) string=?))))

(define get-toks (lambda (ctlseq) (cond ((find-toks ctlseq) => cadr) (else (terror (quote get-toks))))))

(define the-count (lambda (ctlseq) (let ((dracula (find-count ctlseq))) (unless dracula (terror (quote the-count))) (cadr dracula))))

(define do-count= (lambda (z global?) (get-equal-sign) (tex-def-count z (get-number) global?)))

(define do-toks= (lambda (z global?) (get-equal-sign) (tex-def-toks z (get-group) global?)))

(define do-dimen= (lambda (z global?) (get-equal-sign) (ignorespaces) (if (char=? (snoop-actual-char) *esc-char*) (get-ctl-seq) (eat-dimen))))

(define get-gcount (lambda (ctlseq) (cadr (lassoc ctlseq (texframe.counts *global-texframe*) string=?))))

(define set-gcount! (lambda (ctlseq v) (tex-def-count ctlseq v #t)))

(define do-number (lambda () (emit (the-count (get-ctl-seq)))))

(define do-the (lambda () (let ((ctlseq (get-ctl-seq))) (cond ((find-count ctlseq) => (lambda (x) (emit (cadr x)))) ((find-toks ctlseq) => (lambda (x) (tex2page-string (cadr x)))) (else (trace-if #f "do-the failed"))))))

(define find-corresp-prim (lambda (ctlseq) (let ((y (find-def ctlseq))) (if (and y (eqv? (cadr y) (quote :prim))) (caddr y) ctlseq))))

(define find-corresp-prim-thunk (lambda (ctlseq) (let ((y (find-def ctlseq))) (if (and y (eqv? (cadr y) (quote :thunk))) (caddr y) ctlseq))))

(define do-def (lambda (global?) (unless (inside-false-world?) (let* ((lhs (get-raw-token/is)) (arg-pat (get-def-arguments lhs)) (rhs (ungroup (get-group)))) (if (ctl-seq? lhs) (tex-def lhs arg-pat rhs #f global?) (tex-def-char (string-ref lhs 0) arg-pat rhs global?))))))

(define do-newcount (lambda (global?) (tex-def-count (get-ctl-seq) 0 global?)))

(define do-newtoks (lambda (global?) (tex-def-toks (get-ctl-seq) "" global?)))

(define do-newdimen (lambda (global?) (tex-def-dimen (get-ctl-seq) global?)))

(define do-advance (lambda (global?) (let* ((ctlseq (get-ctl-seq)) (count (find-count ctlseq))) (get-by) (if count (tex-def-count ctlseq (+ (cadr count) (get-number)) global?) (eat-dimen)))))

(define do-multiply (lambda (global?) (let* ((ctlseq (get-ctl-seq)) (curr-val (cadr (find-count ctlseq)))) (get-by) (tex-def-count ctlseq (* curr-val (get-number)) global?))))

(define do-divide (lambda (global?) (let* ((ctlseq (get-ctl-seq)) (curr-val (cadr (find-count ctlseq)))) (get-by) (tex-def-count ctlseq (quotient curr-val (get-number)) global?))))

(define do-catcode (lambda () (let* ((c (get-tex-char-spec)) (val (begin (get-equal-sign) (get-number)))) (case val ((0) (set! *esc-char* c)) ((13) (tex-def-char c (quote ()) "" #f)) (else (let ((y (or (ormap (lambda (fr) (assoc c (texframe.chardefinitions fr))) *tex-env*) (assoc c (texframe.chardefinitions *global-texframe*))))) (if y (set-car! (cddr y) #f))))))))

(define do-defcsactive (lambda () (ignorespaces) (let* ((c (get-ctl-seq)) (rhs (ungroup (get-group)))) (tex-def-char (string-ref c 1) (quote ()) rhs #f))))

(define do-undefcsactive (lambda () (ignorespaces) (let* ((c (string-ref (get-ctl-seq) 1)) (fr (top-texframe)) (y (assoc c (texframe.chardefinitions fr)))) (if y (set-car! (cddr y) #f) (tex-def-char c (quote ()) #f #f)))))

(define do-newcommand (lambda (renew?) (ignorespaces) (let* ((lhs (string-trim-blanks (ungroup (get-token)))) (opt-arg #f) (argc (cond ((get-bracketed-text-if-any) => (lambda (s) (cond ((get-bracketed-text-if-any) => (lambda (s) (set! opt-arg s)))) (string->number (string-trim-blanks s)))) (else 0))) (rhs (ungroup (get-token))) (ok-to-def? (or renew? (not (find-def lhs))))) (tex-def lhs (latex-arg-num->plain-arg-pat argc) rhs opt-arg #f) (unless ok-to-def? (trace-if *tracingcommands?* lhs " already defined")))))

(define do-advancetally (lambda (global?) (let* ((ctlseq (get-ctl-seq)) (increment (string->number (string-trim-blanks (ungroup (get-token)))))) (tex-def ctlseq (quote ()) (number->string (+ (string->number (resolve-defs ctlseq)) increment)) #f global?))))

(define do-newenvironment (lambda (renew?) (ignorespaces) (let* ((envname (string-trim-blanks (ungroup (get-token)))) (bs-envname (string-append "\\" envname)) (optarg #f) (argc (cond ((get-bracketed-text-if-any) => (lambda (s) (cond ((get-bracketed-text-if-any) => (lambda (s) (set! optarg s)))) (string->number (string-trim-blanks s)))) (else 0))) (beginning (string-append "\\begingroup " (ungroup (get-token)))) (ending (string-append (ungroup (get-token)) "\\endgroup")) (ok-to-def? (or renew? (not (find-def bs-envname))))) (tex-def bs-envname (latex-arg-num->plain-arg-pat argc) beginning optarg #f) (tex-def (string-append "\\end" envname) (quote ()) ending #f #f) (unless ok-to-def? (trace-if #t "{" envname "} already defined")))))

(define tex-def-dotted-count (lambda (counter-name sec-num) (when sec-num (table-put! *section-counter-dependencies* sec-num (cons counter-name (table-get *section-counter-dependencies* sec-num (quote ()))))) (table-put! *dotted-counters* counter-name (make-counter (quote within) sec-num))))

(define do-newtheorem (lambda () (let* ((env (ungroup (get-group))) (numbered-like (get-bracketed-text-if-any)) (counter-name (or numbered-like env)) (caption (ungroup (get-group))) (within (if numbered-like #f (get-bracketed-text-if-any))) (sec-num (and within (section-ctl-seq? (string-append "\\" within))))) (unless numbered-like (tex-def-dotted-count counter-name sec-num)) (tex-def (string-append "\\" env) (quote ()) (string-append "\\par\\begingroup\\TIIPtheorem{" counter-name "}{" caption "}") #f #t) (tex-def (string-append "\\end" env) (quote ()) "\\endgroup\\par" #f #t))))

(define do-theorem (lambda () (let* ((counter-name (ungroup (get-group))) (counter (table-get *dotted-counters* counter-name)) (caption (ungroup (get-group)))) (unless counter (terror (quote do-theorem))) (let ((new-counter-value (+ 1 (counter.value counter)))) (set!counter.value counter new-counter-value) (let* ((thm-num (let ((sec-num (counter.within counter))) (if sec-num (string-append (section-counter-value sec-num) "." (number->string new-counter-value)) (number->string new-counter-value)))) (lbl (string-append "%_thm_" thm-num))) (tex-def-toks "\\TIIPrecentlabelname" lbl #f) (tex-def-toks "\\TIIPrecentlabelvalue" thm-num #f) (emit-anchor lbl) (emit-newline) (emit "<b>") (emit caption) (emit " ") (emit thm-num) (emit ".</b>") (emit-nbsp 2))))))

(define do-begin (lambda () (cond ((get-grouped-environment-name-if-any) => (lambda (env) (toss-back-char *invisible-space*) (toss-back-string (string-append "\\" env)) (unless (ormap (lambda (y) (string=? env y)) (quote ("htmlonly" "cssblock" "document" "latexonly" "rawhtml" "texonly" "verbatim"))) (toss-back-string "\\begingroup") (do-end-para)))) (else (terror (quote do-begin) "\\begin not followed by environment name")))))

(define do-end (lambda () (cond ((get-grouped-environment-name-if-any) => (lambda (env) (toss-back-char *invisible-space*) (unless (ormap (lambda (y) (string=? env y)) (quote ("htmlonly" "document"))) (do-end-para) (toss-back-string "\\endgroup")) (toss-back-string (string-append "\\end" env)))) (else (toss-back-char *invisible-space*) (toss-back-string "\\bye")))))

(define latex-arg-num->plain-arg-pat (lambda (n) (let loop ((n n) (s (quote ()))) (if (<= n 0) s (loop (- n 1) (cons #\# (cons (integer->char (+ *int-corresp-to-0* n)) s)))))))

(define do-let (lambda (global?) (unless (inside-false-world?) (ignorespaces) (let* ((lhs (get-ctl-seq)) (rhs (begin (get-equal-sign) (get-raw-token/is)))) (unless (and (ormap (lambda (z) (string=? lhs z)) (quote ("\\texonly" "\\endtexonly"))) (string=? rhs "\\relax")) (if (ctl-seq? rhs) (let ((s (find-def rhs))) (if s (tex-def lhs (cadr s) (caddr s) (cadddr s) global?) (tex-def lhs (quote :prim) rhs #f global?))) (tex-def lhs (quote ()) rhs #f global?)))))))

(define make-reusable-img (lambda (global?) (set! *imgdef-file-count* (+ *imgdef-file-count* 1)) (ignorespaces) (let ((lhs (get-ctl-seq)) (imgdef-file-stem (string-append *subjobname* *img-file-suffix* *imgdef-file-suffix* (number->string *imgdef-file-count*)))) (dump-imgdef imgdef-file-stem) (tex-to-img imgdef-file-stem) (tex-def lhs (quote ()) (string-append "\\TIIPreuseimage{" imgdef-file-stem "}") #f global?))))

(define source-img-file (lambda (img-file-stem) (let* ((img-file (string-append img-file-stem *img-file-extn*)) (f (string-append *aux-dir/* img-file))) (write-log #\space) (write-log #\() (write-log f) (cond ((file-exists? f) (emit "<img src=\"") (emit img-file) (emit "\" border=\"0\">") (write-log #\)) #t) (else (write-log #\space) (write-log "missing") (write-log #\)) (non-fatal-error "Image not generated") #f)))))

(define reuse-img (lambda () (source-img-file (ungroup (get-group)))))

(define get-def-arguments (lambda (lhs) (let aux () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote read-arg-pat) "EOF found while scanning definition of " lhs)) ((char=? c #\{) (quote ())) (else (get-actual-char) (cons c (aux))))))))

(define get-till-char (lambda (c0) (list->string (reverse! (let loop ((s (quote ())) (nesting 0) (escape? #f)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote get-till-char) "File ended too soon")) (escape? (loop (cons (get-actual-char) s) nesting #f)) ((char=? c c0) s) ((char=? c *esc-char*) (loop (cons (get-actual-char) s) nesting #t)) ((char=? c #\{) (loop (cons (get-actual-char) s) (+ nesting 1) #f)) ((char=? c #\}) (loop (cons (get-actual-char) s) (- nesting 1) #f)) ((> nesting 0) (loop (cons (get-actual-char) s) nesting #f)) ((and (char-whitespace? c) (not (char=? c0 #\newline)) (char-whitespace? c0)) s) (else (loop (cons (get-actual-char) s) nesting #f)))))))))

(define digit->int (lambda (d) (- (char->integer d) *int-corresp-to-0*)))

(define do-halign (lambda () (do-end-para) (ignorespaces) (let ((c (get-actual-char))) (if (eof-object? c) (terror (quote do-halign) "Missing {")) (unless (char=? c #\{) (terror (quote do-halign) "Missing {"))) (fluid-let ((*tabular-stack* (cons (quote halign) *tabular-stack*))) (bgroup) (emit "<table>") (let ((tmplt (get-halign-template))) (let loop () (ignorespaces) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-halign) "Eof inside \\halign")) ((char=? c #\}) (get-actual-char) (emit "</table>") (egroup) (do-para)) (else (expand-halign-line tmplt) (loop)))))))))

(define get-halign-template (lambda () (let loop ((s (quote ()))) (let ((x (get-raw-token))) (cond ((eof-object? x) (terror (quote get-halign-template) "Eof in \\halign")) ((string=? x "\\cr") (reverse! (cons #f s))) ((string=? x "#") (loop (cons #t s))) ((string=? x "&") (loop (cons #f s))) (else (loop (cons x s))))))))

(define expand-halign-line (lambda (tmplt) (emit "<tr>") (let loop ((tmplt tmplt) (ins " ")) (let ((x (get-raw-token))) (cond ((eof-object? x) (terror (quote expand-halign-line) "Eof in \\halign")) ((or (string=? x "&") (string=? x "\\cr")) (let loop2 ((tmplt tmplt) (r "{")) (if (null? tmplt) (terror (quote expand-halign-line) "Eof in \\halign") (let ((y (car tmplt))) (case y ((#f) (emit "<td>") (tex2page-string (string-append r "}")) (emit "</td>") (if (string=? x "\\cr") (begin (emit "</tr>") (emit-newline)) (loop (cdr tmplt) " "))) ((#t) (loop2 (cdr tmplt) (string-append r ins))) (else (loop2 (cdr tmplt) (string-append r y)))))))) (else (loop tmplt (string-append ins x))))))))

(define expand-tex-macro (lambda (arg-pat rhs opt-arg) (let* ((arg-pat-n (length arg-pat)) (k 0) (r (if (not opt-arg) (quote ()) (begin (set! k 2) (list (cond ((get-bracketed-text-if-any) => (lambda (s) s)) (else opt-arg)))))) (args (reverse! (let loop ((k k) (r r)) (if (>= k arg-pat-n) r (let ((c (list-ref arg-pat k))) (cond ((char=? c #\#) (loop (+ k 2) (cons (if (or (= (+ k 2) arg-pat-n) (char=? (list-ref arg-pat (+ k 2)) #\#)) (ungroup (get-token)) (get-till-char (list-ref arg-pat (+ k 2)))) r))) ((char-whitespace? c) (ignorespaces) (loop (+ k 1) r)) (else (let ((c2 (get-actual-char))) (if (eof-object? c2) (terror (quote expand-tex-macro) "Eof before macro got enough args") (if (char=? c c2) (loop (+ k 1) r) (terror (quote expand-tex-macro) "Misformed macro call"))))))))))) (rhs-n (string-length rhs))) (list->string (let aux ((k 0)) (if (>= k rhs-n) (quote ()) (let ((c (string-ref rhs k))) (cond ((char=? c #\\) (let loop ((j (+ k 1)) (s (list #\\))) (if (>= j rhs-n) (reverse! s) (let ((c (string-ref rhs j))) (cond ((char-alphabetic? c) (loop (+ j 1) (cons c s))) ((and (char=? c #\#) (> (length s) 1)) (append (reverse! s) (cons #\space (aux j)))) ((= (length s) 1) (append (reverse! (cons c s)) (aux (+ j 1)))) (else (append (reverse! s) (aux j)))))))) ((char=? c #\#) (if (= k (- rhs-n 1)) (list #\#) (let ((n (string-ref rhs (+ k 1)))) (cond ((char=? n #\#) (cons #\# (aux (+ k 2)))) ((and (char-numeric? n) (<= (digit->int n) (length args))) (append (string->list (list-ref args (- (digit->int n) 1))) (aux (+ k 2)))) (else (cons #\# (aux (+ k 1)))))))) (else (cons c (aux (+ k 1))))))))))))

(define set-verbatim-escape-character (lambda () (ignorespaces) (let* ((c1 (get-actual-char)) (c2 (get-actual-char))) (unless (char=? c1 *esc-char*) (terror (quote set-verbatim-escape-character) "Arg must be \\<char>")) (set! *esc-char-verb* c2))))

(define do-braced-verb (lambda () (get-actual-char) (let ((in-text? (not (munched-a-newline?)))) (if in-text? (emit "<code class=verbatim>") (begin (do-end-para) (emit "<pre class=verbatim>"))) (bgroup) (fluid-let ((*esc-char* *esc-char-verb*) (*tex-extra-letters* (quote ()))) (let loop ((nesting 0)) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote do-braced-verb) "Eof inside verbatim")) ((char=? c *esc-char*) (toss-back-char c) (let ((x (fluid-let ((*not-processing?* #t)) (get-ctl-seq)))) (cond ((ormap (lambda (z) (string=? x z)) (quote ("\\ " "\\{" "\\}"))) (emit (string-ref x 1))) (else (fluid-let ((*esc-char* *esc-char-std*)) (do-tex-ctl-seq-completely x))))) (loop nesting)) ((char=? c #\{) (emit #\{) (loop (+ nesting 1))) ((char=? c #\}) (unless (= nesting 0) (emit #\}) (loop (- nesting 1)))) (else (emit-html-char c) (loop nesting)))))) (egroup) (if in-text? (emit "</code>") (begin (emit "</pre>") (do-para))))))

(define do-latex-verb (lambda () (let* ((d (get-actual-char)) (in-text? (not (munched-a-newline?)))) (if in-text? (emit "<code class=verbatim>") (begin (do-end-para) (emit "<pre class=verbatim>"))) (let loop () (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote do-latex-verb) "Eof inside verbatim")) ((char=? c d) (quote done)) (else (emit-html-char c) (loop))))) (if in-text? (emit "</code>") (begin (emit "</pre>") (do-para))))))

(define do-verb (lambda () (ignorespaces) (bgroup) (fluid-let ((*ligatures?* #f)) ((if (char=? (snoop-actual-char) #\{) do-braced-verb do-latex-verb))) (egroup)))

(define do-verbc (lambda () (ignorespaces) (bgroup) (fluid-let ((*ligatures?* #f)) (emit "<code class=verbatim>") (emit-html-char (get-actual-char)) (emit "</code>")) (egroup)))

(define do-verbatim-file (lambda () (ignorespaces) (let ((f (get-filename))) (cond ((file-exists? f) (do-end-para) (bgroup) (emit "<pre class=verbatim>") (call-with-input-file f (lambda (p) (let loop () (let ((c (read-char p))) (unless (eof-object? c) (emit-html-char c) (loop)))))) (emit "</pre>") (egroup) (do-para)) (else (terror (quote do-verbatim-file) "I can't find file \"" f #\"))))))

(define verb-set-filename (lambda () (let ((f (get-filename))) (if *verb-port* (close-output-port *verb-port*)) (ensure-file-deleted f) (set! *verb-port* (open-output-file f)))))

(define verb-ensure-output-port (lambda () (unless *verb-port* (let ((output-file (string-append *jobname* ".txt"))) (ensure-file-deleted output-file) (set! *verb-port* (open-output-file output-file))))))

(define verb-write-to-file (lambda () (verb-ensure-output-port) (ignorespaces) (let ((d (get-actual-char))) (case d ((#\{) (let loop ((nesting 0)) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote verb-write-to-file) "Eof inside verbatim")) ((char=? c *esc-char-verb*) (write-char c *verb-port*) (write-char (get-actual-char) *verb-port*) (loop nesting)) ((char=? c #\{) (write-char c *verb-port*) (loop (+ nesting 1))) ((char=? c #\}) (unless (= nesting 0) (write-char c *verb-port*) (loop (- nesting 1)))) (else (write-char c *verb-port*) (loop nesting)))))) (else (let loop () (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote verb-write-to-file) "Eof inside verbatim")) ((char=? c d) (quote done)) (else (write-char c *verb-port*) (loop))))))))))

(define do-latex-verbatim (lambda () (do-end-para) (bgroup) (emit "<pre class=verbatim>") (munched-a-newline?) (fluid-let ((*ligatures?* #f)) (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-latex-verbatim) "Eof inside verbatim")) ((char=? c #\\) (let ((end? (get-ctl-seq))) (if (string=? end? "\\end") (cond ((get-grouped-environment-name-if-any) => (lambda (e) (unless (string=? e "verbatim") (emit-html-string end?) (emit-html-char #\{) (emit-html-string e) (emit-html-char #\}) (loop)))) (else (for-each emit-html-char end?) (loop))) (begin (emit-html-string end?) (loop))))) (else (emit-html-char (get-actual-char)) (loop)))))) (emit "</pre>") (egroup) (do-para)))

(define do-alltt (lambda () (do-end-para) (bgroup) (emit "<pre class=verbatim>") (munched-a-newline?) (fluid-let ((*in-alltt?* #t)) (let loop () (let ((c (snoop-actual-char))) (if (eof-object? c) (terror (quote do-alltt) "Eof inside alltt") (begin (case c ((#\\) (do-tex-ctl-seq (get-ctl-seq))) ((#\{) (get-actual-char) (bgroup)) ((#\}) (get-actual-char) (egroup)) (else (emit-html-char (get-actual-char)))) (if *in-alltt?* (loop)))))))))

(define do-end-alltt (lambda () (emit "</pre>") (egroup) (do-para) (set! *in-alltt?* #f)))

(define *scm-special-symbols* (make-table (quote equ) string=?))

(define *scm-keywords* (quote ("=>" "and" "begin" "begin0" "case" "cond" "define" "define-macro" "define-syntax" "defmacro" "defstruct" "delay" "do" "else" "flet" "fluid-let" "if" "labels" "lambda" "let" "let-syntax" "let*" "letrec" "letrec-syntax" "macrolet" "or" "quasiquote" "quote" "set!" "syntax-rules" "unless" "unquote" "unquote-splicing" "when" "with" "with-handlers")))

(define *scm-constants* (quote ()))

(define do-scm-set-special-symbol (lambda () (let* ((sym (string-trim-blanks (ungroup (get-group)))) (xln (get-group))) (table-put! *scm-special-symbols* sym xln))))

(define do-scm-unset-special-symbol (lambda () (call-with-input-string/buffered (ungroup (get-group)) (lambda () (let loop () (ignore-all-whitespace) (unless (eof-object? (snoop-actual-char)) (table-put! *scm-special-symbols* (scm-get-token) #f) (loop)))))))

(define do-scm-set-constants (lambda () (call-with-input-string/buffered (ungroup (get-group)) (lambda () (let loop () (ignore-all-whitespace) (let ((c (snoop-actual-char))) (unless (eof-object? c) (let ((s (scm-get-token))) (set! *scm-constants* (cons s *scm-constants*)) (loop)))))))))

(define do-scm-set-keywords (lambda () (call-with-input-string/buffered (ungroup (get-group)) (lambda () (let loop () (ignore-all-whitespace) (let ((c (snoop-actual-char))) (unless (eof-object? c) (let ((s (scm-get-token))) (set! *scm-keywords* (cons s *scm-keywords*)) (loop)))))))))

(define do-input-dirs (lambda () (call-with-input-string/buffered (ungroup (get-group)) (lambda () (let loop () (ignore-all-whitespace) (let ((c (snoop-actual-char))) (unless (eof-object? c) (let ((f (get-filename))) (set! *input-dirs* (cons f *input-dirs*))) (loop))))))))

(define scm-emit-html-char (lambda (c) (unless (eof-object? c) (if *scm-dribbling?* (write-char c *scm-port*)) (emit-html-char c))))

(define scm-output-next-chunk (lambda () (let ((c (snoop-actual-char))) (cond ((and *slatex-math-escape* (char=? c *slatex-math-escape*)) (scm-escape-into-math)) ((char=? c #\;) (scm-output-comment) (do-end-para)) ((char=? c #\") (scm-output-string)) ((char=? c #\#) (scm-output-hash)) ((char=? c #\,) (get-actual-char) (emit "<span class=keyword>") (scm-emit-html-char c) (let ((c (snoop-actual-char))) (when (char=? c #\@) (get-actual-char) (scm-emit-html-char c))) (emit "</span>")) ((or (char=? c #\') (char=? c #\`)) (get-actual-char) (emit "<span class=keyword>") (scm-emit-html-char c) (emit "</span>")) ((or (char-whitespace? c) (memv c *scm-token-delims*)) (get-actual-char) (scm-emit-html-char c)) (else (scm-output-token (scm-get-token)))))))

(define scm-set-math-escape (lambda (yes?) (let ((c (fluid-let ((*esc-char* (integer->char 0))) (string-ref (ungroup (get-group)) 0)))) (cond (yes? (set! *slatex-math-escape* c) (set! *scm-token-delims* (cons *slatex-math-escape* *scm-token-delims*))) (else (set! *slatex-math-escape* #f) (set! *scm-token-delims* (ldelete c *scm-token-delims* char=?)))))))

(define scm-escape-into-math (lambda () (get-actual-char) (let ((math-text (get-till-char *slatex-math-escape*))) (get-actual-char) (emit "<span class=variable>") (fluid-let ((*esc-char* *esc-char-std*)) (tex2page-string (string-append "$" math-text "$"))) (emit "</span>"))))

(define scm-output-slatex-comment (lambda () (let ((s (get-line))) (emit "<span class=comment>") (when *scm-dribbling?* (display s *scm-port*) (newline *scm-port*)) (fluid-let ((*esc-char* *esc-char-std*)) (tex2page-string s)) (do-end-para) (emit "</span>") (toss-back-char #\newline))))

(define scm-output-verbatim-comment (lambda () (emit "<span class=comment>") (let loop () (let ((c (get-actual-char))) (cond ((or (eof-object? c) (char=? c #\newline)) (emit "</span>") (scm-emit-html-char c)) ((and (char-whitespace? c) (let ((c2 (snoop-actual-char))) (or (eof-object? c2) (char=? c2 #\newline)))) (emit "</span>") (scm-emit-html-char (get-actual-char))) (else (scm-emit-html-char c) (loop)))))))

(define scm-output-comment (lambda () ((if *slatex-like-comments?* scm-output-slatex-comment scm-output-verbatim-comment))))

(define scm-output-extended-comment (lambda () (get-actual-char) (emit "<span class=comment>") (scm-emit-html-char #\#) (scm-emit-html-char #\|) (let loop () (let ((c (get-actual-char))) (cond ((eof-object? c) #t) ((char=? c #\|) (let ((c2 (snoop-actual-char))) (cond ((eof-object? c2) (scm-emit-html-char c)) ((char=? c2 #\#) (get-actual-char)) (else (scm-emit-html-char c) (loop))))) (else (scm-emit-html-char c) (loop))))) (scm-emit-html-char #\|) (scm-emit-html-char #\#) (emit "</span>")))

(define scm-output-string (lambda () (get-actual-char) (emit "<span class=selfeval>") (scm-emit-html-char #\") (let loop ((esc? #f)) (let ((c (get-actual-char))) (case c ((#\") (when esc? (scm-emit-html-char c) (loop #f))) ((#\\) (scm-emit-html-char c) (loop (not esc?))) (else (scm-emit-html-char c) (loop #f))))) (scm-emit-html-char #\") (emit "</span>")))

(quote (define scm-output-hash-token (lambda () (get-actual-char) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (emit "<span class=selfeval>") (scm-emit-html-char #\#) (emit "</span>")) ((char=? c #\|) (scm-output-extended-comment)) (else (emit "<span class=selfeval>") (scm-emit-html-char #\#) (scm-display-token (scm-get-token)) (emit "</span>")))))))

(define scm-output-hash (lambda () (get-actual-char) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (emit "<span class=selfeval>") (scm-emit-html-char #\#) (emit "</span>")) ((char=? c #\|) (scm-output-extended-comment)) (else (toss-back-char #\#) (scm-output-token (scm-get-token)))))))

(define scm-output-token (lambda (s) (case (scm-get-type s) ((special-symbol) (fluid-let ((*esc-char* *esc-char-std*)) (tex2page-string (table-get *scm-special-symbols* s)))) ((keyword) (emit "<span class=keyword>") (scm-display-token s) (emit "</span>")) ((global) (emit "<span class=global>") (scm-display-token s) (emit "</span>")) ((selfeval) (emit "<span class=selfeval>") (scm-display-token s) (emit "</span>")) ((builtin) (emit "<span class=builtin>") (scm-display-token s) (emit "</span>")) ((background) (scm-display-token s)) (else (emit "<span class=variable>") (scm-display-token s) (emit "</span>")))))

(define scm-display-token (lambda (s) (let ((n (string-length s))) (let loop ((k 0)) (when (< k n) (scm-emit-html-char (string-ref s k)) (loop (+ k 1)))))))

(define do-scm-with-brace (lambda (result?) (get-actual-char) (let ((in-text? (not (munched-a-newline?)))) (cond (in-text? (emit "<code class=scheme") (when result? (emit "response")) (emit ">")) (else (do-end-para) (emit "<pre class=scheme>"))) (bgroup) (fluid-let ((*esc-char* *esc-char-verb*)) (let loop ((nesting 0)) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-scm-with-brace) "Eof inside verbatim")) ((char=? c *esc-char*) (let ((x (fluid-let ((*not-processing?* #t)) (get-ctl-seq)))) (cond ((ormap (lambda (z) (string=? x z)) (quote ("\\ " "\\{" "\\}"))) (scm-emit-html-char (string-ref x 1))) (else (fluid-let ((*esc-char* *esc-char-std*)) (do-tex-ctl-seq-completely x))))) (loop nesting)) ((char=? c #\{) (get-actual-char) (scm-emit-html-char c) (loop (+ nesting 1))) ((char=? c #\}) (get-actual-char) (unless (= nesting 0) (scm-emit-html-char c) (loop (- nesting 1)))) (else (scm-output-next-chunk) (loop nesting)))))) (egroup) (if in-text? (emit "</code>") (begin (emit "</pre>") (do-para))))))

(define do-scm-with-delim (lambda (result?) (let ((d (get-actual-char))) (let ((in-text? (not (munched-a-newline?)))) (cond (in-text? (emit "<code class=scheme") (when result? (emit "response")) (emit ">")) (else (do-end-para) (emit "<pre class=scheme>"))) (fluid-let ((*scm-token-delims* (cons d *scm-token-delims*))) (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-scm-with-delim) "Eof inside verbatim")) ((char=? c d) (get-actual-char)) (else (scm-output-next-chunk) (loop)))))) (if in-text? (emit "</code>") (begin (emit "</pre>") (do-para)))))))

(define do-scm (lambda (result?) (ignorespaces) (bgroup) (fluid-let ((*ligatures?* #f)) ((if (char=? (snoop-actual-char) #\{) do-scm-with-brace do-scm-with-delim) result?)) (egroup)))

(define do-scm-input (lambda () (ignorespaces) (do-end-para) (bgroup) (emit "<pre class=scheme>") (let ((f (get-filename))) (call-with-input-file/buffered f (lambda () (let loop () (let ((c (snoop-actual-char))) (unless (eof-object? c) (scm-output-next-chunk) (loop))))))) (emit "</pre>") (egroup) (do-para)))

(define do-scm-set-filename (lambda () (let ((f (get-filename))) (if *scm-port* (close-output-port *scm-port*)) (ensure-file-deleted f) (set! *scm-port* (open-output-file f)))))

(define scm-ensure-output-port (lambda () (unless *scm-port* (let ((output-file (string-append *jobname* ".scm"))) (ensure-file-deleted output-file) (set! *scm-port* (open-output-file output-file))))))

(define do-scm-dribble (lambda () (scm-ensure-output-port) (fluid-let ((*scm-dribbling?* #t)) (do-scm #f)) (newline *scm-port*)))

(define do-scm-write-to-file (lambda () (scm-ensure-output-port) (ignorespaces) (let ((d (get-actual-char))) (case d ((#\{) (let loop ((nesting 0)) (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote do-scm-write-to-file) "Eof inside verbatim")) ((char=? c *esc-char-verb*) (write-char c *scm-port*) (write-char (get-actual-char) *scm-port*) (loop nesting)) ((char=? c #\{) (write-char c *scm-port*) (loop (+ nesting 1))) ((char=? c #\}) (unless (= nesting 0) (write-char c *scm-port*) (loop (- nesting 1)))) (else (write-char c *scm-port*) (loop nesting)))))) (else (let loop () (let ((c (get-actual-char))) (cond ((eof-object? c) (terror (quote do-scm-write-to-file) "Eof inside verbatim")) ((char=? c d) (quote done)) (else (write-char c *scm-port*) (loop))))))))))

(define do-scm-slatex-lines (lambda (env display? result?) (let ((endenv (string-append "\\end" env)) (in-table? (and (not (null? *tabular-stack*)) (memv (car *tabular-stack*) (quote (block figure table)))))) (fluid-let ((*ligatures?* #f) (*not-processing?* #t)) (munched-a-newline?) (cond (display? (do-end-para)) (in-table? (emit "</td><td>"))) (bgroup) (emit "<div align=left><pre class=scheme") (when result? (emit "response")) (emit ">") (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-scm-slatex-lines) "Eof inside " env)) ((char=? c #\newline) (get-actual-char) (scm-emit-html-char c) (cond ((not *slatex-like-comments?*) #f) ((char=? (snoop-actual-char) #\;) (get-actual-char) (if (char=? (snoop-actual-char) #\;) (toss-back-char #\;) (scm-output-slatex-comment)))) (loop)) ((char=? c *esc-char*) (let ((x (get-ctl-seq))) (cond ((string=? x endenv) #t) ((string=? x "\\end") (let ((g (get-grouped-environment-name-if-any))) (if (and g (string=? g env)) (egroup) (begin (scm-output-token x) (when g (scm-output-token "{") (scm-output-token g) (scm-output-token "}")) (loop))))) (else (scm-output-token x) (loop))))) (else (scm-output-next-chunk) (loop))))) (emit "</pre></div>") (egroup) (cond (display? (do-para)) (in-table? (emit "</td><td>")))))))

(define string-is-all-dots? (lambda (s) (let ((n (string-length s))) (let loop ((i 0)) (cond ((>= i n) #t) ((char=? (string-ref s i) #\.) (loop (+ i 1))) (else #f))))))

(define string-is-flanked-by-stars? (lambda (s) (let ((n (string-length s))) (and (>= n 3) (char=? (string-ref s 0) #\*) (char=? (string-ref s (- n 1)) #\*)))))

(define string-starts-with-hash? (lambda (s) (char=? (string-ref s 0) #\#)))

(define scm-get-type (lambda (s) (cond ((table-get *scm-special-symbols* s) (quote special-symbol)) ((member/string-ci=? s *scm-keywords*) (quote keyword)) ((member/string-ci=? s *scm-constants*) (quote builtin)) ((string-is-flanked-by-stars? s) (quote global)) (else (let ((colon (string-index s #\:))) (cond (colon (if (= colon 0) (quote selfeval) #f)) ((string-is-all-dots? s) (quote background)) ((string-starts-with-hash? s) (quote selfeval)) ((string->number s) (quote selfeval)) (else #f)))))))

(define eat-star (lambda () (let ((c (snoop-actual-char))) (if (and (not (eof-object? c)) (char=? c #\*)) (get-actual-char) #f))))

(define do-cr (lambda (z) (ignorespaces) (let ((top-tabular (if (pair? *tabular-stack*) (car *tabular-stack*) (quote nothing)))) (case top-tabular ((tabular) (get-bracketed-text-if-any) (egroup) (emit "</td></tr>") (emit-newline) (emit "<tr><td valign=top ") (do-tabular-multicolumn)) ((ruled-table) (emit "</td></tr><tr><td>") (emit-newline)) ((minipage tabbing) (get-bracketed-text-if-any) (emit "<br>") (emit-newline)) ((eqalign pmatrix) (unless (char=? (snoop-actual-char) #\}) (emit "</td></tr><tr><td>") (emit-newline))) ((header) (emit #\space)) (else (when (and (eqv? *tex-format* (quote latex)) (string=? z "\\\\")) (get-bracketed-text-if-any) (let ((c (snoop-actual-char))) (when (and (not (eof-object? c)) (char=? c #\*)) (get-actual-char))) (emit "<br>") (emit-newline)))))))

(define do-ruledtable (lambda () (set! *tabular-stack* (cons (quote ruled-table) *tabular-stack*)) (emit "<table border=2><tr><td>") (emit-newline)))

(define do-endruledtable (lambda () (emit-newline) (emit "</td></tr></table>") (emit-newline) (set! *tabular-stack* (cdr *tabular-stack*))))

(define do-tabular (lambda () (do-end-para) (get-bracketed-text-if-any) (bgroup) (add-postlude-to-top-frame (let ((old-math-mode? *math-mode?*) (old-in-display-math? *in-display-math?*)) (set! *math-mode?* #f) (set! *in-display-math?* #f) (lambda () (set! *math-mode?* old-math-mode?) (set! *in-display-math?* old-in-display-math?)))) (let ((border-width (if (string-index (get-group) #\|) 1 0))) (set! *tabular-stack* (cons (quote tabular) *tabular-stack*)) (emit "<table border=") (emit border-width) (emit "><tr><td valign=top ") (do-tabular-multicolumn))))

(define do-end-tabular (lambda () (egroup) (do-end-para) (emit "</td></tr></table>") (set! *tabular-stack* (cdr *tabular-stack*)) (egroup)))

(define do-tabular-colsep (lambda () (egroup) (emit "</td><td valign=top ") (do-tabular-multicolumn)))

(define do-tabular-multicolumn (lambda () (let loop () (ignorespaces) (let ((c (snoop-actual-char))) (if (char=? c #\\) (let ((x (get-ctl-seq))) (cond ((string=? x "\\hline") (loop)) ((string=? x "\\multicolumn") (let ((n (ungroup (get-token)))) (get-token) (emit " colspan=") (emit n))) (else (toss-back-char *invisible-space*) (toss-back-string x))))))) (emit ">") (bgroup)))

(define do-ruledtable-colsep (lambda () (emit-newline) (emit "</td><td") (ignorespaces) (let ((c (snoop-actual-char))) (if (char=? c #\\) (let ((x (get-ctl-seq))) (if (string=? x "\\multispan") (let ((n (ungroup (get-token)))) (emit " colspan=") (emit n)) (toss-back-string x))))) (emit ">") (emit-newline)))

(define do-tex-logo (lambda () (emit "T<small>E</small>X")))

(define do-latex-logo (lambda () (emit "L<small>A</small>") (do-tex-logo)))

(define do-latex2e-logo (lambda () (do-latex-logo) (emit "2<small>E</small>")))

(define do-romannumeral (lambda (upcase?) (emit (number->roman (get-integer 10) upcase?))))

(define set-latex-counter (lambda (add?) (let* ((counter-name (string-trim-blanks (ungroup (get-group)))) (new-value (string->number (string-trim-blanks (ungroup (get-group)))))) (cond ((string=? counter-name "secnumdepth") (set-gcount! "\\secnumdepth" (if add? (+ new-value (get-gcount "\\secnumdepth")) new-value))) ((string=? counter-name "tocdepth") (set-gcount! "\\tocdepth" (if add? (+ new-value (get-gcount "\\tocdepth")) new-value))) ((table-get *dotted-counters* counter-name) => (lambda (counter) (set!counter.value counter (if add? (+ new-value (counter.value counter)) new-value)))) (else #f)))))

(define toss-back-line-as-group (lambda (s) (toss-back-char #\}) (toss-back-string s) (toss-back-char #\{)))

(define do-tex-prim (lambda (z) (cond ((find-def z) => (lambda (y) (let ((args (cadr y)) (expn (caddr y)) (opt-arg (cadddr y))) (case args ((:thunk) (expn)) ((:prim) (toss-back-string expn)) (else (expand-tex-macro args expn opt-arg)))))) ((section-ctl-seq? z) => (lambda (n) (do-heading n))) (*math-mode?* (do-math-ctl-seq z)) (else (trace-if *tracingcommands?* "Ignoring " z)))))

(define do-char (lambda () (emit-html-char (get-tex-char-spec))))

(define do-tex-char (lambda (c) (cond ((and *comment-char* (char=? c *comment-char*)) (do-comment)) ((or (memv #f *tex-if-stack*) (memv (quote ?) *tex-if-stack*)) #t) ((char=? c #\{) (bgroup)) ((char=? c #\}) (egroup)) ((char=? c #\$) (do-math)) ((char=? c #\-) (do-hyphen)) ((char=? c #\`) (do-lsquo)) ((char=? c #\') (do-rsquo)) ((char=? c #\~) (emit-nbsp 1)) ((or (char=? c #\<) (char=? c #\>) (char=? c #\")) (emit-html-char c)) ((char=? c #\&) (cond ((pair? *tabular-stack*) (do-end-para) (case (car *tabular-stack*) ((eqalign pmatrix) (emit "</td><td>")) ((tabular) (do-tabular-colsep)) ((ruled-table) (do-ruledtable-colsep)))) (else (emit-html-char c)))) ((char=? c #\|) (if (and (pair? *tabular-stack*) (eqv? (car *tabular-stack*) (quote ruled-table))) (do-ruledtable-colsep) (emit c))) ((char=? c #\newline) (do-newline)) ((char=? c #\space) (do-space)) ((char=? c *tab*) (do-tab)) (else (cond (*math-mode?* (case c ((#\^) (do-sup)) ((#\_) (do-sub)) ((#\+ #\=) (unless *math-script-mode?* (emit #\space)) (emit c) (unless *math-script-mode?* (emit #\space))) (else (if (and (char-alphabetic? c) (not *math-roman-mode?*)) (begin (emit "<em>") (emit c) (emit "</em>")) (emit c))))) ((and *in-small-caps?* (char-lower-case? c)) (emit "<font size=-2>") (emit (char-upcase c)) (emit "</font>")) (else (emit c)))))))

(define do-tex-ctl-seq-completely (lambda (x) (let ((z (resolve-defs x))) (cond ((not (eq? z x)) (tex2page-string z)) ((do-tex-prim (find-corresp-prim z)) => (lambda (y) (if (eqv? y (quote :encountered-undefined-command)) (emit x))))))))

(define inside-false-world? (lambda () (or (memv #f *tex-if-stack*) (memv (quote ?) *tex-if-stack*))))

(define do-tex-ctl-seq (lambda (x) (trace-if *tracingcommands?* x) (let ((z (resolve-defs x))) (cond ((not (eq? z x)) (trace-if *tracingmacros?* "    --> " z) (toss-back-char *invisible-space*) (toss-back-string z)) ((and *doing-urlh?* (string=? z "\\\\")) (egroup)) ((and (inside-false-world?) (not (if-aware-ctl-seq? z))) #f) ((string=? z "\\enddocument") (probably-latex) (quote :encountered-bye)) ((string=? z "\\bye") (quote :encountered-bye)) ((string=? z "\\endinput") (quote :encountered-endinput)) ((find-count z) (do-count= z #f)) ((find-toks z) (do-toks= z #f)) ((find-dimen z) (do-dimen= z #f)) (else (do-tex-prim z))))))

(define generate-html (lambda () (let loop () (let ((c (snoop-actual-char))) (cond ((eof-object? c) #t) ((resolve-chardefs c) => (lambda (d) (get-actual-char) (toss-back-char *invisible-space*) (toss-back-string d) (loop))) ((char=? c *esc-char*) (let ((r (do-tex-ctl-seq (get-ctl-seq)))) (case r ((:encountered-endinput) #t) ((:encountered-bye) (quote :encountered-bye)) (else (loop))))) (else (get-actual-char) (do-tex-char c) (loop)))))))

(define do-if-file-exists (lambda () (let* ((file (ungroup (get-group))) (thene (ungroup (get-group))) (elsee (ungroup (get-group)))) (toss-back-string (if (file-exists? (actual-tex-filename file)) thene elsee)))))

(define check-input-file-timestamp (lambda (f) (unless (or *inputting-boilerplate?* (> *html-only* 0) (and (>= (string-length f) 3) (char=? (string-ref f 0) #\.) (char=? (string-ref f 1) #\/))) (update-last-modification-time f))))

(define do-input-if-file-exists (lambda () (let* ((f (ungroup (get-group))) (then-txt (ungroup (get-group))) (else-txt (ungroup (get-group)))) (tex2page-string (if (tex2page-file (actual-tex-filename f)) then-txt else-txt)))))

(define do-input (lambda () (ignorespaces) (let ((f (let ((c (snoop-actual-char))) (if (and (char? c) (char=? c #\{)) (ungroup (get-group)) (get-filename))))) (let ((boilerplate-index *inputting-boilerplate?*)) (if (eqv? *inputting-boilerplate?* 0) (set! *inputting-boilerplate?* #f)) (fluid-let ((*inputting-boilerplate?* (and boilerplate-index (+ boilerplate-index 1)))) (unless (or (latex-style-file? f) (member/string-ci=? f (quote ("eplain" "eplain.tex" "tex2page" "tex2page.tex")))) (do-input-check-bye (actual-tex-filename f))))))))

(define do-input-check-bye (lambda (f) (let ((r (tex2page-file f))) (when (and (eqv? f *main-tex-file*) (not (eqv? r (quote :encountered-bye)))) (trace-if #t "Added missing \\end")) r)))

(define tex2page-file (lambda (f) (write-log #\space) (write-log #\() (write-log f) (let ((r (cond ((file-exists? f) (let ((gen-file? (let ((e (file-extension f))) (and e (member/string-ci=? e (quote (".t2p" ".bbl" ".ind"))))))) (unless gen-file? (check-input-file-timestamp f)) (set! f (tex2page-massage-file f)) (let ((r (call-with-input-file/buffered f (lambda () (trace-if *tracingcommands?* "Inputting file " f) (generate-html))))) r))) (else (write-log #\space) (write-log "not found") #f)))) (write-log #\)) r)))

(define do-includeonly (lambda () (ignorespaces) (when (eq? *includeonly-list* #t) (set! *includeonly-list* (quote ()))) (let ((c (get-actual-char))) (when (or (eof-object? c) (not (char=? c #\{))) (terror (quote do-includeonly)))) (fluid-let ((*filename-delims* (cons #\} (cons #\, *filename-delims*)))) (let loop () (ignorespaces) (let ((c (snoop-actual-char))) (cond ((eof-object? c) (terror (quote do-includeonly))) ((and *comment-char* (char=? c *comment-char*)) (eat-till-eol) (ignorespaces) (loop)) ((char=? c #\,) (get-actual-char) (loop)) ((char=? c #\}) (get-actual-char)) ((ormap (lambda (d) (char=? c d)) *filename-delims*) (terror (quote do-includeonly))) (else (set! *includeonly-list* (cons (get-filename) *includeonly-list*)) (loop))))))))

(define do-include (lambda () (let ((f (ungroup (get-group)))) (when (or (eq? *includeonly-list* #t) (ormap (lambda (i) (string=? f i)) *includeonly-list*)) (fluid-let ((*subjobname* (file-stem-name f)) (*img-file-count* 0) (*imgdef-file-count* 0)) (do-input-check-bye (actual-tex-filename f)))))))

(define do-evalh (lambda (s) (call-with-input-string s (lambda (i) (let loop () (let ((x (read i))) (unless (eof-object? x) (eval1 x) (loop))))))))

(define do-evalt (lambda (i) (set! *eval-file-count* (+ *eval-file-count* 1)) (set! *eval-file-stem* (string-append *jobname* *eval-file-suffix* (number->string *eval-file-count*))) (let ((scratch-tex-file (string-append *eval-file-stem* ".tex"))) (fluid-let ((*after-eval* #f)) (ensure-file-deleted scratch-tex-file) (with-output-to-file scratch-tex-file (lambda () (do-evalh i))) (when *after-eval* (*after-eval*)) (move-aux-files-to-aux-dir *eval-file-stem*)))))

(define do-eval (lambda (fmts) (when (> *html-only* 0) (set! fmts (quote html))) (let ((scheme-expr (ungroup (get-group)))) (unless (inside-false-world?) ((case fmts ((html) do-evalh) ((both) do-evalt)) scheme-expr)))))

(define expand-ctl-seq-into-string (lambda (cs) (let ((tmp-port (open-output-string))) (fluid-let ((*html* tmp-port)) (do-tex-ctl-seq cs)) (get-output-string tmp-port))))

(define tex-string->html-string (lambda (ts) (let ((tmp-port (open-output-string))) (fluid-let ((*html* tmp-port)) (tex2page-string ts)) (get-output-string tmp-port))))

(define call-bibtex-makeindex-if-necessary (lambda () (when (and (member "bibtex" *external-programs*) (file-exists? (string-append *aux-dir/* *jobname* *bib-aux-file-suffix* ".aux")) (not (file-exists? (string-append *aux-dir/* *jobname* *bib-aux-file-suffix* ".bbl")))) (write-log "Running: bibtex ") (write-log *aux-dir/*) (write-log *jobname*) (write-log *bib-aux-file-suffix*) (write-log #\space) (system (string-append "bibtex " *aux-dir/* *jobname* *bib-aux-file-suffix*)) (unless (file-exists? (string-append *jobname* *bib-aux-file-suffix* ".bbl")) (write-log " ... failed; try manually")) (write-log #\newline)) (when (and (member "makeindex" *external-programs*) (file-exists? (string-append *aux-dir/* *jobname* *index-file-suffix* ".idx")) (not (file-exists? (string-append *aux-dir/* *jobname* *index-file-suffix* ".ind")))) (write-log "Running: makeindex ") (write-log *aux-dir/*) (write-log *jobname*) (write-log *index-file-suffix*) (write-log #\space) (system (string-append "makeindex " *aux-dir/* *jobname* *index-file-suffix*)) (unless (file-exists? (string-append *aux-dir/* *jobname* *index-file-suffix* ".ind")) (write-log " ... failed; try manually")) (write-log #\newline))))

(define first-file-that-exists (lambda ff (ormap (lambda (f) (and f (file-exists? f) f)) ff)))

(define file-in-home (lambda (f) (let ((home (getenv "HOME"))) (and home (let ((slash-already? (let ((n (string-length home))) (and (>= n 0) (let ((c (string-ref home (- n 1)))) (or (char=? c #\/) (char=? c #\\))))))) (string-append home (if slash-already? "" "/") f))))))

(define make-target-dir (lambda () (let ((hdir-file (first-file-that-exists (string-append *jobname* ".hdir") ".tex2page.hdir" (file-in-home ".tex2page.hdir")))) (when hdir-file (let ((hdir (call-with-input-file/buffered hdir-file (lambda () (get-filename))))) (unless (= (string-length hdir) 0) (case *operating-system* ((unix) (system (string-append "mkdir -p " hdir)) (system (string-append "touch " hdir "/probe"))) ((windows) (system (string-append "mkdir " hdir)) (system (string-append "echo probe > " hdir "\\probe")))) (let ((probe (string-append hdir "/probe"))) (when (file-exists? probe) (ensure-file-deleted probe) (set! *aux-dir* hdir) (set! *aux-dir/* (string-append *aux-dir* "/"))))))))))

(define move-aux-files-to-aux-dir (lambda (f) (when (and *aux-dir* (or (file-exists? (string-append f ".tex")) (file-exists? (string-append f ".scm")) (file-exists? (string-append f *img-file-extn*)))) (case *operating-system* ((unix) (system (string-append "mv " f ".* " *aux-dir*))) ((windows) (system (string-append "copy " f ".* " *aux-dir*)) (when (or (file-exists? (string-append f ".tex")) (file-exists? (string-append f ".scm"))) (system (string-append "del " f ".*"))))))))

(define load-aux-file (lambda () (let ((label-file (string-append *aux-dir/* *jobname* *label-file-suffix* ".scm"))) (when (file-exists? label-file) (load-tex2page-data-file label-file) (delete-file label-file))) (unless (string=? *jobname* "texput") (let ((jobname-aux (string-append "texput" *aux-file-suffix* ".scm"))) (when (file-exists? jobname-aux) (delete-file jobname-aux)))) (let ((aux-file (string-append *aux-dir/* *jobname* *aux-file-suffix* ".scm"))) (when (file-exists? aux-file) (load-tex2page-data-file aux-file) (delete-file aux-file)) (set! *aux-port* (open-output-file aux-file)) (when (eqv? *tex-format* (quote latex)) (!definitely-latex) (write-aux (quasiquote (!definitely-latex)))) (unless (null? *toc-list*) (set! *toc-list* (reverse! *toc-list*))) (unless (null? *stylesheets*) (set! *stylesheets* (reverse! *stylesheets*))) (unless (null? *html-head*) (set! *html-head* (reverse! *html-head*))))))

(define update-last-modification-time (lambda (f) (when *timestamp?* (let ((s (file-modification-time f))) (when (and s (or (not *last-modification-time*) (> s *last-modification-time*))) (!last-modification-time s) (if (> *html-page-count* 1) (flag-missing-piece (quote last-modification-time))))))))

(define probably-latex (lambda () (set! *latex-probability* (+ *latex-probability* 1)) (if (>= *latex-probability* 2) (unless (eqv? *tex-format* (quote latex)) (!definitely-latex) (write-aux (quasiquote (!definitely-latex)))))))

(define !toc-page (lambda (p) (set! *toc-page* p)))

(define !index-page (lambda (p) (set! *index-page* p)))

(define !toc-entry (lambda (level number page label header) (set! *toc-list* (cons (make-tocentry (quote level) level (quote number) number (quote page) page (quote label) label (quote header) header) *toc-list*))))

(define !label (lambda (label html-page label-name label-value) (table-put! *label-table* label (vector html-page label-name label-value))))

(define !last-modification-time (lambda (s) (set! *last-modification-time* s)))

(define !last-page-number (lambda (n) (set! *last-page-number* n)))

(define !using-chapters (lambda () (set! *using-chapters?* #t)))

(define !definitely-latex (lambda () (set! *tex-format* (quote latex)) (when (< (get-gcount "\\secnumdepth") -1) (set-gcount! "\\secnumdepth" 3))))

(define !using-external-program (lambda (x) (set! *external-programs* (cons x *external-programs*))))

(define fully-qualified-url? (lambda (u) (or (substring? "//" u) (char=? (string-ref u 0) #\/))))

(define fully-qualified-pathname? (lambda (f) (let ((n (string-length f))) (if (= n 0) #t (let ((c0 (string-ref f 0))) (if (char=? c0 #\/) #t (if (or (= n 1) (not (eqv? *operating-system* (quote windows)))) #f (if (and (char-alphabetic? c0) (char=? (string-ref f 1) #\:)) #t #f))))))))

(define ensure-url-reachable (lambda (f) (if (and (not (fully-qualified-url? f)) *aux-dir*) (let ((real-f (string-append *aux-dir* (if (eq? *operating-system* (quote windows)) "\\" "/") f))) (when (and (file-exists? f) (not (file-exists? real-f)) (not (substring? "/" f))) (case *operating-system* ((unix) (system (string-append "cp -p " f " " real-f))) ((windows) (system (string-append "copy/b " f " " real-f))))) real-f) f)))

(define !stylesheet (lambda (css) (if (file-exists? (ensure-url-reachable css)) (set! *stylesheets* (cons css *stylesheets*)) (begin (write-log "! Can't find stylesheet ") (write-log css) (write-log #\newline)))))

(define !html-head (lambda (s) (set! *html-head* (cons s *html-head*))))

(define !default-title (lambda (tit) (unless *title* (set! *title* tit))))

(define !preferred-title (lambda (tit) (set! *title* tit)))

(define !infructuous-calls-to-tex2page (lambda (n) (set! *infructuous-calls-to-tex2page* n)))

(define load-tex2page-data-file (lambda (f) (if (file-exists? f) (call-with-input-file f (lambda (i) (let loop () (let ((e (read i))) (unless (eof-object? e) (apply (case (car e) ((!default-title) !default-title) ((!definitely-latex) !definitely-latex) ((!external-labels) !external-labels) ((!html-head) !html-head) ((!index-page) !index-page) ((!infructuous-calls-to-tex2page) !infructuous-calls-to-tex2page) ((!label) !label) ((!last-modification-time) !last-modification-time) ((!last-page-number) !last-page-number) ((!preferred-title) !preferred-title) ((!stylesheet) !stylesheet) ((!toc-entry) !toc-entry) ((!toc-page) !toc-page) ((!using-chapters) !using-chapters) ((!using-external-program) !using-external-program)) (cdr e)) (loop)))))))))

(define tex2page-string (lambda (s) (call-with-input-string/buffered s (lambda () (generate-html)))))

(define tex2page-massage-file (lambda (f) f))

(define tex2page-help (lambda (not-a-file) (write-aux (quasiquote (!infructuous-calls-to-tex2page (unquote (+ *infructuous-calls-to-tex2page* 1))))) (unless (or (string=? not-a-file "--help") (string=? not-a-file "--missing-arg") (string=? not-a-file "--version")) (write-log "! I can't find file `") (write-log not-a-file) (write-log "'.") (write-log #\newline)) (cond ((string=? not-a-file "--version") (write-log "Copyright (c) 1997-2002, Dorai Sitaram.\n\nPermission to distribute and use this work for any\npurpose is hereby granted provided this copyright\nnotice is included in the copy.  This work is provided\nas is, with no warranty of any kind.\n\nFor more information on TeX2page, please see") (write-log #\space) (write-log *tex2page-website*) (write-log #\.) (write-log #\newline)) ((string=? not-a-file "--help") (write-log "\nThe command tex2page converts a (La)TeX document into\nWeb pages.  Call tex2page with the relative or full\npathname of the main (La)TeX file.  \n\nThe relative pathnames of the main and any subsidiary\n(La)TeX files are resolved against the current working\ndirectory and the list of directories in the\nenvironment variable TIIPINPUTS.  The file extension is\noptional if it is `.tex'. \n\nThe output Web files are generated in the current\ndirectory by default.  An alternate location can be\nspecified in  <jobname>.hdir, tex2page.hdir, or\n~/tex2page.hdir, where <jobname> is the basename of the\nmain (La)TeX file.  \n\nFor more information on tex2page, please see") (write-log #\space) (write-log *tex2page-website*) (write-log #\.) (write-log #\newline)) (else (when (string=? not-a-file "--missing-arg") (write-log "! Missing command-line argument.") (write-log #\newline)) (write-log "No pages of output.") (write-log #\newline) (when (> *infructuous-calls-to-tex2page* 0) (write-log "You have called TeX2page") (write-log #\space) (write-log (+ *infructuous-calls-to-tex2page* 1)) (write-log #\space) (write-log "times without a valid input document.") (write-log #\newline)) (when (>= *infructuous-calls-to-tex2page* 4) (write-log "I can't go on meeting you like this.") (write-log #\newline)) (write-log "Do you need help using TeX2page?\nTry the commands\n  tex2page --help\n  tex2page --version") (write-log #\newline))) (close-output-port *aux-port*) (close-output-port *log-port*)))

(define non-fatal-error (lambda ss (emit-link-start (string-append *jobname* ".hlog")) (emit "[") (for-each emit-html-string ss) (emit "]") (emit-link-stop)))

(define do-math-ctl-seq (lambda (s) (cond ((find-math-def s) => (lambda (x) (x))) (else (emit (substring s 1 (string-length s)))))))

(define tex-def-math-prim (lambda (cs th) (set!texframe.definitions *math-primitive-texframe* (cons (cons cs th) (texframe.definitions *math-primitive-texframe*)))))

(define make-reusable-math-image-as-needed (lambda (cs . expn) (let ((expn (if (null? expn) cs (car expn)))) (tex-def-math-prim cs (lambda () (tex2page-string (string-append "\\global\\imgdef" cs "{$" expn "$}")) (tex2page-string cs))))))

(quote (tex-def-math-prim "\\alpha" (lambda () (tex2page-string "\\global\\imgdef\\alpha{$\\alpha$}") (tex2page-string "\\alpha"))))

(tex-def-math-prim "\\beta" (lambda () (emit "<i>&szlig;</i>")))

(quote (tex-def-math-prim "\\gamma" (lambda () (tex2page-string "\\global\\imgdef\\gamma{$\\gamma$}") (tex2page-string "\\gamma"))))

(quote (tex-def-math-prim "\\delta" (lambda () (tex2page-string "\\global\\imgdef\\delta{$\\delta$}") (tex2page-string "\\delta"))))

(quote (tex-def-math-prim "\\epsilon" (lambda () (tex2page-string "\\global\\imgdef\\epsilon{$\\epsilon$}") (tex2page-string "\\epsilon"))))

(quote (tex-def-math-prim "\\zeta" (lambda () (tex2page-string "\\global\\imgdef\\zeta{$\\zeta$}") (tex2page-string "\\zeta"))))

(quote (tex-def-math-prim "\\eta" (lambda () (tex2page-string "\\global\\imgdef\\zeta{$\\zeta$}") (tex2page-string "\\zeta"))))

(quote (tex-def-math-prim "\\theta" (lambda () (tex2page-string "\\global\\imgdef\\theta{$\\theta$}") (tex2page-string "\\theta"))))

(tex-def-math-prim "\\iota" (lambda () (emit "<i><small>I</small></i>")))

(tex-def-math-prim "\\kappa" (lambda () (emit "<i><small>K</small></i>")))

(quote (tex-def-math-prim "\\lambda" (lambda () (tex2page-string "\\global\\imgdef\\lambda{$\\lambda$}") (tex2page-string "\\lambda"))))

(tex-def-math-prim "\\mu" (lambda () (emit "&micro;")))

(quote (tex-def-math-prim "\\nu" (lambda () (tex2page-string "\\global\\imgdef\\nu{$\\nu$}") (tex2page-string "\\nu"))))

(quote (tex-def-math-prim "\\xi" (lambda () (tex2page-string "\\global\\imgdef\\xi{$\\xi$}") (tex2page-string "\\xi"))))

(quote (tex-def-math-prim "\\pi" (lambda () (tex2page-string "\\global\\imgdef\\pi{$\\pi$}") (tex2page-string "\\pi"))))

(quote (tex-def-math-prim "\\rho" (lambda () (tex2page-string "\\global\\imgdef\\rho{$\\rho$}") (tex2page-string "\\rho"))))

(quote (tex-def-math-prim "\\sigma" (lambda () (tex2page-string "\\global\\imgdef\\sigma{$\\sigma$}") (tex2page-string "\\sigma"))))

(quote (tex-def-math-prim "\\tau" (lambda () (tex2page-string "\\global\\imgdef\\tau{$\\tau$}") (tex2page-string "\\tau"))))

(quote (tex-def-math-prim "\\phi" (lambda () (tex2page-string "\\global\\imgdef\\phi{$\\phi$}") (tex2page-string "\\phi"))))

(quote (tex-def-math-prim "\\varphi" (lambda () (tex2page-string "\\global\\imgdef\\varphi{$\\varphi$}") (tex2page-string "\\varphi"))))

(quote (tex-def-math-prim "\\chi" (lambda () (tex2page-string "\\global\\imgdef\\chi{$\\chi$}") (tex2page-string "\\chi"))))

(quote (tex-def-math-prim "\\psi" (lambda () (tex2page-string "\\global\\imgdef\\psi{$\\psi$}") (tex2page-string "\\psi"))))

(quote (tex-def-math-prim "\\omega" (lambda () (tex2page-string "\\global\\imgdef\\omega{$\\omega$}") (tex2page-string "\\omega"))))

(quote (tex-def-math-prim "\\Phi" (lambda () (tex2page-string "\\global\\imgdef\\Phi{$\\Phi$}") (tex2page-string "\\Phi"))))

(quote (tex-def-math-prim "\\Omega" (lambda () (tex2page-string "\\global\\imgdef\\Omega{$\\Omega$}") (tex2page-string "\\Omega"))))

(tex-def-math-prim "\\ell" (lambda () (emit "<i>l</i>")))

(tex-def-math-prim "\\partial" (lambda () (emit "&eth;")))

(tex-def-math-prim "\\prime" (lambda () (emit "/")))

(tex-def-math-prim "\\emptyset" (lambda () (emit "&Oslash;")))

(tex-def-math-prim "\\|" (lambda () (emit "||")))

(tex-def-math-prim "\\backslash" (lambda () (emit "\\")))

(tex-def-math-prim "\\forall" (lambda () (emit "<b>A</b>")))

(tex-def-math-prim "\\exists" (lambda () (emit "<b>E</b>")))

(tex-def-math-prim "\\neg" (lambda () (emit "&not;")))

(tex-def-math-prim "\\lnot" (find-math-def "\\neg"))

(tex-def-math-prim "\\sharp" (lambda () (emit "#")))

(tex-def-math-prim "\\pm" (lambda () (emit "&plusmn;")))

(tex-def-math-prim "\\setminus" (lambda () (emit "\\")))

(tex-def-math-prim "\\cdot" (lambda () (emit " &middot; ")))

(tex-def-math-prim "\\cdots" (lambda () (emit "<tt>&middot;&middot;&middot;</tt>")))

(tex-def-math-prim "\\times" (lambda () (emit "&times;")))

(tex-def-math-prim "\\ast" (lambda () (emit #\*)))

(tex-def-math-prim "\\star" (find-math-def "\\ast"))

(tex-def-math-prim "\\circ" (lambda () (emit "<small>o</small>")))

(tex-def-math-prim "\\bullet" (lambda () (emit *html-bull*)))

(tex-def-math-prim "\\vee" (lambda () (emit "V")))

(tex-def-math-prim "\\lor" (find-math-def "\\vee"))

(tex-def-math-prim "\\wedge" (lambda () (emit "^")))

(tex-def-math-prim "\\land" (find-math-def "\\wedge"))

(tex-def-math-prim "\\dagger" (lambda () (emit *html-dagger*)))

(tex-def-math-prim "\\dag" (find-math-def "\\dagger"))

(tex-def-math-prim "\\ddagger" (lambda () (emit *html-ddagger*)))

(tex-def-math-prim "\\ddag" (find-math-def "\\ddagger"))

(tex-def-math-prim "\\le" (lambda () (emit "<u>&lt;</u>")))

(tex-def-math-prim "\\leq" (find-math-def "\\le"))

(tex-def-math-prim "\\ll" (lambda () (emit "&lt;&lt;")))

(tex-def-math-prim "\\ge" (lambda () (emit "<u>&gt;</u>")))

(tex-def-math-prim "\\geq" (find-math-def "\\ge"))

(tex-def-math-prim "\\gg" (lambda () (emit "&gt;&gt;")))

(tex-def-math-prim "\\equiv" (lambda () (emit "<u>=</u>")))

(tex-def-math-prim "\\sim" (lambda () (emit "~")))

(tex-def-math-prim "\\simeq" (lambda () (emit "<u>~</u>")))

(tex-def-math-prim "\\mid" (lambda () (emit "|")))

(tex-def-math-prim "\\vert" (find-math-def "\\mid"))

(tex-def-math-prim "\\parallel" (lambda () (emit "||")))

(tex-def-math-prim "\\Vert" (find-math-def "\\parallel"))

(tex-def-math-prim "\\perp" (lambda () (emit "<u>|</u>")))

(tex-def-math-prim "\\leftarrow" (lambda () (emit "&lt;--")))

(tex-def-math-prim "\\gets" (find-math-def "\\leftarrow"))

(tex-def-math-prim "\\Leftarrow" (lambda () (emit "&lt;==")))

(tex-def-math-prim "\\rightarrow" (lambda () (emit "-->")))

(tex-def-math-prim "\\to" (find-math-def "\\rightarrow"))

(tex-def-math-prim "\\Rightarrow" (lambda () (emit "==&gt;")))

(tex-def-math-prim "\\leftrightarrow" (lambda () (emit "&lt;--&gt;")))

(tex-def-math-prim "\\Leftrightarrow" (lambda () (emit "&lt;==&gt;")))

(tex-def-math-prim "\\longleftarrow" (lambda () (emit "&lt;---")))

(tex-def-math-prim "\\Longleftarrow" (lambda () (emit "&lt;===")))

(tex-def-math-prim "\\longrightarrow" (lambda () (emit "---&gt;")))

(tex-def-math-prim "\\Longrightarrow" (lambda () (emit "===&gt;")))

(tex-def-math-prim "\\longleftrightarrow" (lambda () (emit "&lt;---&gt;")))

(tex-def-math-prim "\\Longleftrightarrow" (lambda () (emit "&lt;===&gt;")))

(tex-def-math-prim "\\iff" (find-math-def "\\Longleftrightarrow"))

(tex-def-math-prim "\\uparrow" (lambda () (emit "<table><tr><td>^</td></tr><tr><td>|</td></tr></table>")))

(tex-def-math-prim "\\lbrack" (lambda () (emit "[")))

(tex-def-math-prim "\\lbrace" (lambda () (emit "{")))

(tex-def-math-prim "\\{" (find-math-def "\\lbrack"))

(tex-def-math-prim "\\langle" (lambda () (emit "&lt;")))

(tex-def-math-prim "\\rbrack" (lambda () (emit "]")))

(tex-def-math-prim "\\rbrace" (lambda () (emit "}")))

(tex-def-math-prim "\\}" (find-math-def "\\rbrack"))

(tex-def-math-prim "\\rangle" (lambda () (emit "&gt;")))

(tex-def-math-prim "\\eqalign" do-eqalign)

(tex-def-math-prim "\\frac" do-frac)

(tex-def-math-prim "\\pmatrix" do-pmatrix)

(tex-def-math-prim "\\," do-space)

(tex-def-math-prim "\\;" do-space)

(tex-def-math-prim "\\!" do-relax)

(tex-def-math-prim "\\mathbf" do-relax)

(tex-def-math-prim "\\mathrm" do-relax)

(tex-def-math-prim "\\over" (lambda () (emit "/")))

(tex-def-math-prim "\\sqrt" (lambda () (emit "(") (tex2page-string (get-token)) (emit ")<sup>1/2</sup>")))

(tex-def-math-prim "\\left" (lambda () #f))

(tex-def-math-prim "\\right" (lambda () #f))

(tex-def-prim "\\AA" (lambda () (emit "&Aring;")))

(tex-def-prim "\\aa" (lambda () (emit "&aring;")))

(tex-def-prim "\\addtocounter" (lambda () (set-latex-counter #t)))

(tex-def-prim "\\advance" (lambda () (do-advance #f)))

(tex-def-prim "\\advancetally" (lambda () (do-advancetally #f)))

(tex-def-prim "\\AE" (lambda () (emit "&AElig;")))

(tex-def-prim "\\ae" (lambda () (emit "&aelig;")))

(tex-def-prim "\\aftergroup" do-aftergroup)

(tex-def-prim "\\alltt" do-alltt)

(tex-def-prim "\\appendix" do-appendix)

(tex-def-prim "\\appendixname" (lambda () (emit "Appendix ")))

(tex-def-prim "\\author" do-author)

(tex-def-prim "\\b" (lambda () (do-diacritic "a")))

(tex-def-prim "\\begin" do-begin)

(tex-def-prim "\\bgroup" bgroup)

(tex-def-prim "\\beginsection" do-beginsection)

(tex-def-prim "\\bf" (lambda () (do-switch "\\bf")))

(tex-def-prim "\\bgcolor" (lambda () (do-switch "\\bgcolor")))

(tex-def-prim "\\bibitem" do-bibitem)

(tex-def-prim "\\bibliography" do-bibliography)

(tex-def-prim "\\bibliographystyle" do-bibliographystyle)

(tex-def-prim "\\bigbreak" (lambda () (do-bigskip "\\bigbreak")))

(tex-def-prim "\\bigskip" (lambda () (do-bigskip "\\bigskip")))

(tex-def-prim "\\break" (lambda () (emit "<br>")))

(tex-def-prim "\\c" (lambda () (do-diacritic "cedil")))

(tex-def-prim "\\caption" do-caption)

(tex-def-prim "\\catcode" do-catcode)

(tex-def-prim "\\center" (lambda () (do-block "\\center")))

(tex-def-prim "\\centerline" (lambda () (do-function "\\centerline")))

(tex-def-prim "\\chapter" (lambda () (!using-chapters) (write-aux (quasiquote (!using-chapters))) (when (and (eqv? *tex-format* (quote latex)) (< (get-gcount "\\secnumdepth") -1)) (set-gcount! "\\secnumdepth" 2)) (do-heading 0)))

(tex-def-prim "\\chaptername" (lambda () (emit "Chapter ")))

(tex-def-prim "\\char" do-char)

(tex-def-prim "\\cite" do-cite)

(tex-def-prim "\\color" (lambda () (do-switch "\\color")))

(tex-def-prim "\\copyright" (lambda () (emit "&copy;")))

(tex-def-prim "\\CR" (lambda () (do-cr "\\CR")))

(tex-def-prim "\\cr" (lambda () (do-cr "\\cr")))

(tex-def-prim "\\csname" do-csname)

(tex-def-prim "\\cssblock" do-css-block)

(tex-def-prim "\\dag" (lambda () (emit *html-dagger*)))

(tex-def-prim "\\date" do-date)

(tex-def-prim "\\ddag" (lambda () (emit *html-ddagger*)))

(tex-def-prim "\\def" (lambda () (do-def #f)))

(tex-def-prim "\\defcsactive" do-defcsactive)

(tex-def-prim "\\defschememathescape" (lambda () (scm-set-math-escape #t)))

(tex-def-prim "\\description" (lambda () (do-end-para) (set! *tabular-stack* (cons (quote description) *tabular-stack*)) (emit "<dl><dt></dt><dd>")))

(tex-def-prim "\\discretionary" do-discretionary)

(tex-def-prim "\\displaymath" (lambda () (do-latex-env-as-image "displaymath" (quote display))))

(tex-def-prim "\\divide" (lambda () (do-divide #f)))

(tex-def-prim "\\document" probably-latex)

(tex-def-prim "\\documentclass" do-documentclass)

(tex-def-prim "\\dontuseimgforhtmlmath" (lambda () (set! *use-img-for-math?* #f)))

(tex-def-prim "\\dontuseimgforhtmlmathdisplay" (lambda () (set! *use-img-for-display-math?* #f)))

(tex-def-prim "\\dontuseimgforhtmlmathintext" (lambda () (set! *use-img-for-in-text-math?* #f)))

(tex-def-prim "\\dots" (lambda () (emit "<tt>...</tt>")))

(tex-def-prim "\\egroup" egroup)

(tex-def-prim "\\eject" do-eject)

(tex-def-prim "\\else" (lambda () (do-else)))

(tex-def-prim "\\em" (lambda () (do-switch "\\em")))

(tex-def-prim "\\emph" (lambda () (do-function "\\emph")))

(tex-def-prim "\\equation" (lambda () (do-latex-env-as-image "equation" (quote display))))

(tex-def-prim "\\eqnarray" (lambda () (do-latex-env-as-image "eqnarray" (quote display))))

(tex-def-prim "\\end" do-end)

(tex-def-prim "\\endalltt" do-end-alltt)

(tex-def-prim "\\endcenter" do-end-block)

(tex-def-prim "\\enddescription" (lambda () (set! *tabular-stack* (cdr *tabular-stack*)) (do-end-para) (emit "</dd></dl>") (do-para)))

(tex-def-prim "\\endenumerate" (lambda () (set! *tabular-stack* (cdr *tabular-stack*)) (do-end-para) (emit "</ol>") (do-para)))

(tex-def-prim "\\endfigure" do-end-figure)

(tex-def-prim "\\endflushleft" do-end-block)

(tex-def-prim "\\endflushright" do-end-block)

(tex-def-prim "\\endgraf" do-para)

(tex-def-prim "\\endhtmlimg" (lambda () (terror (quote tex-def-prim) "Unmatched \\endhtmlimg")))

(tex-def-prim "\\endhtmlonly" (lambda () (set! *html-only* (- *html-only* 1))))

(tex-def-prim "\\enditemize" (lambda () (set! *tabular-stack* (cdr *tabular-stack*)) (do-end-para) (emit "</ul>") (do-para)))

(tex-def-prim "\\endminipage" do-endminipage)

(tex-def-prim "\\endruledtable" do-endruledtable)

(tex-def-prim "\\endtabbing" do-end-tabbing)

(tex-def-prim "\\endtable" do-end-table)

(tex-def-prim "\\endtableplain" do-end-table-plain)

(tex-def-prim "\\endtabular" do-end-tabular)

(tex-def-prim "\\endthebibliography" (lambda () (emit "</table>") (do-para)))

(tex-def-prim "\\enspace" (lambda () (emit-nbsp 2)))

(tex-def-prim "\\enumerate" (lambda () (do-end-para) (set! *tabular-stack* (cons (quote enumerate) *tabular-stack*)) (emit "<ol>")))

(tex-def-prim "\\epsfbox" do-epsfbox)

(tex-def-prim "\\errmessage" do-errmessage)

(tex-def-prim "\\eval" (lambda () (do-eval (quote both))))

(tex-def-prim "\\evalh" (lambda () (do-eval (quote html))))

(tex-def-prim "\\expandafter" do-expandafter)

(tex-def-prim "\\expandhtmlindex" (lambda () (expand-html-index #f)))

(tex-def-prim "\\externaltitle" do-external-title)

(tex-def-prim "\\fi" do-fi)

(tex-def-prim "\\figure" do-figure)

(tex-def-prim "\\fiverm" (lambda () (do-switch "\\fiverm")))

(tex-def-prim "\\flushleft" (lambda () (do-block "\\flushleft")))

(tex-def-prim "\\flushright" (lambda () (do-block "\\flushright")))

(tex-def-prim "\\footnote" do-footnote)

(tex-def-prim "\\gdef" (lambda () (do-def #t)))

(tex-def-prim "\\global" do-global)

(tex-def-prim "\\globaladvancetally" (lambda () (do-advancetally #t)))

(tex-def-prim "\\gobblegroup" get-group)

(tex-def-prim "\\\"" (lambda () (do-diacritic "uml")))

(tex-def-prim "\\halign" do-halign)

(tex-def-prim "\\hbox" do-box)

(tex-def-prim "\\hfill" (lambda () (emit-nbsp 5)))

(tex-def-prim "\\hrule" (lambda () (do-end-para) (emit "<hr>") (emit-newline) (do-para)))

(tex-def-prim "\\hskip" do-hskip)

(tex-def-prim "\\hspace" do-hspace)

(tex-def-prim "\\htmladdimg" do-htmladdimg)

(tex-def-prim "\\htmlgif" (lambda () (do-htmlimg "htmlgif")))

(tex-def-prim "\\htmlheadonly" do-html-head-only)

(tex-def-prim "\\htmlimg" (lambda () (do-htmlimg "htmlimg")))

(tex-def-prim "\\htmlimgformat" do-html-img-format)

(tex-def-prim "\\htmlimgmagnification" do-html-img-magnification)

(tex-def-prim "\\htmlonly" (lambda () (set! *html-only* (+ *html-only* 1))))

(tex-def-prim "\\htmlpagelabel" do-html-page-label)

(tex-def-prim "\\htmlpageref" do-html-page-ref)

(tex-def-prim "\\htmlref" do-htmlref)

(tex-def-prim "\\htmlrefexternal" do-htmlref-external)

(tex-def-prim "\\Huge" (lambda () (do-switch "\\Huge")))

(tex-def-prim "\\hyperref" do-hyperref)

(tex-def-prim "\\if" do-if)

(tex-def-prim "\\ifeof" do-iffalse)

(tex-def-prim "\\ifdim" do-iffalse)

(tex-def-prim "\\iffalse" do-iffalse)

(tex-def-prim "\\iffileexists" do-if-file-exists)

(tex-def-prim "\\ifmmode" do-ifmmode)

(tex-def-prim "\\ifnum" do-ifnum)

(tex-def-prim "\\iftrue" do-iftrue)

(tex-def-prim "\\ifx" do-ifx)

(tex-def-prim "\\ifodd" do-ifodd)

(tex-def-prim "\\ignorenextinputtimestamp" (lambda () (unless *inputting-boilerplate?* (set! *inputting-boilerplate?* 0))))

(tex-def-prim "\\ignorespaces" ignorespaces)

(tex-def-prim "\\imgdef" (lambda () (make-reusable-img #f)))

(tex-def-prim "\\imgpreamble" do-imgpreamble)

(tex-def-prim "\\IMGtabbing" (lambda () (do-latex-env-as-image "tabbing" (quote display))))

(tex-def-prim "\\IMGtabular" (lambda () (do-latex-env-as-image "tabular" (quote display))))

(tex-def-prim "\\include" do-include)

(tex-def-prim "\\includeonly" do-includeonly)

(tex-def-prim "\\includegraphics" do-includegraphics)

(tex-def-prim "\\index" do-index)

(tex-def-prim "\\indexitem" (lambda () (do-index-item "\\indexitem")))

(tex-def-prim "\\indexsubitem" (lambda () (do-index-item "\\indexsubitem")))

(tex-def-prim "\\indexsubsubitem" (lambda () (do-index-item "\\indexsubsubitem")))

(tex-def-prim "\\input" do-input)

(tex-def-prim "\\inputcss" do-input-css)

(tex-def-prim "\\inputexternallabels" do-input-external-labels)

(tex-def-prim "\\InputIfFileExists" do-input-if-file-exists)

(tex-def-prim "\\inputindex" (lambda () (do-input-index #f)))

(tex-def-prim "\\it" (lambda () (do-switch "\\it")))

(tex-def-prim "\\item" do-item)

(tex-def-prim "\\itemize" (lambda () (do-end-para) (set! *tabular-stack* (cons (quote itemize) *tabular-stack*)) (emit "<ul>")))

(tex-def-prim "\\itshape" (lambda () (do-switch "\\itshape")))

(tex-def-prim "\\jobname" (lambda () (tex2page-string *jobname*)))

(tex-def-prim "\\label" do-label)

(tex-def-prim "\\LaTeX" do-latex-logo)

(tex-def-prim "\\LaTeXe" do-latex2e-logo)

(tex-def-prim "\\latexonly" (lambda () (ignore-tex-specific-text "\\latexonly")))

(tex-def-prim "\\leftdisplays" (lambda () (set! *display-justification* (quote left))))

(tex-def-prim "\\leftline" (lambda () (do-function "\\leftline")))

(tex-def-prim "\\let" (lambda () (do-let #f)))

(tex-def-prim "\\linebreak" (lambda () (get-bracketed-text-if-any) (emit "<br>")))

(tex-def-prim "\\mailto" do-mailto)

(tex-def-prim "\\maketitle" do-maketitle)

(tex-def-prim "\\marginpar" do-marginpar)

(tex-def-prim "\\mathg" do-mathg)

(tex-def-prim "\\mathdg" do-mathdg)

(tex-def-prim "\\mathp" do-mathp)

(tex-def-prim "\\medbreak" (lambda () (do-bigskip "\\medbreak")))

(tex-def-prim "\\medskip" (lambda () (do-bigskip "\\medskip")))

(tex-def-prim "\\message" do-message)

(tex-def-prim "\\mfpic" do-mfpic)

(tex-def-prim "\\minipage" do-minipage)

(tex-def-prim "\\multiply" (lambda () (do-multiply #f)))

(tex-def-prim "\\narrower" (lambda () (do-switch "\\narrower")))

(tex-def-prim "\\newcommand" (lambda () (do-newcommand #f)))

(tex-def-prim "\\newcount" (lambda () (do-newcount #f)))

(tex-def-prim "\\newdimen" (lambda () (do-newdimen #f)))

(tex-def-prim "\\newenvironment" (lambda () (do-newenvironment #f)))

(tex-def-prim "\\newif" do-newif)

(tex-def-prim "\\newtheorem" do-newtheorem)

(tex-def-prim "\\newtoks" (lambda () (do-newtoks #f)))

(tex-def-prim "\\noad" (lambda () (set! *self-promote?* #f)))

(tex-def-prim "\\nocite" do-nocite)

(tex-def-prim "\\node" do-node)

(tex-def-prim "\\notimestamp" (lambda () (set! *timestamp?* #f)))

(tex-def-prim "\\nr" (lambda () (do-cr "\\nr")))

(tex-def-prim "\\number" do-number)

(tex-def-prim "\\numfootnote" do-numbered-footnote)

(tex-def-prim "\\O" (lambda () (emit "&Oslash;")))

(tex-def-prim "\\o" (lambda () (emit "&oslash;")))

(tex-def-prim "\\obeylines" do-obeylines)

(tex-def-prim "\\obeyspaces" do-obeyspaces)

(tex-def-prim "\\obeywhitespace" do-obeywhitespace)

(tex-def-prim "\\OE" (lambda () (emit "&OElig;")))

(tex-def-prim "\\oe" (lambda () (emit "&oelig;")))

(tex-def-prim "\\opengraphsfile" do-opengraphsfile)

(tex-def-prim "\\P" (lambda () (emit "&para;")))

(tex-def-prim "\\pagebreak" (lambda () (get-bracketed-text-if-any) (do-eject)))

(tex-def-prim "\\pageno" (lambda () (emit *html-page-count*)))

(tex-def-prim "\\pageref" do-pageref)

(tex-def-prim "\\part" (lambda () (do-heading -1)))

(tex-def-prim "\\picture" (lambda () (do-latex-env-as-image "picture" (quote inline))))

(tex-def-prim "\\printindex" (lambda () (do-input-index #t)))

(tex-def-prim "\\quad" (lambda () (emit-nbsp 4)))

(tex-def-prim "\\qquad" (lambda () (emit-nbsp 8)))

(tex-def-prim "\\quote" (lambda () (do-end-para) (emit "<blockquote>") (bgroup)))

(tex-def-prim "\\endquote" (lambda () (do-end-para) (egroup) (emit "</blockquote>")))

(tex-def-prim "\\rawhtml" do-rawhtml)

(tex-def-prim "\\ref" do-ref)

(tex-def-prim "\\refexternal" do-ref-external)

(tex-def-prim "\\relax" do-relax)

(tex-def-prim "\\renewcommand" (lambda () (do-newcommand #t)))

(tex-def-prim "\\renewenvironment" (lambda () (do-newenvironment #t)))

(tex-def-prim "\\resizebox" do-resizebox)

(tex-def-prim "\\rightline" (lambda () (do-function "\\rightline")))

(tex-def-prim "\\rm" (lambda () (if *math-mode?* (do-switch "\\rm"))))

(tex-def-prim "\\romannumeral" (lambda () (do-romannumeral #f)))

(tex-def-prim "\\Romannumeral" (lambda () (do-romannumeral #t)))

(tex-def-prim "\\ruledtable" do-ruledtable)

(tex-def-prim "\\S" (lambda () (emit "&sect;")))

(tex-def-prim "\\sc" (lambda () (do-switch "\\sc")))

(tex-def-prim "\\schemedisplay" (lambda () (do-scm-slatex-lines "schemedisplay" #t #f)))

(tex-def-prim "\\schemebox" (lambda () (do-scm-slatex-lines "schemebox" #f #f)))

(tex-def-prim "\\schemeresponse" (lambda () (do-scm-slatex-lines "schemeresponse" #t (quote result))))

(tex-def-prim "\\schemeresponsebox" (lambda () (do-scm-slatex-lines "schemeresponsebox" #f (quote result))))

(tex-def-prim "\\schemeresult" (lambda () (do-scm (quote result))))

(tex-def-prim "\\scm" (lambda () (do-scm #f)))

(tex-def-prim "\\scmdribble" do-scm-dribble)

(tex-def-prim "\\scmfilename" do-scm-set-filename)

(tex-def-prim "\\scminput" do-scm-input)

(tex-def-prim "\\scmwrite" do-scm-write-to-file)

(tex-def-prim "\\section" (lambda () (do-heading 1)))

(tex-def-prim "\\seealso" do-see-also)

(tex-def-prim "\\setconstant" do-scm-set-constants)

(tex-def-prim "\\setcounter" (lambda () (set-latex-counter #f)))

(tex-def-prim "\\setkeyword" do-scm-set-keywords)

(tex-def-prim "\\setspecialsymbol" do-scm-set-special-symbol)

(tex-def-prim "\\sevenrm" (lambda () (do-switch "\\sevenrm")))

(tex-def-prim "\\sf" (lambda () #f))

(tex-def-prim "\\sl" (lambda () (do-switch "\\sl")))

(tex-def-prim "\\slatexdisable" get-group)

(tex-def-prim "\\slatexlikecomments" (lambda () (set! *slatex-like-comments?* #t)))

(tex-def-prim "\\small" (lambda () (do-switch "\\small")))

(tex-def-prim "\\smallbreak" (lambda () (do-bigskip "\\smallbreak")))

(tex-def-prim "\\smallskip" (lambda () (do-bigskip "\\smallskip")))

(tex-def-prim "\\ss" (lambda () (emit "&szlig;")))

(tex-def-prim "\\strike" (lambda () (do-switch "\\strike")))

(tex-def-prim "\\subject" do-subject)

(tex-def-prim "\\subsection" (lambda () (get-bracketed-text-if-any) (do-heading 2)))

(tex-def-prim "\\subsubsection" (lambda () (do-heading 3)))

(tex-def-prim "\\symfootnote" do-symfootnote)

(tex-def-prim "\\tabbing" do-tabbing)

(tex-def-prim "\\table" do-table)

(tex-def-prim "\\tableplain" do-table-plain)

(tex-def-prim "\\tableofcontents" do-toc)

(tex-def-prim "\\tabular" do-tabular)

(tex-def-prim "\\tag" do-tag)

(tex-def-prim "\\TeX" do-tex-logo)

(tex-def-prim "\\texonly" (lambda () (ignore-tex-specific-text "\\texonly")))

(tex-def-prim "\\textbf" (lambda () (do-function "\\textbf")))

(tex-def-prim "\\textit" (lambda () (do-function "\\textit")))

(tex-def-prim "\\textsc" (lambda () (fluid-let ((*in-small-caps?* #t)) (tex2page-string (get-group)))))

(tex-def-prim "\\textsl" (lambda () (do-function "\\textsl")))

(tex-def-prim "\\texttt" (lambda () (do-function "\\texttt")))

(tex-def-prim "\\the" do-the)

(tex-def-prim "\\thebibliography" do-thebibliography)

(tex-def-prim "\\TIIPbackslash" (lambda () (emit "\\")))

(tex-def-prim "\\TIIPbr" do-br)

(tex-def-prim "\\TIIPcomment" eat-till-eol)

(tex-def-prim "\\TIIPeatstar" eat-star)

(tex-def-prim "\\TIIPgobblegroup" get-group)

(tex-def-prim "\\TIIPlatexenvasimage" do-following-latex-env-as-image)

(tex-def-prim "\\TIIPnbsp" (lambda () (emit-nbsp 1)))

(tex-def-prim "\\TIIPnull" get-actual-char)

(tex-def-prim "\\TIIPreuseimage" reuse-img)

(tex-def-prim "\\TIIPtheorem" do-theorem)

(tex-def-prim "\\title" do-title)

(tex-def-prim "\\tracingall" do-tracingall)

(tex-def-prim "\\tracingcommands" (lambda () (do-tracingcommands #f)))

(tex-def-prim "\\tracingmacros" (lambda () (do-tracingmacros #f)))

(tex-def-prim "\\tt" (lambda () (do-switch "\\tt")))

(tex-def-prim "\\undefcsactive" do-undefcsactive)

(tex-def-prim "\\undefschememathescape" (lambda () (scm-set-math-escape #f)))

(tex-def-prim "\\underline" (lambda () (do-function "\\underline")))

(tex-def-prim "\\unsetspecialsymbol" do-scm-unset-special-symbol)

(tex-def-prim "\\url" do-url)

(tex-def-prim "\\urlh" do-urlh)

(tex-def-prim "\\urlhd" do-urlhd)

(tex-def-prim "\\urlp" do-urlp)

(tex-def-prim "\\vdots" (lambda () (emit "<tt><table><tr><td>.</td></tr>") (emit "<tr><td>.</td></tr>") (emit "<tr><td>.</td></tr></table></tt>")))

(tex-def-prim "\\verb" do-verb)

(tex-def-prim "\\verbatim" do-latex-verbatim)

(tex-def-prim "\\verbc" do-verbc)

(tex-def-prim "\\verbescapechar" set-verbatim-escape-character)

(tex-def-prim "\\verbinput" do-verbatim-file)

(tex-def-prim "\\verbwrite" verb-write-to-file)

(tex-def-prim "\\vskip" (lambda () (eat-dimen) (do-bigskip "vskip")))

(tex-def-prim "\\vspace" do-vspace)

(tex-def-prim "\\\\" (lambda () (do-cr "\\\\")))

(tex-def-prim "\\`" (lambda () (do-diacritic "grave")))

(tex-def-prim "\\(" do-latex-in-text-math)

(tex-def-prim "\\[" do-latex-display-math)

(tex-def-prim "\\)" egroup)

(tex-def-prim "\\]" egroup)

(tex-def-prim "\\{" (lambda () (emit "{")))

(tex-def-prim "\\}" (lambda () (emit "}")))

(tex-let-prim "\\-" "\\relax")

(tex-def-prim "\\'" (lambda () (do-diacritic "acute")))

(tex-def-prim "\\=" (lambda () (unless (and (pair? *tabular-stack*) (eqv? (car *tabular-stack*) (quote tabbing))) (do-diacritic "circ"))))

(tex-def-prim "\\>" (lambda () (if (and (pair? *tabular-stack*) (eqv? (car *tabular-stack*) (quote tabbing))) (emit-nbsp 3))))

(tex-def-prim "\\^" (lambda () (do-diacritic "circ")))

(tex-def-prim "\\~" (lambda () (do-diacritic "tilde")))

(tex-def-prim "\\#" (lambda () (emit "#")))

(tex-def-prim "\\ " (lambda () (emit #\space)))

(tex-def-prim "\\%" (lambda () (emit "%")))

(tex-def-prim "\\&" (lambda () (emit "&amp;")))

(tex-def-prim "\\@" (lambda () (emit "@")))

(tex-def-prim "\\_" (lambda () (emit "_")))

(tex-def-prim "\\$" (lambda () (emit "$")))

(tex-def-prim (string #\\ #\newline) emit-newline)

(tex-let-prim "\\displaystyle" "\\relax")

(tex-let-prim "\\textstyle" "\\relax")

(tex-let-prim "\\endsloppypar" "\\relax")

(tex-let-prim "\\frenchspacing" "\\relax")

(tex-let-prim "\\noindent" "\\relax")

(tex-let-prim "\\oldstyle" "\\relax")

(tex-let-prim "\\protect" "\\relax")

(tex-let-prim "\\raggedbottom" "\\relax")

(tex-let-prim "\\raggedright" "\\relax")

(tex-let-prim "\\sloppy" "\\relax")

(tex-let-prim "\\sloppypar" "\\relax")

(tex-let-prim "\\normalfont" "\\relax")

(tex-let-prim "\\textnormal" "\\relax")

(tex-let-prim "\\textrm" "\\relax")

(tex-let-prim "\\unskip" "\\relax")

(tex-def-prim "\\font" eat-till-eol)

(tex-def-prim "\\cline" get-group)

(tex-def-prim "\\externalref" get-group)

(tex-def-prim "\\GOBBLEARG" get-group)

(tex-def-prim "\\hyphenation" get-group)

(tex-def-prim "\\newcounter" get-group)

(tex-def-prim "\\newlength" get-group)

(tex-def-prim "\\hphantom" get-group)

(tex-def-prim "\\vphantom" get-group)

(tex-def-prim "\\phantom" get-group)

(tex-def-prim "\\pagenumbering" get-group)

(tex-def-prim "\\pagestyle" get-group)

(tex-def-prim "\\raisebox" get-group)

(tex-def-prim "\\thispagestyle" get-group)

(tex-def-prim "\\usepackage" get-group)

(tex-def-prim "\\externallabels" (lambda () (get-group) (get-group)))

(tex-let-prim "\\markboth" "\\externallabels")

(tex-def-prim "\\hbadness" eat-integer)

(tex-def-prim "\\exhyphenpenalty" eat-integer)

(tex-def-prim "\\hyphenpenalty" eat-integer)

(tex-def-prim "\\showboxdepth" eat-integer)

(tex-def-prim "\\pretolerance" eat-integer)

(tex-def-prim "\\tolerance" eat-integer)

(tex-def-prim "\\widowpenalty" eat-integer)

(tex-def-prim "\\baselineskip" eat-dimen)

(tex-def-prim "\\columnsep" eat-dimen)

(tex-def-prim "\\columnseprule" eat-dimen)

(tex-def-prim "\\epsfxsize" eat-dimen)

(tex-def-prim "\\evensidemargin" eat-dimen)

(tex-def-prim "\\fboxsep" eat-dimen)

(tex-def-prim "\\headsep" eat-dimen)

(tex-def-prim "\\itemsep" eat-dimen)

(tex-def-prim "\\kern" eat-dimen)

(tex-def-prim "\\leftcodeskip" eat-dimen)

(tex-def-prim "\\lower" eat-dimen)

(tex-def-prim "\\oddsidemargin" eat-dimen)

(tex-def-prim "\\overfullrule" eat-dimen)

(tex-def-prim "\\parindent" eat-dimen)

(tex-def-prim "\\parsep" eat-dimen)

(tex-def-prim "\\parskip" eat-dimen)

(tex-def-prim "\\raise" eat-dimen)

(tex-def-prim "\\rightcodeskip" eat-dimen)

(tex-def-prim "\\sidemargin" eat-dimen)

(tex-def-prim "\\textheight" eat-dimen)

(tex-def-prim "\\textwidth" eat-dimen)

(tex-def-prim "\\topmargin" eat-dimen)

(tex-def-prim "\\topsep" eat-dimen)

(tex-def-prim "\\vertmargin" eat-dimen)

(tex-def-prim "\\addtolength" (lambda () (get-token) (get-token)))

(tex-let-prim "\\addvspace" "\\vspace")

(tex-let-prim "\\setlength" "\\addtolength")

(tex-let-prim "\\settowidth" "\\addtolength")

(tex-def-prim "\\enlargethispage" (lambda () (eat-star) (get-group)))

(tex-def-prim "\\parbox" (lambda () (get-bracketed-text-if-any) (get-group)))

(tex-let-prim "\\usepackage" "\\parbox")

(tex-def-prim "\\addcontentsline" (lambda () (get-group) (get-group) (get-group)))

(tex-def-prim "\\makebox" (lambda () (get-bracketed-text-if-any) (get-bracketed-text-if-any)))

(tex-let-prim "\\framebox" "\\makebox")

(tex-def-prim "\\rule" (lambda () (get-bracketed-text-if-any) (get-group) (get-group)))

(tex-def-prim "\\GOBBLEOPTARG" get-bracketed-text-if-any)

(tex-def-prim "\\nolinebreak" get-bracketed-text-if-any)

(tex-def-prim "\\nopagebreak" get-bracketed-text-if-any)

(tex-let-prim "\\enskip" "\\enspace")

(tex-let-prim "\\path" "\\verb")

(tex-let-prim "\\par" "\\endgraf")

(tex-let-prim "\\u" "\\`")

(tex-let-prim "\\vbox" "\\hbox")

(tex-let-prim "\\mbox" "\\hbox")

(tex-let-prim "\\supereject" "\\eject")

(tex-let-prim "\\dosupereject" "\\eject")

(tex-let-prim "\\endgroup" "\\egroup")

(tex-let-prim "\\begingroup" "\\bgroup")

(tex-let-prim "\\d" "\\b")

(tex-let-prim "\\." "\\b")

(tex-let-prim "\\ldots" "\\dots")

(tex-let-prim "\\documentstyle" "\\documentclass")

(tex-let-prim "\\edef" "\\def")

(tex-let-prim "\\H" "\\\"")

(tex-let-prim "\\/" "\\relax")

(tex-let-prim "\\leavevmode" "\\relax")

(tex-let-prim "\\space" "\\ ")

(tex-let-prim "\\quotation" "\\quote")

(tex-let-prim "\\endquotation" "\\endquote")

(tex-let-prim "\\xdef" "\\gdef")

(tex-let-prim "\\nohtmlmathimg" "\\dontuseimgforhtmlmath")

(tex-let-prim "\\nohtmlmathintextimg" "\\dontuseimgforhtmlmathintext")

(tex-let-prim "\\nohtmlmathdisplayimg" "\\dontuseimgforhtmlmathdisplay")

(tex-let-prim "\\obeywhitespaces" "\\obeywhitespace")

(tex-let-prim "\\epsffile" "\\epsfbox")

(tex-let-prim "\\verbatiminput" "\\verbinput")

(tex-let-prim "\\verbatimfile" "\\verbinput")

(tex-let-prim "\\setverbatimescapechar" "\\verbescapechar")

(tex-let-prim "\\p" "\\verb")

(tex-let-prim "\\htmladdnormallink" "\\urlp")

(tex-let-prim "\\htmladdnormallinkfoot" "\\urlp")

(tex-let-prim "\\pagehtmlref" "\\htmlref")

(tex-let-prim "\\href" "\\urlhd")

(tex-let-prim "\\scmconstant" "\\setconstant")

(tex-let-prim "\\scmkeyword" "\\setkeyword")

(tex-let-prim "\\unscmspecialsymbol" "\\unsetspecialsymbol")

(tex-let-prim "\\scmspecialsymbol" "\\setspecialsymbol")

(tex-let-prim "\\scmfileonly" "\\scmwrite")

(tex-let-prim "\\scmverbatimfile" "\\scminput")

(tex-let-prim "\\scmverbatiminput" "\\scminput")

(tex-let-prim "\\scmfile" "\\scmdribble")

(tex-let-prim "\\scmverb" "\\scm")

(tex-let-prim "\\scmp" "\\scm")

(tex-let-prim "\\q" "\\scm")

(tex-let-prim "\\scheme" "\\scm")

(tex-let-prim "\\scmverbatim" "\\scm")

(tex-let-prim "\\tagref" "\\ref")

(tex-let-prim "\\numberedfootnote" "\\numfootnote")

(tex-let-prim "\\f" "\\numfootnote")

(tex-let-prim "\\newpage" "\\eject")

(tex-let-prim "\\clearpage" "\\eject")

(tex-let-prim "\\cleardoublepage" "\\eject")

(tex-let-prim "\\htmlpagebreak" "\\eject")

(tex-let-prim "\\typeout" "\\message")

(tex-let-prim "\\unorderedlist" "\\itemize")

(tex-let-prim "\\htmlstylesheet" "\\inputcss")

(tex-let-prim "\\gifpreamble" "\\imgpreamble")

(tex-let-prim "\\mathpreamble" "\\imgpreamble")

(tex-let-prim "\\gifdef" "\\imgdef")

(tex-let-prim "\\hr" "\\hrule")

(tex-let-prim "\\htmlrule" "\\hrule")

(tex-let-prim "\\schemeeval" "\\eval")

(tex-let-prim "\\numberedlist" "\\enumerate")

(tex-let-prim "\\orderedlist" "\\enumerate")

(tex-let-prim "\\endunorderedlist" "\\enditemize")

(tex-let-prim "\\endnumberedlist" "\\endenumerate")

(tex-let-prim "\\endorderedlist" "\\endenumerate")

(tex-let-prim "\\newline" "\\break")

(define tex2page (lambda (tex-file) (fluid-let ((*after-eval* #f) (*aux-dir* #f) (*aux-dir/* "") (*aux-port* #f) (*bibitem-num* 0) (*comment-char* #\%) (*css-port* #f) (*current-mfpic-file-stem* #f) (*current-mfpic-file-num* #f) (*current-tex2page-input* #f) (*current-tex-file* #f) (*current-tex-line-number* #f) (*display-justification* (quote center)) (*doing-urlh?* #f) (*dotted-counters* (make-table (quote equ) string=?)) (*esc-char* #\\) (*esc-char-std* #\\) (*esc-char-verb* #\|) (*eval-file-count* 0) (*eval-file-stem* #f) (*external-label-tables* (make-table (quote equ) string=?)) (*external-programs* (quote ())) (*figure-stack* (quote ())) (*footnote-list* (quote ())) (*footnote-sym* 0) (*global-texframe* (make-texframe)) (*graphics-file-extensions* (quote (".eps"))) (*html* #f) (*html-head* (quote ())) (*html-only* 0) (*html-page* #f) (*html-page-count* 0) (*img-file-count* 0) (*img-file-extn* (find-img-file-extn)) (*img-file-tally* 0) (*imgdef-file-count* 0) (*imgpreamble* "") (*in-alltt?* #f) (*in-display-math?* #f) (*in-para?* #f) (*in-small-caps?* #f) (*includeonly-list* #t) (*index-alist* (quote ())) (*index-count* 0) (*index-page* #f) (*index-port* #f) (*infructuous-calls-to-tex2page* 0) (*input-dirs* (quote ())) (*inputting-boilerplate?* #f) (*inside-appendix?* #f) (*jobname* "texput") (*label-port* #f) (*label-table* (make-table (quote equ) string=?)) (*last-modification-time* #f) (*last-page-number* -1) (*latex-probability* 0) (*ligatures?* #t) (*loading-external-labels?* #f) (*log-file* #f) (*log-port* #f) (*main-tex-file* #f) (*math-mode?* #f) (*missing-pieces* (quote ())) (*not-processing?* #f) (*output-extn* ".html") (*recent-node-name* #f) (*scm-dribbling?* #f) (*scm-port* #f) (*section-counter-dependencies* (make-table)) (*section-counters* (make-table)) (*self-promote?* #t) (*slatex-like-comments?* #f) (*stylesheets* (quote ())) (*subjobname* #f) (*tabular-stack* (quote ())) (*temp-string-count* 0) (*tex2page-inputs* (path-to-list (getenv "TIIPINPUTS"))) (*tex-aux-port* #f) (*tex-env* (quote ())) (*tex-format* (quote plain)) (*tex-if-stack* (quote ())) (*timestamp?* #t) (*title* #f) (*toc-list* (quote ())) (*toc-page* #f) (*tracingcommands?* #f) (*tracingmacros?* #f) (*unresolved-xrefs* (quote ())) (*using-chapters?* #f) (*verb-port* #f)) (set! *main-tex-file* (actual-tex-filename tex-file)) (when (file-exists? *main-tex-file*) (set! *jobname* (file-stem-name *main-tex-file*)) (make-target-dir)) (tex-def-count "\\secnumdepth" -2 #t) (load-aux-file) (write-log "This is TeX2page, Version ") (write-log *tex2page-version*) (write-log #\space) (write-log #\() (write-log *scheme-version*) (write-log #\,) (write-log #\space) (write-log *operating-system*) (write-log #\)) (write-log #\newline) (cond ((not (file-exists? *main-tex-file*)) (tex2page-help tex-file)) (else (set! *subjobname* *jobname*) (initialize-global-texframe) (set! *html-page* (let ((ext (file-extension *main-tex-file*))) (string-append *aux-dir/* *jobname* (if (and ext (string-ci=? ext *output-extn*) (not *aux-dir*)) (string-append "-SAVE" *output-extn*) *output-extn*)))) (ensure-file-deleted *html-page*) (set! *html* (open-output-file *html-page*)) (call-bibtex-makeindex-if-necessary) (do-start) (let ((t2p-file (actual-tex-filename (string-append *jobname* ".t2p")))) (when (file-exists? t2p-file) (fluid-let ((*html-only* (+ *html-only* 1))) (tex2page-file t2p-file)))) (do-input-check-bye *main-tex-file*) (do-bye))) (display "Transcript written on ") (display *log-file*) (display ".") (newline))))

(define main (lambda () (tex2page (or (get-arg1) "--missing-arg"))))

(main)


