;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; LUSH Lisp Universal Shell
;;;   Copyright (C) 2002 Leon Bottou, Yann Le Cun, AT&T Corp, NECI.
;;; Includes parts of TL3:
;;;   Copyright (C) 1987-1999 Leon Bottou and Neuristique.
;;; Includes selected parts of SN3.2:
;;;   Copyright (C) 1991-2001 AT&T Corp.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  $Id: brace.lsh,v 1.10 2003/01/17 07:13:59 profshadoko Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Functions and classes to handle brace lists.
;; brace lists are list 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utilities

(defvar brace.lush-keywords
  '("(cond" "(if" "(when" "(for" "(each" "(all"
    "(while" "(let" "(let*" "(progn" "(prog1" 
    "(let-filter" "(reading" "(writing" "(selectq"
    "(do-while" "(mapwhile" "(mapfor" "(repeat"
    "(idx-eloop" "(idx-bloop" "(idx-gloop"
    "(ifdef" "(ifcompiled"
    "(lambda" "(flambda" "(mlambda" 
    "(on-error" "(on-break"
    "(de" "(df" "(dmc" "(dmd" "(dz" "(dm" "(dhm-p" "(dhm-t" "(dhm-c" "(defun"
    "(demethod" "(dfmethod" "(dmmethod"
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(de list-get-strings (l)
  (let ((r ()))
    (each ((x l)) (if (stringp x) (setq r (cons x r))))
    (reverse r)))

(de first-string (l)
  (while (and l (not (stringp (car l)))) (setq l (cdr l)))
  (car l))

;; string literal: turns a brace into a single string.
;; allows to type a brace expression to build a
;; complicated string with non-escaped characters.
(df <lit> p 
  (let ((r "")) 
    (each ((x p))
      (cond 
       ((stringp x) (setq r (concat r x)))
       ((and (numberp x) (>= x 1)) (repeat x (setq r (concat r " "))))
       ((and (numberp x) (= x -1)) (setq r (concat r "\n")))
       ((and (numberp x) (= x -2)) (setq r (concat r "\t")))
       (t (error "illegal object in literal brace"))))
    r))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; brace macro for double-quote-free text
;; syntax: 
;;   '{<xxx> yyy,   qqq {<zzz> aaa} ,(bbb ccc) ,$ddd}
;;   '{<xxx> yyy, \\  qqq {<zzz> aaa} \(bbb ccc) \$ddd}
;; is turned into:
;;   (<xxx> 1 "yyy" "," 1 "\\" 2 "qqq" 1 (<zzz> 1 "aaa") 1 (bbb ccc) 1 ddd)
;; The first element of each brace must be one of the legal tags, which
;; are all of the form <tag>. The legal tags are available in the
;; global variable brace.tags. 
;; comma or backslash followed by a parenthesized expression: returns expression
;; comma followed by $ followed by expression: returns expression 
;;   (useful for symbols) (can be a symbol)
;; comma followed by another comma (or two backslashes): 
;;   return evaluated expression
;; comma follow by anything else is a comma.
;; number of spaces is inserted as an integer between strings
;; -1 is inserted where carriage returns are
;; -2 is inserted where tabs are
;; preformatted text can inserted (with no need to escape special chars)
;; using the {<pre> xxxx </pre>} and {<code> xxxx </code>} tags.

(de brace.read-text(&optional leave-bracket)
  (let ((nextchar (skip-char "")))
    (selectq nextchar
      (" " (len (read-string " ")))
      ("\n" (read-string 1) 
       (if (<> "\n" (skip-char "")) -1
	 (read-string 1) (list '<p> -1)))
      ("\t" (read-string 1) -2)
      ("{" (read))
      (("," "\\")
       (read-string 1)
       (let ((n (skip-char "")))
	 (selectq n
	  ("(" (read))
	  ("$" (read-string 1) (read))
	  (("," "@") (read-string 1) (eval (read)))
	  ("{" (read-string 1))
	  ("}" (read-string 1))
	  (("," "\\") (read-string 1) (eval (read)))
	  (t nextchar))))
      ("}" (read-string 1) "<END>")
      ("\e" "<END>")
      ("<" (if leave-bracket
	       (read-string "~ ,{}\n\t\\")
	     (read-string 1) (brace.read-bracket)))
      (t (read-string "~ ,{}<\n\t\\")))))

(de brace.read-bracket ()
  (let ((pgm (list '<c>))
	(again t)
	(found-endtag ()))
    (while again
      (let ((item 
	     (let ((nextchar (skip-char "")))
	       (selectq nextchar
		 (" " (len (read-string " ")))
		 ("\n" (read-string 1) -1)
		 ("\t" (read-string 1) -2)
		 ("\e" "<END>")
		 (">" (read-string 1) (setq found-endtag t) "<END>")
		 (t (read-string "~ >\n\t\e"))))))
        (cond
         ((= item "<END>")
	  (setq again ()))
	  ;; end of file: no end tag
          ;; (error "no end tag for pre-formatted text") 
         (t (setq pgm (nconc1 pgm item))))))
    pgm))

;; read preformatted text
(de brace.read-pre (endtag)
  (let ((pgm ())
	(again t)
	(found-endtag ()))
    (while again
      (let ((item 
	     (let ((nextchar (skip-char "")))
	       (selectq nextchar
		 (" " (len (read-string " ")))
		 ("\n" (read-string 1) -1)
		 ("\t" (read-string 1) -2)
		 ("\e" "<END>")
		 ("}" (read-string 1) (if found-endtag "<END>" "}"))
		 (t (read-string "~ }\n\t\e"))))))
        (cond
         ((= item endtag)
	  ;; insert end tag in preformatted doc
          (setq pgm (nconc1 pgm (namedclean item)))
	  (setq found-endtag t))
	 ;; ((and (stringp item) (regex-match "{<.+>" item))
	 ;; we found a brace and a tag, this must be a mistake
	 ;; (error "no end tag for pre-formatted text?"))
         ((= item "<END>")
	  (setq again ()))
	  ;; end of file: no end tag
          ;; (error "no end tag for pre-formatted text") 
         (t
          (setq pgm (nconc1 pgm item))))))
    pgm))
    

(de brace.read-tag (tags)
  (let ((tag (progn (read-string " \t\n") (read-string "~ \t\n{}"))))
    (if (member tag tags) 
	tag
      (error (sprintf "illegal tag in brace construct: %s" tag)) )))
  
(de brace.read-body (pgm)
  (let ((again t))
    (while again
      (let ((item (brace.read-text)))
	(cond
	 ((= item "<END>")
	  (setq again ()) )
	 ((= item "\e")
	  (error "unbalanced brace construct { }") )
	 (t
	  (setq pgm (nconc1 pgm item)))))))
  pgm)

(de brace.ex-tmp () 
  (if (stringp *brace.ex-tmp*) 
      *brace.ex-tmp* (defvar *brace.ex-tmp* (tmpname))))

;; read preformatted text
(de brace.read-example ()
  (let ((a (read)))
    (read-string "~ \n\e")
    (when (<> (skip-char "") "\e") (read-string 1))
    (writing (brace.ex-tmp)
      (printf "? ")
      (pprint a)
      (let ((result (eval a)))
	(printf "= ")
	(pprint result) )
      (printf "\n</code>\n"))
    (reading (brace.ex-tmp) 
      (cons '<code> (brace.read-pre "</code>")))))


(de brace.read (tags)
  (let ((tag (brace.read-tag tags)))
    (cond
     ((member tag '("<pre>" "<code>" "<PRE>" "<CODE>"))
      (let ((endtag (regex-subst "<" "</" tag)))
	(cons (namedclean tag) (brace.read-pre endtag))))
     ((member tag '("<ex>" "<EX>"))
      (brace.read-example))
     (t (brace.read-body (list (namedclean tag)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; list of old-style tags
;; these are the tag that take no argument
(defvar brace.old-tags-noargs-map
  '((".P" . <p>) (".PP" . <p>) (".BR" . <br>)))
	
;; these are the tags that take an argument on the same line
(defvar brace.old-tags-lineargs-map
  '((".TYPE" . <type>)
    (".DESC" . <desc>)
    (".FILE" . <location>)
    (".HLINK". <hlink>) (".SEE" . <see>)
    (".AUTHOR" . <author>) (".AUTH" . <author>)
    (".DATE" . <author>)
    (".EX" . <ex>)
    (".IMG" . <img>) (".EPS" . <img>) ))

;; these are the tags whose argument is the text until the next tag
(defvar brace.old-tags-textargs-map
  '((".LI" . <li>) (".IP" . <li>)
    (".PRE" . <pre>) (".VP" . <pre>)
    (".CODE" . <code>)
    (".DIV" . <div>)
    (".IFOGRE" . <if-ogre>)
    (".IFHLP" . <if-ogre>) (".IFHELP" . <if-ogre>)
    (".IFTEX" . <if-latex>) (".IFTXT" . <if-text>)
    (".IFHTML" . <if-html>)))

(defvar brace.old-tags-noargs
  (mapcar car brace.old-tags-noargs-map))
(defvar brace.old-tags-lineargs
  (mapcar car brace.old-tags-lineargs-map))
(defvar brace.old-tags-textargs
  (mapcar car brace.old-tags-textargs-map))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; read an old-style tag and the arguments
;; that come with it.
(de brace.read-old-tag()
  (let ((tag (read-string "~ \e\t\n"))
	(<tag> ()))
    (cond
     ;; is it a tag with no args
     ((setq <tag> (alist-get tag brace.old-tags-noargs-map))
      (list <tag>))
     ;; is it an example tag
     ((= tag ".EX") (list '<div> '(<br>) (brace.read-example)))
     ;; is it a tag with a single line arg
     ((setq <tag> (alist-get tag brace.old-tags-lineargs-map))
	(let ((stop ()) (rez (list <tag>)))
	  (while (not stop)
	    (let ((token (brace.read-old-token)))
	      (cond 
	       ((= token "<EOF>") (setq stop t) token)
	       ((= token -1) (setq stop t) (nconc1 rez -1))
	       (t (nconc1 rez token)))))
	  rez))
     ;; is it a tag whose scope ends at another tag
     ((setq <tag> (alist-get tag brace.old-tags-textargs-map))
      (let ((stop ()) (rez (list <tag>))
	    (leave-bracket (member <tag> '(<code> <pre> <c>))))
	(while (not stop)
	  (let ((token (brace.read-old-token leave-bracket)))
	    (cond 
	     ((= token "<EOF>") (setq stop t) token)
	     ((= token -1) 
	      (when (= (skip-char "") ".") (setq stop t))
	      (nconc1 rez -1))
	     (t (nconc1 rez token)))))
	rez))
     ;; none of the above, error.
     (t (error (concat "unknown dot tag: " tag))))))
      
;; parse word/carriage-return/tab/spaces/eof
(de brace.read-old-token(&optional leave-bracket)
  (let ((nextchar (skip-char "")))
    (selectq nextchar
      (" " (len (read-string " ")))
      ("\n" (read-string 1)
       (if (= "\n" (skip-char "")) (list '<p> -1) -1))
      ("\t" (read-string 1) -2)
      ("{" (read-string 1)
       (if (<> (skip-char "") "<")
	   "{" (printf "WARNING: brace tag in old-style doc\n")))
      ("\e" "<EOF>")
      ("<" (if leave-bracket 
	       (read-string "~ {\n\t\e")
	     (read-string 1) (brace.read-bracket)))
      (t (read-string "~ {<\n\t\e")))))

;; reads the body of a document in the "old" format (with dot tags).
;; result will be spliced into <doc>, which must be a non-empty list.
;; example:
;; (let ((zz (list '<div>))) (reading "/tmp/qqq" (brace.read-old-body zz)))
(de brace.read-old-body (doc)
  (let ((done ())
	(stop ()))
    ;; this assumes we are at the beginning of a line in the file
    (while (not done)
      (let ((c (skip-char "")))
	(cond 
	 ((= "\e" c) (setq done t))
	 ((= "\n" c) (read-string 1) 
	  (nconc1 doc (if (<> "\n" (skip-char "")) -1
			(read-string 1) (list '<p> -1))))
	 ((= "." c) (nconc1 doc (brace.read-old-tag)))
	 (t 				; read tokens until end of line
	  (let ((stop ()))
	    (while (not stop)
	      (let ((token (brace.read-old-token)))
		(cond 
		 ((= token "<EOF>") (setq stop t))
		 ((= token -1) (setq stop t) (setq doc (nconc1 doc -1)))
		 (t (nconc1 doc token)))))))))))
    doc)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(dmc |{| 
;     (on-error (error 'brace.read "Illegal brace syntax") 
;       (brace.read brace.tags)))

(dmc |{| (brace.read brace.tags))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; splice expressions that begin with one
;; of the tags in <tags> out of <z>,
;; and splice them into <r> 
;; (which must be a non-nil list).
(de brace.extract-metadata (z r tags)
  (while (cadr z)
    (let ((x (cadr z)))
      (cond
       ((and (consp x) (member (car x) tags))
	(nconc1 r (cons (car x) (list-get-strings (cdr x))))
	(rplacd z (cddr z)))
       ((consp x)
	(brace.extract-metadata x r tags)
	(setq z (cdr z)))
       (t (setq z (cdr z)))))) ())

;; splice-in the <ul> tags around successive
;; instances of <li> tags (when needed).
(de brace.splice-ul (z)
  (while (cadr z)
    (let ((x (cadr z)))
      (when (consp x)
	  (when (= (car x) '<li>)
	    (let ((ul z))
	      (while (= (car (cadr ul)) '<li>) (setq ul (cdr ul)))
	      (let ((cdrul (cdr ul)))
		(rplacd ul ())
		(rplacd z (cons (cons '<ul> (cons -1 (cdr z))) cdrul)))))
	  (if (= (car x) '<ul>) x (brace.splice-ul x))))
    (setq z (cdr z))) ())

;; simple print out of a brace list in brace form.
(de brace.print (z)
  (let ((tag (pname (car z))))
    (if (not (member tag brace.tags))
	(progn
	  (printf "\\") 
	  (pretty z))
      (printf "{%s " tag)
      (each ((x (cdr z)))
	(cond
	 ((consp x) (brace.print x))
	 ((= -1 x) (printf "\n"))
	 ((= -2 x) (printf "       "))
	 ((numberp x) (repeat x (printf " ")))
	 ((stringp x) (printf "%s" x))
	 ((symbolp x) (printf "\\$") (prin x))
	 (t (error "can't print that"))))
      (printf "}")))
  (printf "\n"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RENDERING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass brace-renderer object
  ;; text formatting tags
  <p>					; paragraph
  <pre>					; preformatted
  <code>				; displayed code
  <li>					; list item
  <br>					; line break
  <tt>					; typewriter font
  <b>					; bold
  <i>					; italic
  <u>					; underlined
  <c>					; highlighted code/arguments
  <font>				; font
  <center>				; center
  <img>					; image
  <ul>					; unstructured list
  <div>					; noop, just grouping tag

  ;; more text formatting
  <h1>					; big title
  <h2> 					; medium title
  <h3>					; small title

  <hlink>			       ; hyperlink (to URL or heading)
  <see>				       ; hyperlink (to URL or heading)

  ;; special commands
  <if-html>
  <if-latex>
  <if-ogre>
  <if-text>

  <meta>				; metatags

  <ex>					; we should never see that one
  )


(defmethod brace-renderer render (brace) (eval brace))

  
;; these are the tags that need to be excised from
;; the raw doclist because they contain metadata
;; rather than printable material.
(defvar brace.meta-tags
  '(<author> <symbol> <location> <keywords> <date> <desc> <title> <type>))

(defvar brace.global-tags '(<lit>))

;; collect all the legal tags
(defvar brace.tags 
  (let ((tags (mapcar pname 
		      (append (slots brace-renderer) 
			      brace.meta-tags brace.global-tags))))
    (append tags (mapcar upcase tags))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLAIN TEXT RENDERER

;; print string
(de brace-text.printf (s) 
  (printf (regex-subst "%" "%%%%" s))
  (setq returns 0)
  (incr cursor-pos (len s)))

;; print n spaces
(de brace-text.sp (n)
  (repeat n (printf " "))
  (setq returns 0)
  (incr cursor-pos n))

;; go to beginning of next line, only if current line non empty
(de brace-text.br ()
  (when (<> cursor-pos left-margin)
    (printf "\n")
    (incr returns)
    (repeat left-margin (printf " "))
    (setq cursor-pos left-margin)))

;; unconditional carriage return
(de brace-text.cr ()
  (printf "\n")
  (incr returns)
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; a single blank line (even for multiple calls)
(de brace-text.parskip ()
  (while (< returns 2)
    (printf "\n")
    (incr returns))
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; print word with possible word wrap
(de brace-text.print-word (s)
  (when (> (+ cursor-pos (len s)) right-margin) (brace-text.br))
  (printf (regex-subst "%" "%%%%" s)) (printf " ")
  (setq returns 0)
  (incr cursor-pos (1+ (len s))))

;; print paragraph (any brace list really)
(de brace-text.parprint (p)
  (each ((x p))
    (cond
     ((consp x) (eval x))
     ((stringp x) (brace-text.print-word x))
     (t ()))))

;; print pre-formatted text
(de brace-text.preprint (p)
  (let ((stop ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>)) (setq stop t))
	 ((stringp x) (brace-text.printf x))
	 ((= x -1) (brace-text.cr))
	 ((= x -2) (brace-text.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-text.sp x)))
	(setq p (cdr p))))
    (brace-text.parprint p)))

;; print title and header with available metadata
(de brace-text.meta (p)
  (let (((author symbol location keywords date desc title type) p))
    (printf "\n")
    (repeat 6 (printf "------------")) (printf "\n")
    (when title
      (printf "%s" title)
      (repeat (max 1 (- 40 (len title))) (printf " "))
      (if (not type)
	  (repeat 8 (printf " "))
	(repeat (max 1 (- 8 (len type))) (printf " "))
	(printf "[%s]" type))
      (when (and location (<> (right location 4) ".hlp"))
	(printf "(%s)" location))
      (printf "\n")
      (repeat 6 (printf ". . . . . . ")) (printf "\n"))
    (when author 
      (brace-text.parprint (cons "Author(s): " author))
      (brace-text.br))
    (when date (printf "%s\n" date))
    (when desc 
      (brace-text.parprint (cons "Description: " desc))
      (brace-text.br))
    (when keywords
      (brace-text.parprint (cons "Keywords: " keywords))
      (brace-text.br))
    (brace-text.cr)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass brace-text brace-renderer
  (returns 0)				; counts the number of successive CR
  (cursor-pos 0)
  (left-margin 0)
  (right-margin 72))

(defmethod brace-text brace-text ()
  (setq <p> (flambda p 
	      (when p (brace-text.parprint p))
	      (brace-text.parskip)))
  (setq <pre> (flambda p (brace-text.preprint p)))
  (setq <code> (flambda p (brace-text.preprint p)))
  (setq <li> (flambda p 
	       (brace-text.printf "* ")
	       (let ((left-margin (+ left-margin 2)))
		 (brace-text.parprint p))
	       (brace-text.br)))
  (setq <br> (flambda p 
	       (when p (brace-text.parprint p))
	       (brace-text.br)))
  (setq <tt> (flambda p (brace-text.parprint p)))
  (setq <b> (flambda p (brace-text.parprint p)))
  (setq <i> (flambda p (brace-text.parprint p)))
  (setq <u> (flambda p (brace-text.parprint p)))
  (setq <c> (flambda p (brace-text.parprint p)))
  (setq <font> (flambda p ()))
  (setq <center> (flambda p (brace-text.parprint p)))
  (setq <img> (flambda p 
		(brace-text.parprint (append '("[image:" 1) p '("]" 1)))))
  (setq <ul> (flambda p 
	       (brace-text.br)
	       (brace-text.parprint p)
	       (brace-text.br)))
  (setq <div> (flambda p (brace-text.parprint p)))
  (setq <h1> (flambda p 
	       (brace-text.parskip)
	       (brace-text.printf "### ")
	       (brace-text.parprint p)
	       (brace-text.parskip)))
  (setq <h2> (flambda p 
	       (brace-text.parskip)
	       (brace-text.printf "## ")
	       (brace-text.parprint p)
	       (brace-text.parskip)))
  (setq <h3> (flambda p 
	       (brace-text.parskip)
	       (brace-text.printf "# ")
	       (brace-text.parprint p)
	       (brace-text.parskip)))
  (setq <hlink> (flambda p 
		  (brace-text.print-word "[HLINK:")
		  (brace-text.parprint p)
		  (brace-text.print-word "]")))
  (setq <see> (flambda p 
		(brace-text.br)
		(brace-text.printf "* ")
		(let ((left-margin (+ left-margin 2)))
		  (brace-text.print-word "See:")
		  (brace-text.parprint p))
		(brace-text.br)))

  (setq <if-html> (flambda p ()))
  (setq <if-latex> (flambda p ()))
  (setq <if-ogre> (flambda p ()))
  (setq <if-text> (flambda p (brace-text.parprint p)))

  (setq <meta> (flambda p (brace-text.meta p)))
  )

(defmethod brace-text render (doc lmargin rmargin)
  (setq cursor-pos 0)
  (setq returns 0)
  (setq left-margin lmargin)
  (setq right-margin rmargin)
  (==> this (brace-renderer . render) doc))

(defvar *brace-text* (new brace-text))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OGRE RENDERER: returns an executable list of graphic commands

;; print string
(de brace-ogre.printf (s) 
  (setq s (regex-subst "%" "%%%%" s))
  (nconc1 gcode `(gprintf (+ x ,px) (+ y ,py) ,s))
  (incr px (caddr (rect-text 0 0 s)))
  (setq returns 0))


;; print n spaces
(de brace-ogre.sp (&optional (n 1))
  (incr px (* n space-width))
  (setq returns 0))

;; go to beginning of next line, only if current line non empty
(de brace-ogre.br ()
  (when (= returns 0)
    (setq px left-margin)
    (incr py line-height)
    (incr returns)))

;; unconditional carriage return
(de brace-ogre.cr ()
  (setq px left-margin)
  (incr py line-height)
  (incr returns))

;; a single blank line (even for multiple calls)
(de brace-ogre.parskip ()
  (brace-ogre.br)
  (brace-ogre.cr))

;; print word with possible word wrap
;; all the complixated regex stuff is to
;; handle the bracketted words. This should
;; really be handled by the parser.
(de brace-ogre.print-word (s)
  (setq s (regex-subst "%" "%%%%" s))
  (let ((bracketp ())
	(w (caddr (rect-text 0 0 s)))
	(s0 ()) (s1 ()) (s2 ()))
    (when (and (index "<" s)
	       (regex-match "[^<]*<.+>[^>]*" s))
      (let* ((regx"([^<]*)<(.+)>([^>]*)"))
	(setq s0 (regex-subst regx "%0" s))
	(setq s1 (regex-subst regx "%1" s))
	(setq s2 (regex-subst regx "%2" s))
	(setq s s1)
	(setq bracketp t)))
    (when (> (+ w px) right-margin)
      (setq px left-margin)
      (incr py line-height)
      (incr returns))
    (when bracketp 
      (when (and s0 (<> "" s0))
	(nconc1 gcode `(gprintf (+ x ,px) (+ y ,py) ,s0))
	(incr px (caddr (rect-text 0 0 s0))))
      (brace-ogre.push-font "Courier" t () ())
      (brace-ogre.push-color bracket-color))
    (nconc1 gcode `(gprintf (+ x ,px) (+ y ,py) ,s))
    (incr px (caddr (rect-text 0 0 s)))
    (when bracketp 
      (when (and s2 (<> "" s2))
	(nconc1 gcode `(gprintf (+ x ,px) (+ y ,py) ,s2))
	(incr px (caddr (rect-text 0 0 s2))))
      (brace-ogre.pop-font)
      (brace-ogre.pop-color))
    (incr px space-width)
    (setq returns 0)))

(de brace-ogre.print-word (s)
  (setq s (regex-subst "%" "%%%%" s))
  (let ((w (caddr (rect-text 0 0 s))))
    (when (> (+ w px) right-margin)
      (setq px left-margin)
      (incr py line-height)
      (incr returns))
    (nconc1 gcode `(gprintf (+ x ,px) (+ y ,py) ,s))
    (incr px (+ space-width w))
    (setq returns 0)))

;; print paragraph (any brace list really)
(de brace-ogre.parprint-broken (p)
  (each ((x p))
    (let ((z (eval x)))
      (cond
       ((stringp z) (brace-ogre.print-word z))
       ((and (numberp z) (> 0 z)) (incr px space-width))))))

;; print paragraph (any brace list really)
(de brace-ogre.parprint (p)
  (each ((x p))
    (let ((z (eval x)))
      (cond
       ((stringp z) (brace-ogre.print-word z))))))



;; build the name of a font from the 
;; family name, a bold flag, an italic flag and a size integer.
(de make-font-name (n b i s)
  (sprintf "%s-%s%d"
	   n 
	   (cond 
	    ((and (<> 0 b) (<> 0 i)) "BoldItalic-")
	    ((<> 0 b) "Bold-")
	    ((<> 0 i) "Italic-")
	    (t ""))
	   s))

(de brace-ogre.push-bold () (brace-ogre.push-font () t () ()))
(de brace-ogre.pop-bold () (brace-ogre.pop-font))

(de brace-ogre.push-italic () (brace-ogre.push-font () () t ()))
(de brace-ogre.pop-italic () (brace-ogre.pop-font))

(de brace-ogre.push-size (s) (brace-ogre.push-font () () () s))
(de brace-ogre.pop-size () (brace-ogre.pop-font))

(de brace-ogre.push-font (&optional name boldp italicp size)
  (if font-stack
      (let (((n b i s) (car font-stack)))
	(let* ((n2 (if name name n))
	       (b2 (if boldp boldp b))
	       (i2 (if italicp italicp i))
	       (s2 (if size size s))
	       (f (make-font-name n2 b2 i2 s2)))
	  (setq font-stack (cons (list n2 b2 i2 s2) font-stack))
	  (font f)
	  (setq line-height (* 1.25 (last (rect-text 0 0 "pd0"))))
	  (setq space-width 
		(* (if (= n2 "Times") 1.25 1)
		   (- (caddr (rect-text 0 0 "0 0"))
		      (caddr (rect-text 0 0 "00")))))
	  (nconc1 gcode `(font ,f))))
    (when (not (and name boldp italicp size))
      (error "font stack is empty, cannot modify font"))
    (let* ((f (make-font-name name boldp italicp size)))
      (setq font-stack (cons (list name boldp italicp size) font-stack))
      (font f)
      (setq line-height (* 1.25 (last (rect-text 0 0 "pd0"))))
      (setq space-width 
	    (* (if (= name "Times") 1.25 1)
	       (- (caddr (rect-text 0 0 "0 0"))
		  (caddr (rect-text 0 0 "00")))))
      (nconc1 gcode `(font ,f)))))

(de brace-ogre.pop-font ()
  (setq font-stack (cdr font-stack))
  (let* ((f (apply make-font-name (car font-stack)))
	 (name (caar font-stack)))
    (font f)
    (setq line-height (* 1.25 (last (rect-text 0 0 "pd0"))))
    (setq space-width 
	  (* (if (= name "Times") 1.25 1)
	     (- (caddr (rect-text 0 0 "0 0"))
		(caddr (rect-text 0 0 "00")))))
    (nconc1 gcode `(font ,f))))

(de brace-ogre.push-color (c)
  (setq color-stack (cons c color-stack))
  (nconc1 gcode (cons 'color-rgb c)))

(de brace-ogre.pop-color ()
  (setq color-stack (cdr color-stack))
  (nconc1 gcode (cons 'color-rgb (car color-stack))))

(de brace-ogre.image (p) 
  (let ((img (image-read-rgba (eval (car p)))))
    (brace-ogre.cr)
    (nconc1 gcode (cons 'rgb-draw-matrix px py img))
    (incr py (idx-dim img 0))
    (brace-ogre.cr)))

;; print pre-formatted text
(de brace-ogre.preprint (p)
  (let ((stop ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>)) (setq stop t))
	 ((stringp x) (brace-ogre.printf x))
	 ((= x -1) (brace-ogre.cr))
	 ((= x -2) (brace-ogre.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-ogre.sp x)))
	(setq p (cdr p))))
    (brace-ogre.parprint p)))

;; print pre-formatted text
(de brace-ogre.codeprint (p)
  (let ((stop ()) (comment ()) (c-code ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>))
	  (when comment (setq comment ()) (brace-ogre.pop-color))
	  (when c-code (setq c-code ()) (brace-ogre.pop-color))
	  (setq stop t))
	 ((stringp x) 
	  (if (and (member x brace.lush-keywords)
		   (not comment)
		   (not c-code))
	      (progn
		(brace-ogre.push-font () t () ())
		(brace-ogre.printf x)
		(brace-ogre.pop-font))
	    (when (and (not comment)
		       (not c-code)
		       (or (regex-match "#\\?" x)
			   (regex-match "[;]+" x)))
	      (setq comment t) (brace-ogre.push-color '(0.8 0 0)))
	    (when (and (not comment)
		       (not c-code)
		       (regex-match "#{" x))
	      (setq c-code t) (brace-ogre.push-color '(0 0.7 0)))
	    (if (and c-code (not comment) 
		     (or (regex-seek "#}" x)
			 (and (= x "#") (regex-seek "^}" (cadr p)))))
		(progn
		  (setq c-code ()) 
		  (brace-ogre.printf x) 
		  (brace-ogre.pop-color))
	      (brace-ogre.printf x))))
	 ((= x -1) 
	  (when comment (setq comment ()) (brace-ogre.pop-color))
	  (brace-ogre.cr))
	 ((= x -2) (brace-ogre.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-ogre.sp x)))
	(setq p (cdr p))))
    (brace-ogre.parprint p)))

;; print title and header with available metadata
(de brace-ogre.meta (p)
  (let (((author symbol location keywords date desc title type) p))
    (when title
      (brace-ogre.push-font "Helvetica" 0 0 14)
      (brace-ogre.push-color title-color)
      (brace-ogre.cr)
      (brace-ogre.printf title)
      (brace-ogre.pop-color)
      (brace-ogre.pop-font)
      (brace-ogre.cr)
      (brace-ogre.cr))

    (brace-ogre.push-color meta-color)    
    (when type 
      (brace-ogre.printf (sprintf "[%s]" type))
      (brace-ogre.sp))
    (when (and location (<> (right location 4) ".hlp"))
      (brace-ogre.printf (sprintf "(%s)" location))
      (brace-ogre.cr))
    (when author 
      (brace-ogre.parprint (cons "Author(s): " author))
      (brace-ogre.br))
    (when date 
      (brace-ogre.printf (sprintf "%s\n" date))
      (brace-ogre.br))
    (when desc 
      (brace-ogre.parprint (cons "Description: " desc))
      (brace-ogre.br))
    (when keywords
      (brace-ogre.parprint (cons "Keywords: " keywords))
      (brace-ogre.br))
    (brace-ogre.cr)
    (brace-ogre.pop-color)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass brace-ogre brace-renderer
  (px 0) (py 0)
  (gcode ())
  (space-width 8)
  (font-stack ())
  (color-stack ())
  (returns 0)
  (left-margin 0)
  (right-margin 400)
  (line-height 20)
  (text-color '(0 0 0))
  (bracket-color '(0.7 0 0.9))
  (code-color '(0 0 0.8))
  (title-color '(1 0 0))
  (meta-color '(0.8 0 0.8))
  )


(defmethod brace-ogre brace-ogre ()
  (setq <p> (flambda p 
	      (when p (brace-ogre.parprint p))
	      (brace-ogre.parskip) ()))
  (setq <pre> (flambda p (brace-ogre.preprint p)()))
  (setq <code> (flambda p 
		 (brace-ogre.push-color code-color)
		 (brace-ogre.push-font "Courier" 0 0 12)
		 (brace-ogre.codeprint p)
		 (brace-ogre.pop-font)
		 (brace-ogre.pop-color)()))
  (setq <li> (flambda p 
	       (brace-ogre.printf "*")
	       (brace-ogre.sp)
	       (let ((left-margin (+ left-margin (* 2 space-width))))
		 (brace-ogre.parprint p))
	       (brace-ogre.br) ()))
  (setq <br> (flambda p 
	       (when p (brace-ogre.parprint p))
	       (brace-ogre.br) ()))
  (setq <tt> (flambda p 
	       (brace-ogre.push-font "Courier" () () ())
	       (brace-ogre.parprint p)
	       (brace-ogre.pop-font) ()))
  (setq <b> (flambda p 
	      (brace-ogre.push-font () t () ())
	      (brace-ogre.parprint p)
	      (brace-ogre.pop-font) ()))
  (setq <i> (flambda p 
	      (brace-ogre.push-font () () t ())
	      (brace-ogre.parprint p)
	      (brace-ogre.pop-font) ()))
  (setq <u> (flambda p (brace-ogre.parprint p) ()))
  (setq <c> (flambda p 
	      (brace-ogre.push-color bracket-color)
	      (brace-ogre.push-font "Courier" 1 0 12)
	      (brace-ogre.parprint p)
	      (brace-ogre.pop-font)
	      (brace-ogre.pop-color) ()))
  (setq <font> (flambda p ()()))
  (setq <center> (flambda p (brace-ogre.parprint p) ()))
  (setq <img> (flambda p (brace-ogre.image p)()))
  (setq <ul> (flambda p 
	       (brace-ogre.br)
	       (brace-ogre.parprint p)
	       (brace-ogre.br)()))
  (setq <div> (flambda p (brace-ogre.parprint p) ()))
  (setq <h1> (flambda p 
	       (brace-ogre.parskip)
	       (brace-ogre.push-color '(0.9 0.1 0.5))
	       (brace-ogre.push-font "Helvetica" 1 0 18)
	       (brace-ogre.parprint p)
	       (brace-ogre.pop-font)
	       (brace-ogre.parskip)
	       (brace-ogre.pop-color) ()))
  (setq <h2> (flambda p 
	       (brace-ogre.parskip)
	       (brace-ogre.push-color '(0.9 0.1 0.5))
	       (brace-ogre.push-font "Helvetica" 1 0 14)
	       (brace-ogre.parprint p)
	       (brace-ogre.pop-font)
	       (brace-ogre.parskip)
	       (brace-ogre.pop-color) ()))
  (setq <h3> (flambda p 
	       (brace-ogre.parskip)
	       (brace-ogre.push-color '(0.9 0.1 0.5))
	       (brace-ogre.push-font "Helvetica" 1 0 12)
	       (brace-ogre.parprint p)
	       (brace-ogre.pop-font)
	       (brace-ogre.parskip)
	       (brace-ogre.pop-color) ()))
  (setq <hlink> (flambda p 
		  (brace-ogre.print-word "[HLINK:")
		  (brace-ogre.parprint p)
		  (brace-ogre.print-word "]") ()))
  (setq <see> (flambda p 
		(brace-ogre.br)
		(brace-ogre.printf "*")
		(brace-ogre.sp)
		(let ((left-margin (+ left-margin (* 2 space-width))))
		  (brace-ogre.print-word "See:")
		  (brace-ogre.parprint p))
		(brace-ogre.br) ()))

  (setq <if-html> (flambda p ()))
  (setq <if-latex> (flambda p ()))
  (setq <if-text> (flambda p ()))
  (setq <if-ogre> (flambda p (brace-ogre.parprint p) ()))

  (setq <meta> (flambda p (brace-ogre.meta p) ()))
  )

(defmethod brace-ogre render (doc w)
  (setq gcode (list 'progn))
  (setq right-margin w)
  (setq left-margin 0)
  (setq color-stack ())
  (setq font-stack ())
  (setq px 0) (setq py 0)
  (gsave
   (brace-ogre.push-color text-color)
   (brace-ogre.push-font "Times" 0 0 14)
   (==> this (brace-renderer . render) doc)
   (list (list w (+ py line-height)) gcode)))

(defvar *brace-ogre* (new brace-ogre))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTML RENDERER

;; print string
(de brace-html.printf (s) 
  (printf (regex-subst "%" "%%%%" s))
  (setq returns 0)
  (incr cursor-pos (len s)))

;; print n spaces
(de brace-html.sp (n)
  (repeat n (printf " "))
  (setq returns 0)
  (incr cursor-pos n))

;; go to beginning of next line, only if current line non empty
(de brace-html.br ()
  (when (<> cursor-pos left-margin)
    (printf "<br>\n")
    (incr returns)
    (repeat left-margin (printf " "))
    (setq cursor-pos left-margin)))

;; unconditional carriage return
(de brace-html.cr ()
  (printf "<br>\n")
  (incr returns)
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; a single blank line (even for multiple calls)
(de brace-html.parskip ()
  (while (< returns 1)
    (printf "\n<p>\n")
    (incr returns))
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; print word with possible word wrap
(de brace-html.print-word (s)
  (when (> (+ cursor-pos (len s)) right-margin) 
    (printf "\n") (setq cursor-pos 0))
  (setq s (regex-subst "%" "%%%%" s))
  (setq s (regex-subst "<([^ >]+)>" "@@@%0@@@" s))
  (setq s (regex-subst "<" "&lt;" s))
  (setq s (regex-subst ">" "&gt;" s))
  (setq s (regex-subst "@@@([^@]+)@@@" "<i>%0</i>" s))
  (printf s) (printf " ")
  (setq returns 0)
  (incr cursor-pos (1+ (len s))))

;; print paragraph (any brace list really)
(de brace-html.parprint (p)
  (each ((x p))
    (cond
     ((consp x) (eval x))
     ((stringp x) (brace-html.print-word x))
     (t ()))))

;; print pre-formatted text
(de brace-html.preprint (p)
  (printf "\n<PRE>")
  (let ((stop ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>)) (setq stop t))
	 ((stringp x) 
	  (setq x (regex-subst "<" "&lt;" x))
	  (setq x (regex-subst ">" "&gt;" x))
	  (brace-html.printf x))
	 ((= x -1) (printf "\n"))
	 ((= x -2) (brace-html.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-html.sp x)))
	(setq p (cdr p))))
    (printf "</PRE>\n")
    (setq cursor-pos left-margin)
    (brace-html.parprint p)))

(de cleanup-brackets-for-html (s)
  (setq s (regex-subst "<([^ >]+)>" "@@@%0@@@" s))
  (setq s (regex-subst "<" "&lt;" s))
  (setq s (regex-subst ">" "&gt;" s))
  (setq s (regex-subst "@@@([^@]+)@@@" "<i>%0</i>" s))
  s)
    
;; print title and header with available metadata
(de brace-html.meta (p)
  (let (((author symbol location keywords date desc title type) p))
    (when title
      (printf "\n")
      (printf "<hr><br>\n")
      (printf "<table width=90%% border=0 cellspacing=0 cellpadding=1>\n")
      (printf "<tr><td><font size=+2 color=#770077>")
      (brace-html.printf (cleanup-brackets-for-html title))
      (printf "</font><br></td>\n")
      (printf "<td>")
      (if type (printf "[%s] " type))
      (when (and location (<> (right location 4) ".hlp"))
	(printf "(%s)" location))
      (printf "</td></tr>\n")
      (printf "</table><br>\n"))
    (when author 
      (brace-html.parprint (cons "Author(s): " author))
      (brace-html.br))
    (when date (printf "%s\n" date))
    (when desc 
      (brace-html.parprint (cons "Description: " desc))
      (brace-html.br))
    (when keywords
      (brace-html.parprint (cons "Keywords: " keywords))
      (brace-html.br))
    (brace-html.cr)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass brace-html brace-renderer
  (returns 0)				; counts the number of successive CR
  (cursor-pos 0)
  (left-margin 0)
  (right-margin 72))

(defmethod brace-html brace-html ()
  (setq <p> (flambda p 
	      (when p (brace-html.parprint p))
	      (brace-html.parskip)))
  (setq <pre> (flambda p (brace-html.preprint p)))
  (setq <code> (flambda p (brace-html.preprint p)))
  (setq <li> (flambda p 
	       (brace-html.printf "<li> ")
	       (let ((left-margin (+ left-margin 2)))
		 (brace-html.parprint p))
	       (brace-html.br)))
  (setq <br> (flambda p 
	       (when p (brace-html.parprint p))
	       (brace-html.br)))
  (setq <tt> (flambda p 
	       (brace-html.printf "<tt>")
	       (brace-html.parprint p)
	       (brace-html.printf "</tt>")))
  (setq <b> (flambda p 
	      (brace-html.printf "<b>")
	      (brace-html.parprint p)
	      (brace-html.printf "</b>")))
  (setq <i> (flambda p 
	      (brace-html.printf "<i>")
	      (brace-html.parprint p)
	      (brace-html.printf "</i>")))
  (setq <u> (flambda p 
	      (brace-html.printf "<u>")
	      (brace-html.parprint p)
	      (brace-html.printf "</u>")))
  (setq <c> (flambda p 
	      (brace-html.printf "<font color=#5500ff><b>")
	      (brace-html.parprint p)
	      (brace-html.printf "</b></font>")))
  (setq <font> (flambda p (brace-html.parprint p)))
  (setq <center> (flambda p 
		   (brace-html.printf "\n<center>")
		   (brace-html.parprint p)
		   (brace-html.printf "</center>")))
  (setq <img> (flambda p 
		(brace-html.printf "<img src=\"")
		(brace-html.parprint p)
		(brace-html.printf "\">")))
  (setq <ul> (flambda p 
	      (brace-html.printf "\n<ul>")
	      (brace-html.parprint p)
	      (brace-html.printf "</ul>")))
  (setq <div> (flambda p (brace-html.parprint p)))
  (setq <h1> (flambda p 
	      (brace-html.printf "\n<h1>")
	      (brace-html.parprint p)
	      (brace-html.printf "</h1>")))
  (setq <h2> (flambda p 
	      (brace-html.printf "\n<h2>")
	      (brace-html.parprint p)
	      (brace-html.printf "</h2>")))
  (setq <h3> (flambda p 
	      (brace-html.printf "\n<h3>")
	      (brace-html.parprint p)
	      (brace-html.printf "</h3>")))
  (setq <hlink> (flambda p 
		  (brace-html.printf "<a href=\"")
		  (brace-html.parprint (list (car p)))
		  (brace-html.printf "\">")
		  (brace-html.parprint (if (cdr p) (cdr p) p))
		  (brace-html.printf "</a>")))
  (setq <see> (flambda p 
		(brace-html.br)
		(brace-html.printf "See: <a href=\"")
		(brace-html.parprint (list (car p)))
		(brace-html.printf "\">")
		(brace-html.parprint (if (cdr p) (cdr p) p))
		(brace-html.printf "</a>")
		(brace-html.br)))		

  (setq <if-html> (flambda p (brace-html.parprint p)))
  (setq <if-latex> (flambda p ()))
  (setq <if-ogre> (flambda p ()))
  (setq <if-text> (flambda p ()))

  (setq <meta> (flambda p (brace-html.meta p)))
  )

(defmethod brace-html render (doc lmargin rmargin)
  (setq cursor-pos 0)
  (setq returns 0)
  (setq left-margin lmargin)
  (setq right-margin rmargin)
  (==> this (brace-renderer . render) doc))

(defvar *brace-html* (new brace-html))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BRACE RENDERER

;; print string
(de brace-brace.printf (s) 
  (printf (regex-subst "%" "%%%%" s))
  (setq returns 0)
  (incr cursor-pos (len s)))

;; print n spaces
(de brace-brace.sp (n)
  (repeat n (printf " "))
  (setq returns 0)
  (incr cursor-pos n))

;; go to beginning of next line, only if current line non empty
(de brace-brace.br ()
  (when (<> cursor-pos left-margin)
    (printf "{<br>}\n")
    (incr returns)
    (repeat left-margin (printf " "))
    (setq cursor-pos left-margin)))

;; unconditional carriage return
(de brace-brace.cr ()
  (printf "\n")
  (incr returns)
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; a single blank line (even for multiple calls)
(de brace-brace.parskip ()
  (while (< returns 2)
    (printf "\n")
    (incr returns))
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; print word with possible word wrap
(de brace-brace.print-word (s)
  (when (> (+ cursor-pos (len s)) right-margin) (brace-brace.cr))
  (setq s (regex-subst "%" "%%%%" s))
  (printf s) (printf " ")
  (setq returns 0)
  (incr cursor-pos (1+ (len s))))

;; print paragraph (any brace list really)
(de brace-brace.parprint (p)
  (each ((x p))
    (cond
     ((consp x) (eval x))
     ((stringp x) (brace-brace.print-word x))
     (t ()))))

;; print pre-formatted text
(de brace-brace.preprint (p)
  (brace-brace.cr)
  (printf "{<PRE> ")
  (let ((stop ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>)) (setq stop t))
	 ((stringp x) 
	  (brace-brace.printf x))
	 ((= x -1) (printf "\n"))
	 ((= x -2) (brace-brace.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-brace.sp x)))
	(setq p (cdr p))))
    (brace-brace.print-word "</pre>")
    (setq cursor-pos left-margin)
    (brace-brace.parprint p)
    (brace-brace.printf "}"))))

;; print title and header with available metadata
(de brace-brace.meta (p)
  (let (((author symbol location keywords date desc title type) p))
    (brace-brace.printf (sprintf "\n#? %s\n" title))
    (when (or type location author desc keywords)
      (printf "\n{<meta> ")
      ;;(brace-brace.printf "{<title> ")
      ;; (brace-brace.print-word title)
      ;; (printf "}\n")
      (if type (brace-brace.parprint (list "{<type> " type "}\n")))
      (when (and location (<> (right location 4) ".hlp"))
	(brace-brace.print-word "{<location> ")
	(brace-brace.print-word location )
	(brace-brace.print-word "}\n"))
    (when author 
      (brace-brace.print-word "{<author> ")
      (brace-brace.parprint author)
      (brace-brace.print-word "}\n"))
    ;; (when date (printf "%s\n" date))
    (when desc 
      (brace-brace.print-word "{<desc> ")
      (brace-brace.parprint desc)
      (brace-brace.print-word "}\n"))
    (when keywords
      (brace-brace.print-word "{<keywords> ")
      (brace-brace.parprint keywords)
      (brace-brace.print-word "}\n"))
    (brace-brace.print-word "}\n"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass brace-brace brace-renderer
  (returns 0)				; counts the number of successive CR
  (cursor-pos 0)
  (left-margin 0)
  (right-margin 72))

(defmethod brace-brace brace-brace ()
  (setq <p> (flambda p 
	      (when p (brace-brace.parprint p))
	      (brace-brace.parskip)))
  (setq <pre> (flambda p (brace-brace.preprint p)))
  (setq <code> (flambda p (brace-brace.preprint p)))
  (setq <li> (flambda p 
	       (brace-brace.printf "{<li> ")
	       (let ((left-margin (+ left-margin 2)))
		 (brace-brace.parprint p))
	       (brace-brace.printf "}")
	       (brace-brace.cr)))
  (setq <br> (flambda p 
	       (when p (brace-brace.parprint p))
	       (brace-brace.br)))
  (setq <tt> (flambda p 
	       (brace-brace.printf "{<tt> ")
	       (brace-brace.parprint p)
	       (brace-brace.printf "}")))
  (setq <b> (flambda p 
	      (brace-brace.printf "{<b> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")))
  (setq <i> (flambda p 
	      (brace-brace.printf "{<i> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")))
  (setq <u> (flambda p 
	      (brace-brace.printf "{<u> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")))
  (setq <font> (flambda p 
		 (brace-brace.printf "{<font> ")		 
		 (brace-brace.parprint p)
		 (brace-brace.printf "}")))
  (setq <center> (flambda p 
		   (brace-brace.printf "{<center>")
		   (brace-brace.parprint p)
		   (brace-brace.printf "}")))
  (setq <img> (flambda p 
		(brace-brace.printf "{<img> ")
		(brace-brace.parprint p)
		(brace-brace.printf "}")))
  (setq <ul> (flambda p 
	      (brace-brace.cr)
	      (brace-brace.printf "{<ul> ")
	      (let ((left-margin 2))
		(brace-brace.cr)
		(brace-brace.parprint p)
		(brace-brace.printf "}"))
	      (brace-brace.cr)))	      
  (setq <div> (flambda p (brace-brace.parprint p)))
  (setq <h1> (flambda p 
	      (brace-brace.cr)
	      (brace-brace.printf "{<h1> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")
	      (brace-brace.cr)))
  (setq <h2> (flambda p 
	      (brace-brace.cr)
	      (brace-brace.printf "{<h2> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")
	      (brace-brace.cr)))
  (setq <h3> (flambda p 
	      (brace-brace.cr)
	      (brace-brace.printf "{<h3> ")
	      (brace-brace.parprint p)
	      (brace-brace.printf "}")
	      (brace-brace.cr)))
  (setq <hlink> (flambda p 
		  (brace-brace.printf "{<hlink> ")
		  (brace-brace.parprint p)
		  (brace-brace.printf "}")))
  (setq <see> (flambda p 
		(brace-brace.cr)
		(brace-brace.printf "{<see> ")
		(brace-brace.parprint p)
		(brace-brace.printf "}")
		(brace-brace.cr)))

  ;; (setq <if-brace> (flambda p (brace-brace.parprint p)))
  (setq <if-latex> (flambda p ()))
  (setq <if-ogre> (flambda p ()))
  (setq <if-text> (flambda p ()))

  (setq <meta> (flambda p (brace-brace.meta p)))
  )

(defmethod brace-brace render (doc lmargin rmargin)
  (setq cursor-pos 0)
  (setq returns 0)
  (setq left-margin lmargin)
  (setq right-margin rmargin)
  (==> this (brace-renderer . render) doc))

(defvar *brace-brace* (new brace-brace))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LATEX RENDERER

;; print string
(de brace-latex.printf (s) 
  (printf (regex-subst "%" "%%%%" s))
  (setq returns 0)
  (incr cursor-pos (len s)))

;; print string with appropriate escapes
(de brace-latex.smart-printf (s) 
  (setq s (regex-subst "\\\\" "@BCKS@" s)) 
  (setq s (regex-subst "([_&#$])" "\\%0" s))
  (setq s (regex-subst "@BCKS@" "$\\backslash$" s))
  (setq s (regex-subst "\\^" "\\^{ }" s))
  (setq s (regex-subst "%" "\\%%%%" s))
  (setq s (regex-subst "%" "%%" s))
  (setq s (regex-subst "<([^ >]+)>" "@@@%0@@@" s))
  (setq s (regex-subst "@@@([^@]+)@@@" "{\\tt %0}" s))
  (setq s (regex-subst ">" "$>$" s))
  (setq s (regex-subst "<" "$<$" s))
  (printf s)
  (setq returns 0)
  (incr cursor-pos (len s)))

;; print n spaces
(de brace-latex.sp (n)
  (repeat n (printf " "))
  (setq returns 0)
  (incr cursor-pos n))

;; go to beginning of next line, only if current line non empty
(de brace-latex.br ()
  (when (<> cursor-pos left-margin)
    (printf "\\\\\n")
    (incr returns)
    (repeat left-margin (printf " "))
    (setq cursor-pos left-margin)))

;; unconditional carriage return
(de brace-latex.cr ()
  (printf "\n")
  (incr returns)
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; a single blank line (even for multiple calls)
(de brace-latex.parskip ()
  (while (< returns 1)
    (printf "\n\n")
    (incr returns))
  (repeat left-margin (printf " "))
  (setq cursor-pos left-margin))

;; print word with possible word wrap
(de brace-latex.print-word (s)
  (when (> (+ cursor-pos (len s)) right-margin) 
    (printf "\n") (setq cursor-pos 0))
  (brace-latex.smart-printf s)
  (printf " ") (incr cursor-pos 1))

;; print paragraph (any brace list really)
(de brace-latex.parprint (p)
  (each ((x p))
    (cond
     ((consp x) (eval x))
     ((stringp x) (brace-latex.print-word x))
     (t ()))))

;; print pre-formatted text
(de brace-latex.preprint (p)
  (printf "\n\\begin{verbatim}\n")
  (let ((stop ()))
    (while (and p (not stop))
      (let ((x (car p)))
	(cond
	 ((member x '(</code> </pre> </CODE> </PRE>)) (setq stop t))
	 ((stringp x) 
	  (setq x (regex-subst "%" "\\%%%%" x))
	  (setq x (regex-subst "\\\\" "\\\\" x))
	  (setq x (regex-subst "$" "\\$" x))
	  (printf x))
	 ((= x -1) (printf "\n"))
	 ((= x -2) (brace-latex.sp 7))
	 ((and (numberp x) (>= x 1)) (brace-latex.sp x)))
	(setq p (cdr p))))
    (printf "\\end{verbatim}\n")
    (setq cursor-pos left-margin)
    (brace-latex.parprint p)))

;; print title and header with available metadata
(de brace-latex.meta (p)
  (let (((author symbol location keywords date desc title type) p))
    (when title
      (printf "\n")
      (selectq (length section-number)
	(1 (printf "\\chapter{\n"))
	(2 (printf "\\section{\n"))
	(3 (printf "\\subsection{\n"))
	(4 (printf "\\subsubsection{\n"))
	(t (printf "{\\bf\n")))
      (brace-latex.smart-printf title)
      (printf "}\n")
      (when type (brace-latex.smart-printf (concat "Type: " type)))
      (when (and location (<> (right location 4) ".hlp"))
	(brace-latex.smart-printf (concat "(" location ")")))
      (printf "\n"))
    (when author 
      (brace-latex.parprint (cons "Author(s): " author))
      (printf "\n"))
    (when date (brace-latex.smart-printf date) (printf "\n"))
    (when desc 
      (brace-latex.parprint (cons "Description: " desc))
      (printf "\n"))
    (when keywords
      (brace-latex.parprint (cons "Keywords: " keywords))
      (printf "\n"))
    (printf "\n")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass brace-latex brace-renderer
  (returns 0)				; counts the number of successive CR
  (cursor-pos 0)
  (left-margin 0)
  (right-margin 72))

(defmethod brace-latex brace-latex ()
  (setq <p> (flambda p 
	      (when p (brace-latex.parprint p))
	      (brace-latex.parskip)))
  (setq <pre> (flambda p (brace-latex.preprint p)))
  (setq <code> (flambda p (brace-latex.preprint p)))
  (setq <li> (flambda p 
	       (brace-latex.printf "\\item ")
	       (let ((left-margin (+ left-margin 2)))
		 (brace-latex.parprint p))
	       (brace-latex.printf "\n")))
  (setq <br> (flambda p 
	       (when p (brace-latex.parprint p))
	       (brace-latex.printf "\n")))
  (setq <tt> (flambda p 
	       (brace-latex.printf "{\\tt ")
	       (brace-latex.parprint p)
	       (brace-latex.printf "}")))
  (setq <b> (flambda p 
	      (brace-latex.printf "{\\bf ")
	      (brace-latex.parprint p)
	      (brace-latex.printf "}")))
  (setq <i> (flambda p 
	      (brace-latex.printf "{\\it ")
	      (brace-latex.parprint p)
	      (brace-latex.printf "}")))
  (setq <u> (flambda p 
	      (brace-latex.parprint p)))
  (setq <c> (flambda p 
	       (brace-latex.printf "{\\tt ")
	       (brace-latex.parprint p)
	       (brace-latex.printf "}")))
  (setq <font> (flambda p (brace-latex.parprint p)))
  (setq <center> (flambda p 
		   (brace-latex.printf "\\begin{center}\n")
		   (brace-latex.parprint p)
		   (brace-latex.printf "\\end{center}\n")))
  (setq <img> (flambda p 
		(brace-latex.printf "[image ")
		(brace-latex.parprint p)
		(brace-latex.printf "]")))
  (setq <ul> (flambda p 
	      (brace-latex.printf "\\begin{itemize}")
	      (brace-latex.parprint p)
	      (brace-latex.printf "\\end{itemize}")))
  (setq <div> (flambda p (brace-latex.parprint p)))
  (setq <h1> (flambda p 
	      (brace-latex.printf "\n\\section{")
	      (brace-latex.parprint p)
	      (brace-latex.printf "}\n")))
  (setq <h2> (flambda p 
	      (brace-latex.printf "\n\\subsection{")
	      (brace-latex.parprint p)
	      (brace-latex.printf "}\n")))
  (setq <h3> (flambda p 
	      (brace-latex.printf "\n\\subsubsection{")
	      (brace-latex.parprint p)
	      (brace-latex.printf "}\n")))
  (setq <hlink> (flambda p 
		  (brace-latex.printf "[")
		  (brace-latex.parprint p)
		  (brace-latex.printf "]")))
  (setq <see> (flambda p 
		(brace-latex.printf "\n\n")
		(brace-latex.printf "See: ")
		(brace-latex.parprint p)
		(brace-latex.printf "\n\n")))

  (setq <if-latex> (flambda p (brace-latex.parprint p)))
  (setq <if-html> (flambda p ()))
  (setq <if-ogre> (flambda p ()))
  (setq <if-text> (flambda p ()))

  (setq <meta> (flambda p (brace-latex.meta p)))
  )

(defmethod brace-latex render (doc section-number)
  (setq cursor-pos 0)
  (setq returns 0)
  (setq left-margin 0)
  (setq right-margin 72)
  (==> this (brace-renderer . render) doc))

(defvar *brace-latex* (new brace-latex))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(de render-brace-text (lm rm p) (==> *brace-text* render p lm rm))
(de render-brace-graphics (x y w p) 
  (let* ((z (==> *brace-ogre* render p w))
	 (h (cadr (car z))))
    (eval (cadr z))
    (list x y w h)))
(de render-brace-html (lm rm p)
  (==> *brace-html* render p lm rm))
(de render-brace-latex (sn p)
  (==> *brace-latex* render p sn))


