
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MODULE      : texout.scm
;; DESCRIPTION : generation of TeX/LaTeX from scheme expressions
;; COPYRIGHT   : (C) 2002  Joris van der Hoeven
;;
;; This software falls under the GNU general public license and comes WITHOUT
;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
;; If you don't have this file, write to the Free Software Foundation, Inc.,
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define texout-initialized #f)
(define texout-lang-preamble (make-hash-table 100))
(define texout-lang-select (make-hash-table 100))

(define texout-lang-preamble-def
  '(("czech" "\\usepackage[czech]{babel}\n")
    ("dutch" "\\usepackage[dutch]{babel}\n")
    ("french" "\\usepackage[french]{babel}\n")
    ("german" "\\usepackage[german]{babel}\n")
    ("hungarian" "\\usepackage[hungarian]{babel}\n")
    ("italian" "\\usepackage[italian]{babel}\n")
    ("polish" "\\usepackage[polish]{babel}\n")
    ("portuguese" "\\usepackage[portuges]{babel}\n")
    ("romanian" "\\usepackage[romanian]{babel}\n")
    ("russian"
     "\\usepackage[cp1251]{inputenc}\n\\usepackage[russian]{babel}\n")
    ("spanish" "\\usepackage[spanish]{babel}\n")
    ("swedish" "\\usepackage[swedish]{babel}\n")))

