;helpers.ss
;SLaTeX v. 2.3
;Helpers for SLaTeX
;(c) Dorai Sitaram, Rice U., 1991, 1994

(module SLaTeX.)

(local set-keyword set-constant set-variable set-special-symbol
  unset-special-symbol texify texify-data texify-aux
  display-begin-sequence display-end-sequence *code-env-spec*
  display-tex-char display-token)

(define set-keyword
  (lambda (x)
    ;;add token x to the keyword database
    (if (member-token x keyword-tokens) 'skip
	(begin
	 (set! constant-tokens (remove-token! x constant-tokens))
	 (set! variable-tokens (remove-token! x variable-tokens))
	 (set! keyword-tokens (cons x keyword-tokens))))))

(define set-constant
  (lambda (x)
    ;;add token x to the constant database
    (if (member-token x constant-tokens) 'skip
        (begin
	 (set! keyword-tokens (remove-token! x keyword-tokens))
	 (set! variable-tokens (remove-token! x variable-tokens))
	 (set! constant-tokens (cons x constant-tokens))))))

(define set-variable
  (lambda (x)
    ;;add token x to the variable database
    (if (member-token x variable-tokens) 'skip
        (begin
	 (set! keyword-tokens (remove-token! x keyword-tokens))
	 (set! constant-tokens (remove-token! x constant-tokens))
	 (set! variable-tokens (cons x variable-tokens))))))

(define set-special-symbol
  (lambda (x transl)
    ;;add token x to the special-symbol database with
    ;;the translation transl
    (let ((c (assoc-token x special-symbols)))
      (if c (set-cdr! c transl)
	  (set! special-symbols
	    (cons (cons x transl) special-symbols))))))

(define unset-special-symbol
  (lambda (x)
    ;;disable token x's special-symbol-hood
    (set! special-symbols
      (remove-if! (lambda (c) (token=? (car c) x)) special-symbols))))

(define texify
  (lambda (s)
    ;create a tex-suitable string out of token s
    (list->string (texify-aux s))))

(define texify-data
  (lambda (s)
    ;create a tex-suitable string out of the data token s
    (let loop ((l (texify-aux s)) (r '()))
      (if (null? l) (list->string (reverse! r))
	(let ((c (car l)))
	  (loop (cdr l)
		(if (char=? c #\-) (append! (list #\$ c #\$) r)
		  (cons c r))))))))

(define texify-aux
  (let* ((arrow (string->list "-$>$"))
	 (arrow-lh (length arrow)))
    (lambda (s)
      ;;return the list of tex characters corresponding to token s
      (let* ((sl (string->list s))
	     ;;some extra context-sensitive prettifying could go here?!
	     (texified-sl
	       (append-map! (lambda (c) (string->list (tex-analog c)))
		 sl)))
	(ormapcdr
	  (lambda (d)
	    (if (list-prefix? arrow d)
	      (let ((to (string->list "$\\to$")))
		(set-car! d (car to))
		(set-cdr! d (append (cdr to)
			      (list-tail d arrow-lh)))))
	    #f)
	  texified-sl)
	texified-sl))))

(define display-begin-sequence
  (lambda (out)
    (if (or *intext?* (not *latex?*))
	(begin
	  (display "\\" out)
	  (display *code-env-spec* out)
	  (newline out))
	(begin
	  (display "\\begin{" out)
	  (display *code-env-spec* out)
	  (display "}" out)
	  (newline out)))))

(define display-end-sequence
  (lambda (out)
    (cond (*intext?* ;(or *intext?* (not *latex?*))
           (display "\\end" out)
	   (display *code-env-spec* out)
	   ;(display "{}" out)
	   (newline out))
	  (*latex?*
	   (display "\\end{" out)
	   (display *code-env-spec* out)
	   (display "}" out)
	   (newline out))
	  (else
	   (display "\\end" out)
	   (display *code-env-spec* out)
	   (newline out)))))

(define display-tex-char
  (lambda (c p)
    (display (if (char? c) (tex-analog c) c) p)))

(define display-token
  (lambda (s typ p)
    (cond ((eq? typ 'syntax)
           (display "\\sy{" p)
           (display (texify s) p)
           (display "}" p))
	  ((eq? typ 'variable)
           (display "\\va{" p)
           (display (texify s) p)
           (display "}" p))
	  ((eq? typ 'constant)
           (display "\\cn{" p)
           (display (texify s) p)
           (display "}" p))
	  ((eq? typ 'data)
           (display "\\dt{" p)
           (display (texify-data s) p)
           (display "}" p))
	  (else (error 'display-token typ)))))