;proctex.scm
;SLaTeX v. 2.4
;Implements SLaTeX's piggyback to LaTeX
;(c) Dorai Sitaram
;dorai@ses.com

(module SLaTeX.)

(local process-main-tex-file process-tex-file
  disable-slatex-temply enable-slatex-again ignore2
  add-to-slatex-db add-to-slatex-db-basic
  add-to-slatex-db-special process-slatex-alias
  decide-latex-or-tex process-include-only
  process-documentstyle process-documentclass
  process-case-info seen-first-command? dump-intext
  dump-display)

(define disable-slatex-temply
  (lambda (in)
    ;;tell slatex that it should not process slatex commands till
    ;;the enabling control sequence is called
    (set! *slatex-enabled?* #f)
    (set! *slatex-reenabler* (read-grouped-latexexp in))))

(define enable-slatex-again
  (lambda ()
    ;tell slatex to resume processing slatex commands
    (set! *slatex-enabled?* #t)
    (set! *slatex-reenabler* "UNDEFINED")))

(define ignore2
  (lambda (i ii)
    ;;ignores its two arguments
    'void))

(define add-to-slatex-db
  (lambda (in categ)
    ;;some scheme identifiers to be added to the token category categ
    (if (memq categ '(keyword constant variable))
	(add-to-slatex-db-basic in categ)
	(add-to-slatex-db-special in categ))))

(define add-to-slatex-db-basic
  (lambda (in categ)
    ;;read the following scheme identifiers and add them to the
    ;;token category categ
    (let ((setter (cond ((eq? categ 'keyword) set-keyword)
			((eq? categ 'constant) set-constant)
			((eq? categ 'variable) set-variable)
			(else (error 'add-to-slatex-db-basic 1))))
	  (ids (read-grouped-schemeids in)))
      (for-each setter ids))))

(define add-to-slatex-db-special
  (lambda (in what)
    ;;read the following scheme identifier(s) and either
    ;;enable/disable its special-symbol status
    (let ((ids (read-grouped-schemeids in)))
      (cond ((eq? what 'unsetspecialsymbol)
	     (for-each unset-special-symbol ids))
	    ((eq? what 'setspecialsymbol)
	     (if (= (length ids) 1) 'ok
	       (error 'add-to-slatex-db-special
		 'setspecialsymbol-takes-one-arg-only))
	     (let ((transl (read-grouped-latexexp in)))
	       (set-special-symbol (car ids) transl)))
	    (else (error 'add-to-slatex-db-special 2))))))

(define process-slatex-alias
  (lambda (in what which)
    ;;add/remove a slatex control sequence name
    (let ((triggerer (read-grouped-latexexp in)))
      (cond ((eq? which 'intext)
	     (set! *intext-triggerers*
	       (funcall what triggerer *intext-triggerers*)))
	    ((eq? which 'resultintext)
	     (set! *resultintext-triggerers*
	       (funcall what triggerer *resultintext-triggerers*)))
	    ((eq? which 'display)
	     (set! *display-triggerers*
	       (funcall what triggerer *display-triggerers*)))
	    ((eq? which 'response)
	     (set! *response-triggerers*
	       (funcall what triggerer *response-triggerers*)))
	    ((eq? which 'respbox)
	     (set! *respbox-triggerers*
	       (funcall what trigger *respbox-triggerers*)))
	    ((eq? which 'box)
	     (set! *box-triggerers*
	       (funcall what triggerer *box-triggerers*)))
	    ((eq? which 'input)
	     (set! *input-triggerers*
	       (funcall what triggerer *input-triggerers*)))
	    ((eq? which 'region)
	     (set! *region-triggerers*
	       (funcall what triggerer *region-triggerers*)))
	    ((eq? which 'mathescape)
	     (if (= (string-length triggerer) 1) 'ok
	       (error 'process-slatex-alias
		 'math-escape-should-be-character))
	     (set! *math-triggerers*
	       (funcall what (string-ref triggerer 0) *math-triggerers*)))
	    (else (error 'process-slatex-alias 2))))))

(define decide-latex-or-tex
  (lambda (latex?)
    ;;create a junk file if the file is in plain tex rather
    ;;than latex; this is used afterward to call the right
    ;;command, i.e., latex or tex
    (set! *latex?* latex?)
    (let ((pltexchk.jnk "pltexchk.jnk"))
      (if (file-exists? pltexchk.jnk) (delete-file pltexchk.jnk))
      (if (not *latex?*)
          (call-with-output-file pltexchk.jnk
            (lambda (outp)
	      (display 'junk outp)
	      (newline outp)))))))

(define process-include-only
  (lambda (in)
    ;;remember the files mentioned by \includeonly
    (set! *include-onlys* '())
    (for-each
      (lambda (filename)
	(let ((filename (full-texfile-name filename)))
	  (if filename
	    (set! *include-onlys*
	      (adjoin-string filename *include-onlys*)))))
      (read-grouped-commaed-filenames in))))

(define process-documentstyle
  (lambda (in)
    ;;process the .sty files corresponding to the documentstyle options
    (eat-tex-whitespace in)
    (if (char=? (peek-char in) #\[)
      (for-each
	(lambda (filename)
	  (fluid-let ((*slatex-in-protected-region?* #f))
	    (process-tex-file
	      (string-append filename ".sty"))))
	(read-bktd-commaed-filenames in)))))

(define process-documentclass
  (lambda (in)
    (eat-bktd-text in)
    (eat-grouped-text in)))

(define process-case-info
  (lambda (in)
    ;;find out and tell slatex if the scheme tokens that differ
    ;;only by case should be treated identical or not
    (let ((bool (read-grouped-latexexp in)))
    (set! *slatex-case-sensitive?*
      (cond ((string-ci=? bool "true") #t)
	    ((string-ci=? bool "false") #f)
	    (else (error 'process-case-info
		    'bad-schemecasesensitive-arg)))))))

(define seen-first-command? #f)

(define process-main-tex-file
  (lambda (filename)
    ;;kick off slatex on the main .tex file filename
    (display "SLaTeX v. 2.4")
    (newline)
    (set! primary-aux-file-count -1)
    (set! *slatex-separate-includes?* #f)
    (if (null? *texinputs-list*)
      (set! *texinputs-list* (path-to-list *texinputs*)))
    (let ((file-hide-file "xZfilhid.tex"))
      (if (file-exists? file-hide-file) (delete-file file-hide-file))
      (if (memq *op-sys* '(dos os2fat))
          (call-with-output-file file-hide-file
            (lambda (out)
              (display "\\def\\filehider{x}" out)
              (newline out)))))
    (display "typesetting code")
    (set! subjobname (basename filename ".tex"))
    (set! seen-first-command? #f)
    (process-tex-file filename)
    (display 'done)
    (newline)))

(define dump-intext
  (lambda (in out)
    (let* ((display (if out display ignore2))
	   (delim-char (begin (eat-whitespace in) (read-char in)))
	   (delim-char
	     (cond ((char=? delim-char #\{) #\})
		   (else delim-char))))
      (if (eof-object? delim-char) (error 'dump-intext 1))
      (let loop ()
	(let ((c (read-char in)))
	  (if (eof-object? c) (error 'dump-intext 2))
	  (if (char=? c delim-char) 'done
              (begin (funcall display c out) (loop))))))))

(define dump-display
  (lambda (in out ender)
    (eat-tabspace in)
    (let ((display (if out display ignore2))
	  (ender-lh (string-length ender))
	  (c (peek-char in)))
      (if (eof-object? c) (error 'dump-display 1))
      (if (char=? c #\newline) (read-char in))
      (let loop ((buf ""))
	(let ((c (read-char in)))
	  (if (eof-object? c) (error 'dump-display 2))
	  (let ((buf (string-append buf (string c))))
	    (if (string-prefix? buf ender)
		(if (= (string-length buf) ender-lh) 'done
		  (loop buf))
		(begin (funcall display buf out) (loop "")))))))))

;continued on proctex2.scm