(define texout-lang-select-def
  '(("czech" "\\SelectCzech\n")
    ("dutch" "\\SelectDutch\n")
    ("french" "\\SelectFrench\n")
    ("german" "\\SelectGerman\n")
    ("hungarian" "\\SelectHungarian\n")
    ("italian" "\\SelectItalian\n")
    ("polish" "\\SelectPolish\n")
    ("portuguese" "\\SelectPortugese\n")
    ("romanian" "\\SelectRomanian\n")
    ("russian" "\\SelectRussian\n")
    ("spanish" "\\SelectSpanish\n")
    ("swedish" "\\SelectSwedish\n")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (texout-initialize)
  (if (not texout-initialized)
      (begin
	(set! texout-initialized #t)
	(fill-dictionary texout-lang-preamble texout-lang-preamble-def)
	(fill-dictionary texout-lang-select texout-lang-select-def))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Outputting preamble and postamble
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (texout-file l)
  (let* ((doc (car l))
	 (styles (cadr l))
	 (prestyle (car styles))
	 (style (if (equal? prestyle "help") "letter" prestyle))
	 (lang (caddr l))
	 (lpreamble (hash-ref texout-lang-preamble lang))
	 (lselect (hash-ref texout-lang-select lang))
	 (tmpath (cadddr l)))

    (output-verbatim "\\documentclass{" style "}\n")
    (if lpreamble (output-verbatim lpreamble))
    (output-verbatim "\\IfFileExists{TeXmacs.sty}\n"
		     "  {\\usepackage{TeXmacs}}\n"
		     "  {\\usepackage{" tmpath "/misc/latex/TeXmacs}}\n")
    (exec-unary texout-usepackage (cdr styles))
    (if (in? style '("letter" "article"))
	(output-verbatim
	 "\\newcommand{\\chapter}[1]{"
	 "\\tmsection{\\begin{center}\\huge #1\\end{center}}"
	 "}\n"))
    (if (equal? style "letter")
	(output-verbatim
	 "\\newcommand{\\section}[1]{\\tmsection{\\LARGE #1}}\n"
	 "\\newcommand{\\subsection}[1]{\\tmsection{\\Large #1}}\n"
	 "\\newcommand{\\subsubsection}[1]{\\tmsection{\\large #1}}\n"
	 "\\newcommand{\\paragraph}[1]{\\tmparagraph{#1}}\n"
	 "\\newcommand{\\subparagraph}[1]{\\tmparagraph{#1}}\n"))

    (output-lf)
    (output-text "\\begin{document}")
    (output-lf)
    (if lselect (output-verbatim lselect))
    (output-lf)
    (texout doc)
    (output-lf)
    (output-lf)
    (output-text "\\end{document}")
    (output-lf)))

(define (texout-usepackage x)
  (output-verbatim "\\usepackage{" x "}\n"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Outputting main flow
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (texout-document l)
  (if (not (null? l))
      (begin
	(texout (car l))
	(if (not (null? (cdr l)))
	    (begin
	      (output-lf)
	      (output-lf)))
	(texout-document (cdr l)))))

(define (texout-paragraph l)
  (if (not (null? l))
      (begin
	(texout (car l))
	(if (not (null? (cdr l))) (output-lf))
	(texout-paragraph (cdr l)))))

(define (texout-table l)
  (if (not (null? l))
      (begin
	(if (func? (car l) '!row)
	    (begin
	      (texout-row (cdar l))
	      (if (not (null? (cdr l)))
		  (begin
		    (output-text "\\\\")
		    (output-lf))))
	    (begin
	      (texout (car l))
	      (if (not (null? (cdr l))) (output-lf))))
	(texout-table (cdr l)))))

(define (texout-row l)
  (if (not (null? l))
      (begin
	(texout (car l))
	(if (not (null? (cdr l))) (output-text " & "))
	(texout-row (cdr l)))))

(define (texout-concat l)
  (if (not (null? l))
      (begin
	(texout (car l))
	(texout-concat (cdr l)))))

(define (texout-newline)
  (output-lf)
  (output-lf))

(define (texout-nextline)
  (output-text "\\\\")
  (output-lf))

(define (texout-verb x)
  (output-verb "¤" x "¤"))

(define (texout-verbatim x)
  (output-lf-verbatim "\\begin{verbatim}\n" x "\n\\end{verbatim}"))

(define (texout-group x)
  (output-text "{")
  (texout x)
  (output-text "}"))

(define (texout-empty? x)
  (cond ((equal? x "") #t)
	((func? x '!concat)
	 (eval (cons and (map-unary texout-empty? (cdr x)))))
	((func? x '!document 1) (texout-empty? (cadr x)))
	(else #f)))

(define (texout-math x)
  (if (not (texout-empty? x))
      (begin
	(output-text "$")
	(texout x)
	(output-text "$"))))

(define (texout-eqn x)
  (output-text "\\[ ")
  (output-indent 3)
  (texout x)
  (output-indent -3)
  (output-text " \\]"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Outputting macro applications and environments
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (texout-arg x)
  (output-text "#" x))

(define (texout-args l)
  (if (not (null? l))
      (begin
	(if (and (list? (car l)) (equal? (caar l) '!option))
	    (begin
	      (output-text "[")
	      (texout (cadar l))
	      (output-text "]"))
	    (begin
	      (output-text "{")
	      (texout (car l))
	      (output-text "}")))
	(texout-args (cdr l)))))

(define (texout-apply what args)
  (output-text "\\" what)
  (texout-args args))

(define (texout-begin what args inside)
  (output-text "\\begin{" what "}")
  (texout-args args)
  (output-indent 2)
  (output-lf)
  (texout inside)
  (output-indent -2)
  (output-lf)
  (output-text "\\end{" what "}"))

(define (texout-contains-table? x)
  (cond ((not (list? x)) #f)
	((and (>= (length x) 2) (equal? (car x) '!table)) #t)
	(else (eval (cons 'or (map-unary texout-contains-table? (cdr x)))))))

(define (texout-script where l)
  (output-text where)
  (let ((x (car l)))
    (cond ((and (string? x) (= (string-length x) 1)) (output-text x))
	  ((texout-contains-table? x)
	   (output-text "{\\tmscript{")
	   (texout x)
	   (output-text "}}"))
	  (else (texout-args l)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main output routines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (texout x)
  (cond ((string? x) (output-text x))
	((equal? (car x) '!file) (texout-file (cdr x)))
	((equal? (car x) '!document) (texout-document (cdr x)))
	((equal? (car x) '!paragraph) (texout-paragraph (cdr x)))
	((equal? (car x) '!table) (texout-table (cdr x)))
	((equal? (car x) '!concat) (texout-concat (cdr x)))
	((equal? (car x) '!newline) (texout-newline))
	((equal? (car x) '!nextline) (texout-nextline))
	((equal? (car x) '!verb) (texout-verb (cadr x)))
	((equal? (car x) '!verbatim) (texout-verbatim (cadr x)))
	((equal? (car x) '!arg) (texout-arg (cadr x)))
	((equal? (car x) '!group) (texout-group (cadr x)))
	((equal? (car x) '!math) (texout-math (cadr x)))
	((equal? (car x) '!eqn) (texout-eqn (cadr x)))
	((equal? (car x) '!sub) (texout-script "_" (cdr x)))
	((equal? (car x) '!sup) (texout-script "^" (cdr x)))
	((and (list? (car x)) (equal? (caar x) '!begin))
	 (texout-begin (cadar x) (cddar x) (cadr x)))
	(else (texout-apply (car x) (cdr x)))))

(define (texout-produce x)
  (texout-initialize)
  (texout x)
  (output-produce))
