(in-package :clim-doc)

(defvar *part-number* 0)
(defvar *chapter-number* 0)
(defvar *section-number* 0)
(defvar *subsection-number* 0)
(defvar *subsubsection-number* 0)
(defvar *in-appendix* nil)

(defvar *section* nil)

;;;; definition of the tex macros

(setf (gethash "def" *tex-macros*) 'read-/def)

(setf (gethash "verb" *tex-macros*)
      (lambda (input)
        ;; We do this the same as TeX does: Using catcode hacks.
        (let ((*catcode-table* (make-hash-table :test #'eql)))
          (let ((c0 (read-token input)))
            (let ((res nil))
              (do ((tok (read-token input) (read-token input)))
                  ((token-equal c0 tok))
                (push tok res))
              ;;
              (setf res (reverse res))
              ;;
              (list `(:CODE
                      ,@res)) )))))

;; \begin{foo} is mapped to (:cs " begin foo")

(define-tex-macro "begin" "#1" (name)
  (list (make-token :cs " verify begin")
        (make-token :cs (skot name))
        (make-token :cs (format nil " begin ~A" (skot name)))))

(define-tex-macro "end" "#1" (name)
  (list (make-token :cs (format nil " end ~A" (skot name)))
        (make-token :cs " verify end")
        (make-token :cs (skot name))) )

(defvar latex/*environment-stack* nil)

(define-tex-macro " verify begin" "#1" (name)
  (push (first name) latex/*environment-stack*)
  nil)

(define-tex-macro " verify end" "#1" (name)
  (let ((tos (pop latex/*environment-stack*)))
    (unless (token-equal (first name) tos)
      (perror $input "\\end{~A} does not match \\begin{~A}."
              (token-value (first name))
              (token-value tos))))
  nil)

(define-tex-macro " begin verbatim" "" ()
  ;; Catcode hack!
  (let ((*catcode-table* (make-hash-table :test #'eql)))
    (let ((body (match-parameters (cons (make-token :param (list :required 1))
                                        (map 'list (lambda (c) (make-token :char c))
                                             "\\end{verbatim}"))
                                  $input)))
      (pop latex/*environment-stack*)
      (list `(:PRE
              ,@(first body))))))

(define-tex-macro " begin alltt" "" ()
  ;; Catcode hack!
  (let ((*catcode-table* (make-hash-table :test #'eql)))
    (let ((body (match-parameters (cons (make-token :param (list :required 1))
                                        (map 'list (lambda (c) (make-token :char c))
                                             "\\end{alltt}"))
                                  $input)))
      (pop latex/*environment-stack*)
      (list `(:PRE
              ,@(first body))))))

;;;; The Document itself

(defvar latex/*title*)
(defvar latex/*author*)

(define-tex-macro " begin document" "" ()
  (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
    (list `(:DOCUMENT
            :KIND :DOCUMENT
            :TITLE ,(or latex/*title*
                        (progn
                          (warn "Docuemnt has no title")
                          '("Unnamed Document")))
            (:NOEXPAND
             ,body)))))

(define-tex-macro "title" "#1" (title)
  (setf latex/*title*
        (expand-tokens title))
  nil)

(define-tex-macro "author" "#1" (title)
  (setf latex/*author*
        (expand-tokens title))
  nil)

(define-tex-macro " end document" "" ()
  (list (make-token :eof)))

(define-ignore "maketitle" "")

;;;;

(define-environment "itemize" "" ()
  ;; sometimes we still catch stray items
  (let ((items nil)
        (item nil))
    (dolist (k $body)
      (cond ((equal k '(++ITEM++))
             (push (reverse item) items)
             (setf item nil))
            (t
             (push k item))))
    (push (reverse item) items)
    (setf items (reverse items))
    (list `(:NOEXPAND
            ((:UL
              ,@(mapcar (lambda (x)
                          `(:LI ,@x))
                        (cdr items)))))) )) ;xxx Error checking needed

(define-environment "center" "" ()
  (list `(:NOEXPAND
          ((:CENTER
            ,@$body)))))

(define-tex-macro " begin enumerate" "" ()
  (let ((body (slurp-stream $input)))
    (let ((items nil)
          (item nil))
      (dolist (k body)
        (cond ((equal k '(++ITEM++))
               (push (reverse item) items)
               (setf item nil))
              (t
               (push k item))))
      (push (reverse item) items)
      (setf items (reverse items))
      (list `(:NOEXPAND
              ((:OL
                ,@(mapcar (lambda (x)
                            `(:LI ,@x))
                          (cdr items)))))) )))

(define-tex-macro " end enumerate" "" ()
  (list (make-token :eof)))



;;;;;;

(define-tex-macro " begin description" "" ()
  (let ((body (slurp-stream $input)))
    (let ((items nil)
          (item nil))
      (dolist (k body)
        (cond ((and (consp k) (eq (car k) '++ITEM++))
               (push (reverse item) items)
               (setf item nil)
               (push (cdr k) item))
              (t
               (push k item))))
      (push (reverse item) items)
      (setf items (reverse items))
      (list `(:NOEXPAND
              ((:DL
                ,@(mapcan (lambda (x)
                            (list `(:dt ,@(car x))
                                  `(:dd ,@(cdr x))))
                          (cdr items)))))) )))

(define-tex-macro "item" "#[1]" (x)
  (list
   `(++ITEM++ ,@x)))

(define-tex-macro " end description" "" ()
  (list (make-token :eof)))

;;;;



(define-tex-macro "newcommand" "#1#[20]#3" ;;xxx
  (name argcount body)
  (let ((n (parse-integer (coerce argcount 'string)))) ;xxx
    (append (list (make-token :cs "def"))
            ;; (remove #\space name)       ;xxx
            name
            (loop for i from 1 to n collect (make-token :param (list :required i)))
            (list (make-token :group-begin))
            body
            (list (make-token :group-end)))))

(define-ignore "renewenvironment" "#1#2#3")

(define-tex-macro "\\" "" () (list '(:BR)))
(define-tex-macro "bf" "" () (list `(:FONT :FACE :B)))
(define-tex-macro "tt" "" () (list `(:FONT :FACE :TT)))
(define-tex-macro "it" "" () (list `(:FONT :FACE :I)))
(define-tex-macro "sl" "" () (list `(:FONT :FACE :SL)))
(define-tex-macro "sf" "" () (list `(:FONT :FACE :SF)))
(define-tex-macro "&" "" () (list #\&))
(define-tex-macro "{" "" () (list #\{))
(define-tex-macro "}" "" () (list #\}))
(define-tex-macro "_" "" () (list #\_))
(define-tex-macro " " "" () (list #\space))
(define-tex-macro " char ~" "" () (list +nbsp+))
(define-tex-macro "colon" "" () (list #\:)) ;what is the magic behind this?

(define-tex-macro "texttt" "#1" (x) (list `(:TT ,@x)))
(define-tex-macro "textit" "#1" (x) (list `(:I  ,@x)))
(define-tex-macro "textbf" "#1" (x) (list `(:B  ,@x)))
(define-tex-macro "textsl" "#1" (x) (list `(:SL ,@x)))
(define-tex-macro "textsf" "#1" (x) (list `(:SF ,@x)))
(define-tex-macro "emph"   "#1" (x) (list `(:EM ,@x)))
(define-tex-macro "cl"     "#1" (x) (list `(:CL ,@x)))

(define-tex-macro "textcolor" "#1#2" (color text)
  (list `(:COLOR :COLOR ,(coerce color 'string) ,@text)))

(define-tex-macro "'" "#1" (x)
  (cond ((equal x '(#\a)) (list #\á))
        ((equal x '(#\e)) (list #\é))
        ((equal x '(#\o)) (list #\ó))
        ((equal x '(#\u)) (list #\ú))
        (t
         (warn "Accent #\\' + ~S not supported." x)
         x)))

(define-tex-macro "`" "#1" (x)
  (cond ((equal x '(#\a)) (list #\à))
        ((equal x '(#\e)) (list #\è))
        ((equal x '(#\o)) (list #\ò))
        ((equal x '(#\u)) (list #\ù))
        (t
         (warn "Accent #\\` + ~S not supported." x)
         x)))

(define-tex-macro "\"" "#1" (x)
  (cond ((equal x '(#\a)) (list #\ä))
        ((equal x '(#\e)) (list #\ë))
        ((equal x '(#\o)) (list #\ö))
        ((equal x '(#\u)) (list #\ü))
        ((equal x '(#\i)) (list #\ï))
        (t
         (warn "Accent #\\\" + ~S not supported." x)
         x)))

;; Some Characters

(defmacro define-char-macro (tex-name html-name)
  `(define-tex-macro ,tex-name "" ()
    (list `(:entity :name ,',html-name))))

(define-char-macro "cdot" "sdot")
(define-char-macro "circ" "#8728")      ;unicode 2218 RING OPERATOR
;;(define-char-macro "circ" "#111")      ; latin-1 'o'

(define-char-macro "\leq" "le")
(define-char-macro "\geq" "ge")         ;heißt das so?
(define-char-macro "\pi" "pi")
(define-char-macro "\prime" "prime")

(define-char-macro "\#" "#35")
(define-char-macro "Rightarrow" "rArr")
(define-char-macro "Leftarrow" "lArr")
(define-char-macro "rightarrow" "rarr")
(define-char-macro "leftarrow" "larr")

(define-tex-macro "%" "" () (list #\%))

;;;; Labels

(define-tex-macro "label" "#1" (name)
  (let ((name (skot name)))
    (list `(:LABEL :NAME ,name))))

(define-tex-macro "ref" "#1" (name)
  (let ((name (skot name)))
    (list `(:REF :NAME ,name))))


;;;;

(defvar *figure-number* 0)
(defvar *table-number* 0)

(define-tex-macro "part" "#1" (title)
  (let ((*stop-words* (list* "part" *stop-words*)))
    (incf (car *section*))
    (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
      (list `(:SECTION
              :KIND :PART
              :TITLE (,(format nil "Part ~@r: " (incf *part-number*))
                      ,@(expand-tokens title))
              :NAME ,*section*
              (:NOEXPAND
               ,body))))))

(define-tex-macro "chapter" "#1" (title)
  (let ((*stop-words* (list* "chapter" "part" *stop-words*)))
    (incf *chapter-number*)
    (setf *section-number* 0)
    (setf *figure-number* 0)
    (setf *table-number* 0)
    (incf (car *section*))
    (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
      (list `(:SECTION
              :TITLE (,(if *in-appendix*
                           (format nil "~A "
                                   (elt "@ABCDEFGHIJKLMNOPQRSTUVWXYZ" *chapter-number*))
                           (format nil "~D "
                                   *chapter-number*))
                      ,@(expand-tokens title))
              :KIND :CHAPTER
              :NAME ,*section*
              (:NOEXPAND
               ,body))))))

(define-tex-macro "section" "#1" (title)
  (let ((*stop-words* (list* "section" "chapter" "part" *stop-words*)))
    (incf *section-number*)
    (setf *subsection-number* 0)
    (incf (car *section*))
    (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
      (list `(:SECTION
              :TITLE (,(if *in-appendix*
                           (format nil "~A.~D "
                                   (elt "@ABCDEFGHIJKLMNOPQRSTUVWXYZ" *chapter-number*)
                                   *section-number*)
                           (format nil "~D.~D "
                                   *chapter-number*
                                   *section-number*))
                      ,@(expand-tokens title))
              :KIND :SECTION
              :NAME ,*section*
              (:NOEXPAND
               ,body))))))

(define-tex-macro "subsection" "#1" (title)
  (let ((*stop-words* (list* "subsection" "section" "chapter" "part" *stop-words*)))
    (setf *subsubsection-number* 0)
    (incf *subsection-number*)
    (incf (car *section*))
    (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
      (list `(:SECTION
              :TITLE (,(if *in-appendix*
                           (format nil "~A.~D.~D "
                                   (elt "@ABCDEFGHIJKLMNOPQRSTUVWXYZ" *chapter-number*)
                                   *section-number*
                                   *subsection-number*)
                           (format nil "~D.~D.~D "
                                   *chapter-number*
                                   *section-number*
                                   *subsection-number*))
                      ,@(expand-tokens title))
              :KIND :SUBSECTION
              :NAME ,*section*
              (:NOEXPAND
               ,body))))))

(define-tex-macro "subsubsection" "#1" (title)
  (let ((*stop-words* (list* "subsubsection" "section" "chapter" "part" *stop-words*)))
    (incf *subsubsection-number*)
    (incf (car *section*))
    (let ((body (let ((*section* (cons 0 *section*))) (slurp-stream $input))))
      (list `(:SECTION
              :TITLE (,(if *in-appendix*
                           (format nil "~A.~D.~D.~D "
                                   (elt "@ABCDEFGHIJKLMNOPQRSTUVWXYZ" *chapter-number*)
                                   *section-number*
                                   *subsection-number*
                                   *subsubsection-number*)
                           (format nil "~D.~D.~D.~D "
                                   *chapter-number*
                                   *section-number*
                                   *subsection-number*
                                   *subsubsection-number*))
                      ,@(expand-tokens title))
              :KIND :SUBSUBSECTION
              :NAME ,*section*
              (:NOEXPAND
               ,body))))))

(define-tex-macro "paragraph" "#1" (title)
  (let ((*stop-words* (list* "paragraph" "subsubsection" "section" "chapter" "part" *stop-words*)))
    (let ((body (slurp-stream $input)))
      (list `(:SECTION
              :TITLE ,(expand-tokens title)
              :KIND :PARAGRAPH
              (:NOEXPAND
               ,body))))))

;;;; some ignores

(define-ignore "documentclass" "#1")
(define-ignore "long" "")

(define-ignore "index" "#1")            ;should that really be ignored?

(define-tex-macro "usepackage" "#[1]#2" (options packagename)
  (print `(:usepackage ,(skot options) ,(skot packagename)))
  nil)

(define-ignore "setlength" "#1#2")


;;;; \include

(defparameter *nono-files* (list "psfig+"))

(define-tex-macro "include" "" ()
  (list (make-token :cs "input")))

(define-tex-macro "input" "#1 " (filename)
  (let ((filename (skot filename)))
    (unless (member filename
                    *nono-files*
                    :test #'string-equal)
      (let ((filename (merge-pathnames filename
                                       *input-filename-defaults*)))
        (format T "~&;; Reading file ~S~%" filename)
        (when (probe-file filename)
          (with-open-file (i filename)
            (list `(:NOEXPAND ,(slurp-stream (make-tex-input i))))))))))

;;;; tabular

;; through reverse engineering i found that LaTex collects the column
;; specification into a number columns like the following:

;; |c|c| --> {|c|}{c|}
;;
;; That is the first column is {|c|} while the second is {c|}.

;; \multicolumn essentially replaces the column spec provided by the
;; tabular environment with its own.

;; so we parse column specs into:

;; (:COL :BEFORE <before> :AFTER <after> :ALIGN {:CENTER | :LEFT | :RIGHT } :WIDTH { NIL | dim })
;;
;; where before/after is simply some text to be inserted. The text is
;; to be inserted at left/right edge of the cell.
;; Note that at all but the first column the :before stuff is empty.

(defun parse-colspec (tokens)
  "Parse a TeX colspec as seen in \\tabluar{colspec}."
  (let ((xs (parse-colspec-1 tokens)))
    (labels ((foo (xs)
               (let* ((p1 (position-if (lambda (x) (eq (node-gi x) :COL)) xs))
                      (p2 (and p1 (position-if (lambda (x) (eq (node-gi x) :COL)) xs :start (1+ p1)))))
                 (cons
                      `(:COL ,@(node-attributes (elt xs p1))
                        :before ,(subseq xs 0 p1)
                        :after  ,(subseq xs (+ p1 1) (or p2 (length xs))))
                      (and p2 (foo (subseq xs p2)))))))
      (foo xs))))
  
(defun parse-colspec-1 (tokens)
  "Parse a TeX colspec as seen in \\tabluar{colspec}."
  (cond ((null tokens) nil)
        ((eql (car tokens) #\r) (cons '(:COL :ALIGN :RIGHT)    (parse-colspec-1 (cdr tokens))))
        ((eql (car tokens) #\l) (cons '(:COL :ALIGN :LEFT)     (parse-colspec-1 (cdr tokens))))
        ((eql (car tokens) #\c) (cons '(:COL :ALIGN :CENTER)   (parse-colspec-1 (cdr tokens))))
        ((eql (car tokens) #\|) (cons '(:BAR) (parse-colspec-1 (cdr tokens))))
        ((eql (car tokens) #\p)
         (multiple-value-bind (wd more) (chop-off-group (cdr tokens))
           (cons (list :COL :ALIGN :LEFT :WIDTH (skot wd))
                 (parse-colspec-1 more))))
        ((eql (car tokens) #\@)
         (multiple-value-bind (text more) (chop-off-group (cdr tokens))
           (append (expand-tokens text)
                   (parse-colspec-1 more))))
        ((eql (car tokens) #\*)
         (multiple-value-bind (num more) (chop-off-group (cdr tokens))
           (multiple-value-bind (cols more) (chop-off-group more)
             (append (loop repeat (parse-integer (skot num))
                       append (parse-colspec-1 cols))
                 (parse-colspec-1 more)))))
        (t
         (error "Bad colspec. ~S" tokens)) ))
  
(defun common-tabular (spec $input)
  (let ((body (let-tex-macro ("multicolumn" " tabular multicolumn")
                (let-tex-macro ("\\" " tabular \\")
                  (let-tex-macro (" char &" " tabular &")
                    (let-tex-macro ("hline" " tabular hline")
                      (let-tex-macro ("vline" " tabular vline")
                        (slurp-stream $input))))))))
    (let ((spec (parse-colspec spec)))
      (list
       `(:TABULAR
         (:noexpand ,(parse-tabular-content body spec))
         )))))

;;


(defun parse-tabular-content (stuff colspecs)
  (let ((current-cell nil)
        (current-row nil)
        (hlinep nil)
        (curcol 0)
        (res nil))
    ;; \hline
    ;; we treat a hline as
    ;; OOPS we still have a few problems with white space. I love this white space business!
    (labels ((make-td (colspec content &optional (span 1))
               (print (list colspec content))
               (let* (left-bar
                      right-bar
                      (content `(,@(mapcan (lambda (x)
                                             (cond ((equal x '(:BAR))
                                                    (setf left-bar t)
                                                    nil)
                                                   (t
                                                    (list x))))
                                           (node-attr colspec :before))
                                 ,@content
                                 ,@(mapcan (lambda (x)
                                             (cond ((equal x '(:BAR))
                                                    (setf right-bar t)
                                                    nil)
                                                   (t
                                                    (list x))))
                                           (node-attr colspec :after)))))
                 `(:TD
                   :ALIGN   ,(or (node-attr colspec :align)
                                 (error "Colspec ~S has no align attribute?" colspec))
                   :VALIGN  :BASELINE
                   ,@(if (node-attr colspec :width) nil (list :NOWRAP :NOWRAP))
                   :STYLE   ,(format nil "padding: 0 .5ex; ~A~A~A"
                                     (if left-bar "border-left: 1px solid;" "")
                                     (if right-bar "border-right: 1px solid;" "")
                                     (if hlinep    "border-top: 1px solid;" ""))
                   :COLSPAN ,span
                   (:GROUP ,@content))))
             (finish-cell (&aux x)
               ;; ### we could need some error checking here, since we do nonsense on e.g.
               ;;     foo \multicolumn{2}{c}{...} bar
               ;;
               (when (< curcol (length colspecs)) ;xxx
                 (cond ((setf x (find :td current-cell :key #'node-gi))
                        (push x current-row))
                       (t
                        (push (make-td (elt colspecs curcol) (reverse current-cell))
                              current-row)))
                 (incf curcol (node-attr (car current-row) :colspan)))
               (setf current-cell nil))
             (finish-row ()
               (push `(:TR
                       ,@(reverse current-row)) res)
               (setf current-row nil)
               (setf hlinep nil)
               (setf curcol 0)))
      (dolist (item stuff)
        (case (node-gi item)
          ((:BAR)
           ; xxx
           )
          ((:HLINE)
           (setf hlinep t))
          ((:TAB)
           (finish-cell))
          ((:CR)
           (finish-cell)
           (finish-row))
          ((:MULTICOLUMN)
           (print item)
           ;; now multicolumn is a bit strange ... note that vertical
           ;; bars seem to vanish on \multicolumn items and that you
           ;; can reintroduce them by specifing it in the colspec of
           ;; the \multicolumn item. it is not clear to me where the
           ;; vertical bars are actually inserted.
           (push (make-td (node-attr item :colspec) (node-children item) (node-attr item :n))
                 current-cell))
          (t
           (push item current-cell))))
      (unless (and (null (clean-inline* current-cell))
                   (null current-row))
        (finish-cell)
        (finish-row))
      (when hlinep
        ;; hack the last row
        (setf res
              (cons `(:TR
                      ,@(node-attributes (car res))
                      ,@(mapcar (lambda (td)
                                  (let ((xs (node-attributes td)))
                                    (setf (getf xs :style)
                                          (concatenate 'string "border-bottom: 1px solid;" (getf xs :style)))
                                    `(:TD ,@xs ,@(node-children td))))
                                (node-children (car res))))
                    (cdr res))))
      (reverse res))))

(define-tex-macro " begin tabular" "#1" (spec)
  (common-tabular spec $input))

(define-tex-macro " end tabular" "" ()
  (list (make-token :eof)))

(define-tex-macro " tabular multicolumn" "#1#2#3" (n colspec text)
  (list `(:noexpand ((:MULTICOLUMN
                      :N ,(parse-integer (skot n))
                      :COLSPEC ,(first (parse-colspec colspec))
                      ,@(expand-tokens
                         (append (list (make-token :group-begin))
                                 text
                                 (list (make-token :group-end)))))))))

(define-tex-macro " tabular &" "" ()
  (list `(:TAB)))

(define-tex-macro " tabular \\" "" ()
  (list `(:CR)))

(define-tex-macro " tabular hline" "" ()
  (list '(:HLINE)))

(define-tex-macro " tabular vline" "" ()
  (list '(:BAR)))

(define-tex-macro " begin array" "#1" (spec)
  (let ((*math-mode-p* t))
    ;; cut + paste alert from tabular XXX
    (common-tabular spec $input)))

(define-tex-macro " end array" "" ()
  (list (make-token :eof)))

(define-tex-macro " begin eqnarray*" "" ()
  (let ((*math-mode-p* t))
    ;; cut + paste alert from tabular XXX
    (common-tabular '(#\r #\c #\l) $input)))

(define-tex-macro " end eqnarray*" "" ()
  (list (make-token :eof)))

;;;; Figure

(defvar *caption*)

(define-tex-macro " begin figure" "" ()
  (let ((*caption* nil)
        (number nil))
    (incf *figure-number*)
    (setf number (format nil "~D.~D" *chapter-number* *figure-number*)) ;### not quite right
    (let ((body (let-tex-macro ("caption" " caption")
                  (slurp-stream $input))))
      (list
       `(:FIGURE
         :NUMBER ,number
         :CAPTION ,*caption*
         (:noexpand ,body))))))

(define-tex-macro " end figure" "" ()
  (list (make-token :eof)))

(define-tex-macro " caption" "#1" (caption)
  (setf *caption* (expand-tokens caption))
  nil)

;;;; table

(define-tex-macro " begin table" "" ()
  (let ((*caption* nil)
        (number))
    (incf *table-number*)
    (setf number (format nil "~D.~D" *chapter-number* *table-number*)) ;### not quite right
    (let ((body (let-tex-macro ("caption" " caption")
                  (slurp-stream $input))))
      (list
       `(:TABLE
         :NUMBER ,number
         :CAPTION ,*caption*
         (:noexpand ,body))))))

(define-tex-macro " end table" "" ()
  (list (make-token :eof)))

;;;;

(define-tex-macro "centerline" "#1" (body)
  (list
   `(:CENTER
     ,@body)))

;;;; cruft

(define-ignore "vspace" "#1")
(define-ignore "renewcommand" "#1#2")

(define-tex-macro "par" "" ()
  (list (make-token :par)))

(define-tex-macro "huge" "" () (list `(:FONT :FACE :HUGE)))

(define-tex-macro "sqrt" "#1" (something)
  (append
   (list `(:noexpand ("sqrt(")))
   something
   (list `(:noexpand (")")))))


;;; ------------------------------------------------------------------------------------------
;;;  Tabbing
;;;

;; Tabbing sub-commands in LaTeX:

;;   The \= command sets the tab stops.

;;   The \> command causes LaTeX to advance to the next tab stop.

;;   The \< command allows you to put something to the left of the local
;;   margin without changing the margin.

;;   The \+ command moves the left margin of the next and all the
;;   following commands one tab stop to the right.
;;   [Only the next line --GB]

;;   The \- command moves the left margin of the next and all the
;;   following commands one tab stop to the left.
;;   [Only the next line --GB]

;;   The \' command moves everything that you have typed so far in the
;;   current column , everything starting from the most recent \>, \<,
;;   \', \\, or \kill command, to the right of the previous column,
;;   flush against the current column's tab stop.

;;   The \` command allows you to put text flushed right against any tab
;;   stop, including tab stop 0. However, it can't move text to the
;;   right of the last column because there's no tab stop there. The \`
;;   command moves all the text that follows it, up to the \\ or
;;   \end{tabbing} command that ends the line, to the right margin of
;;   the tabbing environment. There must be no \> or \' command between
;;   the \` and the command that ends the line.

;;   [This seems to move to the text right margin ... --GB]

;;   The \kill command allows you to set tab stops without producing
;;   text. It works just like the \\ except that it throws away the
;;   current line instead of producing output for it. The effect of
;;   any \=, \+ or \- commands in that line remain in effect.
;;
;;   [Aha --GB]
;;

;; We see that for a first thing we can remove \< \+ \- by seeing then
;; as kind of macros. Further we can remove \' and \` since
;; description is bogus.

;; So we are left with \= \> \kill and \\.

;; The first idea is to convert a tabbing environment but that is not
;; possible in general, consider:
;;
;;  x \= y \= z \\
;;  a \= b \> c \\
;;  d \> e \= f \\
;;  p \> q \> r \\
;;


;;;;;

(define-tex-macro "today" "" ()
  (list `(:NOEXPAND
          (,(apply #'format nil "~D-~2,'0D-~2,'0D"
                   (reverse (subseq (multiple-value-list
                                        (decode-universal-time (get-universal-time)))
                                    3 6)))))))

(define-tex-macro "pagebreak" "" () nil)
(define-tex-macro "makeindex" "" () nil)
(define-tex-macro "printindex" "" () (list `(:noexpand ((:printindex)))))

(define-tex-macro "date" "#1" (x) x nil)
(define-tex-macro "markright" "#1" (x) x nil)
(define-tex-macro "pagestyle" "#1" (x) x nil)
(define-tex-macro "addtolength" "#1#2" (x y) x y nil)

;;;;;


;; tabular

;; cols:
;; 'l' = left aligned column
;; 'r' = right aligned column
;; 'c' = centered column
;; 'p{wd}' = fixed size column
;; '|' = vertical bar
;; '@{text}' = added text
;; '*{num}{cols}' = num times cols

;; pos:
;; 't' = align the tabular top
;; 'b' = align the tabular bottom

;; \cline{i-j} = draws horizontal lines across the columns specified,
;;               beginning in column i and ending in column j

;; \hline      = draw a horizontal line the width of the table.

;; \multicolumn{cols}{pos}{text}
;;      cols = number of columns to span
;;      pos  = c,l,r  horizontal alignment
;;      text = content
;;
;; \vline
;;

;;; so we parse this into

;; & --> (:TAB)
;; \\ --> (:CR)
;; \multicolumn{cols}{pos}{text} -> (:MULTI-COLUMN cols pos ...)
;;


;;;;;;;

(define-tex-macro "[" "" ()
  (let-tex-macro ("]" " []")
    (let ((*math-mode-p* t))
      (list `(:NOEXPAND ((:DISPMATH ,@(slurp-stream $input))))))))

(define-tex-macro " []" "" ()
  (list (make-token :eof)))

(define-tex-macro "left" "" ()
  (let-tex-macro ("right" " left right")
    (let ((left (read-token $input))
          (cont (slurp-stream $input))
          (right (read-token $input)))
      (list `(:NOEXPAND ((:PAREN :LEFT ,left :RIGHT ,right
                          ,@cont)))))))

(define-tex-macro " left right" "" ()
  (list (make-token :eof)))

(define-tex-macro "newpage" "" ()
  nil)

(define-tex-macro "hrule" "" ()
  (list `(:NOEXPAND ((:HR)))))

(define-tex-macro "appendix" "" ()
  (setf *in-appendix* t)
  (setf *chapter-number* 0)
  nil)

(define-tex-macro "tableofcontents" "" ()
  (list `(:NOEXPAND (,(list :TABLEOFCONTENTS))))) ;we cons here because (:TABLEOFCONTENTS) itself
                                                  ; will be destructively modified ...