#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

;; TODO: respect line breaks in pre
;;       outputs the good HTML4.0 header, not the XHTML one
;;       include java-style
;;(kdb t)

(setq args (getopts  USAGE: kxhtml [xml_file]
Is a filter converting xml to html, actually the "voyager/xhtml" 
representation of HTML in XML, see http://www.w3.org/TR/WD-html-in-xml, 
providing three functionalities:
  - generating correct html from the equivalent xml
   <img src="foo"/>  ==>  <img src="foo">,  <td/>  ==>  <td></td>

  - understanding the html4.0 predefined entities (&eacute;, &egrave;,...)

  - defining and expansing macros defined in the xml source: 
    Macros definitions can have have the 2 equivalent general forms:
    <macro>tag-name replacement</macro>
    or:
    <macro name="tag-name">replacement</macro>
    
    And macros definition can be of many types:

    * SIMPLE:
    ---------
    <macro name="tag-name">replacement</macro>  
      replacement is the start-tag contents (element name and attributes)
      e.g.: <macro>element span class="element"</macro>
            will replace <element>chapitre:</element> by:
            <span class="element">chapitre:</span>
      you can override attributes:
            <macro>element span class="element" align="center"</macro>
            <element align="top" base="none">chapitre:</element>
            will give:
            <span class="element" align="top" base="none">chapitre:</span>
     If tag-name is empty, the tag is removed (but its contents remain)

    * INCLUDE:
    ----------
    <macro type="file">filename</macro>
      loads filename for macro definitions. It must be a valid xml file, so 
      the macro definitions must be wrapped inside an element (anyone except 
      macro, we suggest using <macros> for instance. 
      This is not actually an include, as the file contents are discarded, only
      its side effects (macro definitions) are used.
      The file is loaded literally, or in the include_path, if it was given 
      with the -I option

    * FORMAT:
    ---------
    <macro  name="tag-name" type="format">format-string</macro>
      will replace the element by the XML node in format-string, with %% 
      expansed to:
        %%   ==> %%
        %%0  ==> XML contents (children), pretty-printed into a string
        %%1  ==> attributes of node
        %%2  ==> contents of first child, leading & trailing space trimmed
        %%3  ==> contents of first child
        %%4  ==> name of node
        %%{foo} ==> value of attribute foo if present, else ""
        %%{foo=bar} ==> value of attribute foo, "bar" if not present
      e.g.: <macro type="format">I &lt;img src="%%2"/></macro>
      If format-string is empty, the tag and its contents are deleted

    * NO-INDENT:
    ------------
    <macro  name="tag-name" type="no-indent"/>
      Is not really a macro definition, but will control the pretty-printing of
      tag-name, preventing re-indentation of the tag-name contents.
      By default, a <macro type="no-indent">pre</macro> is issued

    * LANGUAGES:
    ------------
    If the processor embeds a scripting language, it can process the macro
    replacement by this language. If a language is not available, an error
    will be triggered.
    Possible languages are:
      
    KLONE
    <macro name="tag-name" type="klone">klone_expression</macro>
      will execute the klone expression on nodes with tags. node is available 
      in the global var "node", and its name, attributes and children can be 
      acessed by: (name node) to get it, (name node newname) to rename it, 
      etc... (children node [new_children]) (attributes node [new])
      the variables of the same name
      e.g.: <macro type="klone">I (nconc (attributes node) (list :src
                       (0 (children node))))
                     (children node ())
 		     (name node 'img)
            </macro>
            Will replace <I>image.gif</I>
            by: <img src="image.gif"/>
      To transform a node into string (chardata), transform it into a pair 
      (() chardata-string)

	("-p" () to-stdout "outputs results on stdout. Normally if input is a
file, another file with a .html extension is created")
        ("-htm" () win-ext "windows mode: files are created with extension .htm
instead of .html")
	("-nh" () noheaders 
	  "Do not add HTML headers (html/head/body) if not there")
	("-m" macro-tag-name macro-tag-name
	  "macro tag name, default is \"macro\""
	)
	("-I" dir include_dirs "directory to search for include files
If none given, takes current dir."
	  :multiple t)
	("-h" header-file header_files "include this xhtml (definitions) first
This header files are searched in the include dirs."
	  :multiple t)
	("-7bit" () quote8 "(default) Quote 8-bits chars: do not keep ,
translate  as &eacute;"
	)
	("-8bit" () dontquote8 "not keep , do not translate  as &eacute;
may be non portable"
	)
        ("-q2b" () quotation2brackets "converts  and  to < and >, avoids 
using &lt; and &gt; to escape <> (and  to &)"
	)
	("-r" () recursive "recurses in current dir (or argument), 
re-generating all .xhtml files found if the corresponding .html 
is obsolete")
	("-R" () force-rebuild "like -r, but forces regeration of all files")
	("-new" () create-new "just outputs a skeleton file of an empty
document, useful as a reminder")
	("-v" () verbose "verbose mode")
;; --- Hidden Options ---
    ("-debug" () enter-debugger-on-error "enter klone debugger on error"
    :hidden t)
    ("-stackdump" () stackdump-on-error "verbose stack dump on error"
    :hidden t)
    ))

(if enter-debugger-on-error (kdb t))
(if stackdump-on-error (stack-dump-on-error t))

;; list of elements marked "End tag: forbidden" in html 4.0 spec
(setq monotags 
  [ link meta br col base img param area basefont hr frame input isindex 
    ;; list of elements where browsers mishandle end tags
    p 
  ]
)
(setq no-indents
  [ pre ]
)
;; This is generated from the html 4.0 spec, cut and paste the table in 
;; sgml/entities.html: The list of characters, and process by this script:
;; #!/usr/local/bin/klone
;; (setq in (open "e1"))  ; file where you put the cutnpaste
;; (setq out (open "e2" :if-exists :supersede :direction :output)) ; result
;; (domatch (re in)
;;   "<!ENTITY +([^ ]*) +CDATA +\"&#([0-9]*);\" +--(.*) -->$"
;;   (PF out "  \"%0\" \"%1\"   ; %2\n" 
;;     (regsub re 1) (String (list (Int (regsub re 2)))) (regsub re 3))))

(setq html40entities (Hashtable '(
  "nbsp" ""   ;  no-break space
  "iexcl" ""   ;  inverted exclamation mark
  "cent" ""   ;  cent sign
  "pound" ""   ;  pound sterling sign
  "curren" ""   ;  general currency sign
  "yen" ""   ;  yen sign
  "brvbar" ""   ;  broken (vertical) bar
  "sect" ""   ;  section sign
  "uml" ""   ;  umlaut (dieresis)
  "copy" ""   ;  copyright sign
  "ordf" ""   ;  ordinal indicator, feminine
  "laquo" ""   ;  angle quotation mark, left
  "not" ""   ;  not sign
  "shy" ""   ;  soft hyphen
  "reg" ""   ;  registered sign
  "macr" ""   ;  macron
  "deg" ""   ;  degree sign
  "plusmn" ""   ;  plus-or-minus sign
  "sup2" ""   ;  superscript two
  "sup3" ""   ;  superscript three
  "acute" ""   ;  acute accent
  "micro" ""   ;  micro sign
  "para" ""   ;  pilcrow (paragraph sign)
  "middot" ""   ;  middle dot
  "cedil" ""   ;  cedilla
  "sup1" ""   ;  superscript one
  "ordm" ""   ;  ordinal indicator, masculine
  "raquo" ""   ;  angle quotation mark, right
  "frac14" ""   ;  fraction one-quarter
  "frac12" ""   ;  fraction one-half
  "frac34" ""   ;  fraction three-quarters
  "iquest" ""   ;  inverted question mark
  "Agrave" ""   ;  capital A, grave accent
  "Aacute" ""   ;  capital A, acute accent
  "Acirc" ""   ;  capital A, circumflex accent
  "Atilde" ""   ;  capital A, tilde
  "Auml" ""   ;  capital A, dieresis or umlaut mark
  "Aring" ""   ;  capital A, ring
  "AElig" ""   ;  capital AE diphthong (ligature)
  "Ccedil" ""   ;  capital C, cedilla
  "Egrave" ""   ;  capital E, grave accent
  "Eacute" ""   ;  capital E, acute accent
  "Ecirc" ""   ;  capital E, circumflex accent
  "Euml" ""   ;  capital E, dieresis or umlaut mark
  "Igrave" ""   ;  capital I, grave accent
  "Iacute" ""   ;  capital I, acute accent
  "Icirc" ""   ;  capital I, circumflex accent
  "Iuml" ""   ;  capital I, dieresis or umlaut mark
  "ETH" ""   ;  capital Eth, Icelandic
  "Ntilde" ""   ;  capital N, tilde
  "Ograve" ""   ;  capital O, grave accent
  "Oacute" ""   ;  capital O, acute accent
  "Ocirc" ""   ;  capital O, circumflex accent
  "Otilde" ""   ;  capital O, tilde
  "Ouml" ""   ;  capital O, dieresis or umlaut mark
  "times" ""   ;  multiply sign
  "Oslash" ""   ;  capital O, slash
  "Ugrave" ""   ;  capital U, grave accent
  "Uacute" ""   ;  capital U, acute accent
  "Ucirc" ""   ;  capital U, circumflex accent
  "Uuml" ""   ;  capital U, dieresis or umlaut mark
  "Yacute" ""   ;  capital Y, acute accent
  "THORN" ""   ;  capital THORN, Icelandic
  "szlig" ""   ;  small sharp s, German (sz ligature)
  "agrave" ""   ;  small a, grave accent
  "aacute" ""   ;  small a, acute accent
  "acirc" ""   ;  small a, circumflex accent
  "atilde" ""   ;  small a, tilde
  "auml" ""   ;  small a, dieresis or umlaut mark
  "aring" ""   ;  small a, ring
  "aelig" ""   ;  small ae diphthong (ligature)
  "ccedil" ""   ;  small c, cedilla
  "egrave" ""   ;  small e, grave accent
  "eacute" ""   ;  small e, acute accent
  "ecirc" ""   ;  small e, circumflex accent
  "euml" ""   ;  small e, dieresis or umlaut mark
  "igrave" ""   ;  small i, grave accent
  "iacute" ""   ;  small i, acute accent
  "icirc" ""   ;  small i, circumflex accent
  "iuml" ""   ;  small i, dieresis or umlaut mark
  "eth" ""   ;  small eth, Icelandic
  "ntilde" ""   ;  small n, tilde
  "ograve" ""   ;  small o, grave accent
  "oacute" ""   ;  small o, acute accent
  "ocirc" ""   ;  small o, circumflex accent
  "otilde" ""   ;  small o, tilde
  "ouml" ""   ;  small o, dieresis or umlaut mark
  "divide" ""   ;  divide sign
  "oslash" ""   ;  small o, slash
  "ugrave" ""   ;  small u, grave accent
  "uacute" ""   ;  small u, acute accent
  "ucirc" ""   ;  small u, circumflex accent
  "uuml" ""   ;  small u, dieresis or umlaut mark
  "yacute" ""   ;  small y, acute accent
  "thorn" ""   ;  small thorn, Icelandic
  "yuml" ""   ;  small y, dieresis or umlaut mark
)))

(if args 
  (setqn in (open (0 args)) filename (0 args)) 
  (setqn in *standard-input* filename ())
)
(if force-rebuild (setq recursive t))
(setq html-ext (if win-ext ".htm" ".html"))
(setq quote8 (if dontquote8 () t))

(if (and filename (not to-stdout))
  (with (re (re-nocase "^(.*)[.]([^.]+)$"))
    (if (regexec re filename)
      (setq outfilename (+ (regsub re 1) html-ext))
      (setq outfilename (+ filename html-ext))
    )
    (setq out (open outfilename :direction :output :if-exists :supersede))
  )
  (setq out *standard-output*)
)
(if macro-tag-name
  (setq macro-tag-name (intern macro-tag-name))
  (setq macro-tag-name 'macro)
)

(if create-new (progn
    (PF <?xml version="1.0"  encoding="ISO-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "DTD/xhtml1-strict.dtd">
<html><head>
</head>
<!-- KXHTML macros start -->
<!-- KXHTML macros end -->
<body>

</body></html>
      
    )
    (exit 0)
))

(when recursive
  (with (re (re-nocase "^(.*)[.]xhtml$")
      options (list)
      status 0
      cur-status 0
    )
    (if args (setq *current-directory* filename))
    ;; reproduces options in subcommands
    (lappend options (0 *arguments*))
    (if noheaders (lappend options "-nh"))
    (if (and macro-tag-name (/= 'macro macro-tag-name)) (progn
	(lappend options "-m")
	(lappend options (String macro-tag-name))
    ))
    (dolist (idir include_dirs)
      (lappend options "-I")
      (lappend options idir)
    )
    (dolist (idir header_files)
      (lappend options "-h")
      (lappend options idir)
    )
    (if dontquote8 (lappend options "-8bit"))
    ;;(if verbose (lappend options "-v"))

    (dofile (name stats dir ".")
      (if (and (regexec re name)
	  (if (or force-rebuild 
	      (> (get stats 'mtime 0)
		(get (file-stats (+ (regsub re 1) html-ext))
		  'mtime 0)
	    )) (progn
	      (verbose? "in %0, kxhtml %1" dir name)
	      ;; remove html file if error occured
	      (setq cur-status (abs (wait (system (+ options (list name))))))
	      (if (/= 0 cur-status)
		(wait (system (list "rm" "-f" (+ (regsub re 1) html-ext))))
	      )
	      (incf status cur-status)
	    )
	    (verbose? "%0 is up to date" (concat-paths dir name))
	  )
    )))
    (exit status)
))


(defun main ()
;;  (setq sxp:print-indent-string ())	;HTML is sensitive to indent (<pre>)

  ;; load headers
  (dolist (header header_files) (x2h:load header))
  (catch-error-with-message
    "kxhtml: Error in xml input, aborting.\n"
    (setq tree (sxp:parse in :filename filename :entities html40entities))
    (verbose "kxhtml: Input file parsed")
  )
  (if quote8 () (setq x2h:print-chardata sxp:print-chardata))

  (x2h:expanse-macros tree)		;expanse macros in place
  (sxp:clean-tree tree)			;regularize tree
  ;; one example of using sxp:eval
  (if (not noheaders) (setq tree (update-header tree))) ;add our signature
  (setq tree (sxp:eval tree [() mark-monotags])) ;find HTML-isms
  (x2h:print tree out)			;outputs the HTML
)
  
;;=============================================================================
;;                    Macro expansion
;;=============================================================================
;; we walk the tree, remembering and removing macro definitions, and
;; expansing the references to them

;; Internal representation: we add to or "Klone-DOM" nodes 1 field:
;; #3: t if this is a tag without end tag 

;; Implementation: via a p-list of macro defs, key being macro names (atoms)
;; and values being remplacements, that are list with first arg being the type
;; (keyword):
;;  - :tag 2nd elt is the replacement string (default macro)
;;  - :klone 2nd elt is the lambda

(defun x2h:expanse-macros (tree &aux
    (x2h:macros (Hashtable ()))		;plist of macros definitions
  )
  (x2h:expanse-macros-node tree)
)

(setq x2h:expanse-macros-re (regcomp (+
      "^[ \t\n]*([a-zA-Z_:][-a-zA-Z0-9._:\xb7]*)" ; 1 macro name
      "[ \t\n]*(.*)"		; 2 repl
)))

(setq trim-spaces:re (regcomp "^[ \t\n\r]*(.*[^ \t\n\r])[ \t\n\r]*$"))
(defun trim-spaces (s)
  (if (and (typep s String) (regexec trim-spaces:re s))
    (regsub trim-spaces:re 1)
    s
))

;; we encountered a macro definition, store its definition and remove it
(defun x2h:define-macro-node (node &aux
    name
    contents
    (do-remove t)
  )
  (if 
    (setq name (xnl:get-attribute node :name))
    (setq contents (x2h:node-contents-as-string node))

    (regexec x2h:expanse-macros-re (x2h:node-contents-as-string node))
    (progn
      (setq name (regsub x2h:expanse-macros-re 1))
      (setq contents (regsub x2h:expanse-macros-re 2))
    )
    (/= (xnl:get-attribute node :type) "file")
    (fatal-error "Bad macro definition: %0\n" node)
  )
  (verbose? "Defining macro %r0" name)
  (if 
    ;; lambda macros
    (= (xnl:get-attribute node :type) "klone")
    (with (repl (list) s () repl-node ())
      (setq s (+ "(lambda (node &aux (name 0) (children 1) (attributes 2)) "
	  contents ")"))
      (setq repl-node (eval (read (open s :type :string))))
      (put x2h:macros (intern name) (list :klone repl-node))
    )
    ;; include files
    (= (xnl:get-attribute node :type) "file")
    (with (filename (x2h:node-contents-as-string node)
	included_node (x2h:load filename)
      )
      (x2h:expanse-macros-node included_node)
      (if included_node (setq do-remove ()))
      (replace-list node included_node)
    )	
    ;; format string
    (= (xnl:get-attribute node :type) "format")
    (put x2h:macros (intern name) (list :format contents))
    
    ;; no-indent
    (= (xnl:get-attribute node :type) "no-indent")
    (lappend no-indents 
      (intern (trim-spaces (x2h:node-contents-as-string node)))
    )
    ;; none: tag macros
    (not (xnl:get-attribute node :type))
    (with (repl (list)
	repl-node ()
	new-tagname contents
	s (+ "<" new-tagname "/>")
      )
      (if (/= "" new-tagname) (progn
	  (catch-error-with-message
	    "kxhtml: error in XML contents of definition of a simple macro, aborting\n"
	    (setq repl-node (sxp:parse s 
	    :filename (+ "Macro definition of name: " name)
		:entities html40entities
	      )
	  ))
	  (put x2h:macros (intern name) (list :tag repl-node))
	)
	(put x2h:macros (intern name) (list :tag ()))
    ))
    ;; default: error
    (fatal-error 1 "ERROR: macro type %r0 not defined!\n" 
      (xnl:get-attribute node :type)
    )
  )
  (if do-remove (x2h:delete-node node))
)

(defun x2h:expanse-macros-node (node &aux 
    must-clean? repl-list (i 0)
  )
  (if (not (typep node String))
    (progn	;recurse only in elements, not chardata
      (if 
	;;macro definition, remember it and remove node
	(= macro-tag-name (xnl:name node))
	(x2h:define-macro-node node)
	;; macro-lambda reference
	(setq repl-list (getn x2h:macros (xnl:name node)))
	(progn
	  (verbose? "Expansing macro \"%0\"" (xnl:name node))
	  (if 
	    (= :klone (0 repl-list))	;=== klone
	    (progn
	      (apply (1 repl-list) (list node))
	      (x2h:expanse-macros-node node) ; re-process the replacement
	    )
	    
	    (= :format (0 repl-list))	;=== format
	    (with (
		format-string (x2h:replace-attributes (1 repl-list) node)
		exp 
		(print-format String format-string
		  (children-in-XML (1 node)) ;sons, in XML form
		  (attributes-list-string (2 node)) ;attributes, in XML form
		  (trim-spaces (0 (1 node))) ; first child, space trimmed
		  (0 (1 node))		;first child
		  (0 node)		;name
		)
		res ()
	      )
	      (catch-error-with-message
		"kxhtml: error in XML contents of expansion of a macro, aborting\n"
		(setq res (sxp:parse exp :forest t :filename  
		    (+ "Macro expansion of name: " (xnl:name node))
		    :entities html40entities
		  )
	      ))
	      (replace-list node (list () res))
	      (dolist (child res)
		(x2h:expanse-macros-node child) ; re-process the replacement
	      )
	    )
	    (= :tag (0 repl-list))	;=== tag
	    (with (repl (1 repl-list) 
		attributes (xnl:attributes node)
	      )
	      (xnl:name node (xnl:name repl))
	      (dohash (key val (xnl:attributes repl))
		(xnl:set-attribute node key val)
	      )
	      (x2h:expanse-macros-node node) ; re-process the replacement
	    )
	))
      )
      ;; recurse
      (if (0 node)
	(dolist (child (xnl:children node))
	  (x2h:expanse-macros-node child)
	)
      )
    )
  )
)

;; Replaces forms %{xxx} by value of attribute xxx in node
;; %{xxx=yyy} means that yyy is the default value
(setq x2h:replace-attributes-re (regcomp "%{([^}=]+)(=(.*))?}"))
(defun x2h:replace-attributes (s node &aux)
  (if (x2h:replace-attributes-re s)
    (replace-string (copy s) x2h:replace-attributes-re 
      x2h:replace-attributes-do :all t :quote t
    )
    s
  )
)
(defun x2h:replace-attributes-do (re &aux
    (name (re 1))
  )
  (get (xnl:attributes node) (intern (+ ":" name)) '(re 3))
)

(defun x2h:delete-node (node)
  (replace-list node (vector))
)

(defun attributes-list-string (plist &aux 
    (string (copy ""))
    (stream (open string :type :string :direction :output))
  )
  (dohash (key val plist)
    (print-format stream " %0=\"" (subseq key 1))
    (sxp:print-attval val stream)
    (print-format stream "\"")
  )
  string
)

(defun children-in-XML (children &aux 
    (string (copy ""))
    (stream (open string :type :string :direction :output))
  )
  (dolist (child children)
    (sxp:print child stream t)
  )
  string
)

;; takes the whole contents of a node and returns it as a string, decompiling
;; it if needed

(defun  x2h:node-contents-as-string (node)
  (if (= (length (xnl:children node)) 1)
    (if (xnl:chardata? (xnl:get-child node 0))
      (xnl:get-child node 0)		;one string child, easy
      (children-in-XML (xnl:children node))
    )
    (children-in-XML (xnl:children node))
))

;;=============================================================================
;;                    Marking HTML start-only tags
;;=============================================================================

(setq x2h:re-lower (regcomp "^[^A-Z]+$"))

(defun mark-monotags (rname children &rest attributes &aux
    (name (if (regexec x2h:re-lower rname) rname (intern (tolower rname))))
    (res (if (seek monotags name)
	(vector name children attributes t)
	(vector name children attributes)
    ))
  )
  (if (seek no-indents name) (put res 4 t)) ;mark for no indent
  res
)

;;=============================================================================
;;                    Putting info in header
;;=============================================================================
;; we add in header:
;;   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
;;   <meta name="Generator" content="kxhtml; http://www.inria.fr/koala/kxhtml">

(defun update-header (tree &aux head body http-equiv generator)
  ;; add header if there isnt one
  (if (/= 'html (xnl:name tree))
    (setq tree (xnl:new 'html (list tree)))
  )
  (dolist (child (xnl:children tree))
    (if (= 'head (xnl:name child)) (setq head child)
       (= 'body (xnl:name child)) (setq body child))
  )
  (if (not body) 
    (xnl:children tree (list (xnl:new 'body (xnl:children tree))))
  )
  (if (not head) 
    (xnl:insert-child tree 0 (setq head (xnl:new 'head)))
  )
  (dolist (child (xnl:children head))
    (if (= 'meta (xnl:name child))
      (if (xnl:get-attribute child :http-equiv) (setq http-equiv child)
	(= "Generator" (xnl:get-attribute child :name)) (setq generator child)
  )))
  (if (not http-equiv)
    (xnl:insert-child head -1 (xnl:new 'meta () 
	'(:http-equiv "Content-Type" :content "text/html; charset=iso-8859-1")
  )))
  (if (not generator)
    (xnl:insert-child head -1 (xnl:new 'meta () 
	'(:name "Generator" 
	  :content "kxhtml; http://www.inria.fr/koala/kxhtml")
  )))
  tree
)

;;=============================================================================
;;                    Printing HTML
;;=============================================================================
;; the following code is recopied from sxp-xml.kl, with only slight changes to 
;; omit end tags when forbidden and write <foo></foo> instead of <foo/>

(defun x2h:print (node &optional (stream *standard-output*) (level 1))
  (write-string 
    "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01 Transitional//EN'>\n"
    stream)

  (setq sxp::print-indent (not sxp:print-indent-string))
  (x2h:print-node node stream level)
  (write-char #\newline stream)
  (flush stream)
  ()
)

(defun x2h:print-node (node stream level)
  (if (4 node)
    (with (sxp::print-indent t) (x2h:print-node-indent node stream level))
    (x2h:print-node-indent node stream level)
))

;; code copied from sxp:print-node with 2 slight modifications (3 node)
;; to omit end tags and print <em></em> instead of <em/>
(defun x2h:print-node-indent (node stream level)
  (if (typep node String)
    (x2h:print-chardata node stream)
    (progn
      (print-format stream "<%0" (xnl:name node))
      (dohash (key val (xnl:attributes node))
	(print-format stream " %0=\"" (subseq key 1))
	(sxp:print-attval val stream)
	(print-format stream "\"")
      )
      (if (xnl:children node) (progn
	  (write-char #\> stream)
	  (if (or sxp::print-indent
	      (sxp:node-has-chardata? node) ; dont indent if there are chardata
	    )
	    (dolist (child (xnl:children node))
	      (x2h:print-node child stream (+ level 1))
	    )
	    ;; only subnodes? indent
	    (progn
	      (write-char #\newline stream)
	      (dolist (child (xnl:children node))
		(dotimes (sxp::dummy level)
		  (write-chars sxp:print-indent-string () stream)
		)
		(x2h:print-node child stream (+ level 1))
		(write-char #\newline stream)
	      )
	      (dotimes (sxp::dummy (- level 1))
		(write-chars sxp:print-indent-string () stream)
	      )
	    )
	  )
	  (if (not (3 node))
	    (print-format stream "</%0>" (xnl:name node))
	  )
	)
	(if (3 node)
	  (write-chars ">" () stream)
	  (print-format stream "></%0>" (xnl:name node))
	)
      )
    )
  )
)

;;=============================================================================
;;                    latin chars quoting
;;=============================================================================
(setq x2h:latin-chars (vector))
(dohash (num val '(
      160 "&nbsp;" 161 "&iexcl;" 162 "&cent;" 163 "&pound;" 164 "&curren;"
165 "&yen;" 166 "&brvbar;" 167 "&sect;" 168 "&uml;" 169 "&copy;" 170 "&ordf;"
171 "&laquo;" 172 "&not;" 173 "&shy;" 174 "&reg;" 175 "&macr;" 176 "&deg;" 177
"&plusmn;" 178 "&sup2;" 179 "&sup3;" 180 "&acute;" 181 "&micro;" 182 "&para;"
183 "&middot;" 184 "&cedil;" 185 "&sup1;" 186 "&ordm;" 187 "&raquo;" 188
"&frac14;" 189 "&frac12;" 190 "&frac34;" 191 "&iquest;" 192 "&Agrave;" 193
"&Aacute;" 194 "&Acirc;" 195 "&Atilde;" 196 "&Auml;" 197 "&Aring;" 198
"&AElig;" 199 "&Ccedil;" 200 "&Egrave;" 201 "&Eacute;" 202 "&Ecirc;" 203
"&Euml;" 204 "&Igrave;" 205 "&Iacute;" 206 "&Icirc;" 207 "&Iuml;" 208 "&ETH;"
209 "&Ntilde;" 210 "&Ograve;" 211 "&Oacute;" 212 "&Ocirc;" 213 "&Otilde;" 214
"&Ouml;" 215 "&times;" 216 "&Oslash;" 217 "&Ugrave;" 218 "&Uacute;" 219
"&Ucirc;" 220 "&Uuml;" 221 "&Yacute;" 222 "&THORN;" 223 "&szlig;" 224
"&agrave;" 225 "&aacute;" 226 "&acirc;" 227 "&atilde;" 228 "&auml;" 229
"&aring;" 230 "&aelig;" 231 "&ccedil;" 232 "&egrave;" 233 "&eacute;" 234
"&ecirc;" 235 "&euml;" 236 "&igrave;" 237 "&iacute;" 238 "&icirc;" 239
"&iuml;" 240 "&eth;" 241 "&ntilde;" 242 "&ograve;" 243 "&oacute;" 244
"&ocirc;" 245 "&otilde;" 246 "&ouml;" 247 "&divide;" 248 "&oslash;" 249
"&ugrave;" 250 "&uacute;" 251 "&ucirc;" 252 "&uuml;" 253 "&yacute;" 254
"&thorn;" 255 "&yuml;"
  ))
  (put x2h:latin-chars num val)
)

(setq x2h:re-print-chars (regcomp "^[^\xa0-\xff]+"))
(setq x2h:re-allprintable-chars (regcomp "^[^\xa0-\xff]*$"))

(if quotation2brackets (progn
    (put x2h:latin-chars 171 "&lt;") ;  = <
    (put x2h:latin-chars 187 "&gt;") ;  = >
    (put x2h:latin-chars 254 "&amp;") ;  = &
))

(defun x2h:print-chardata (s stream &aux (pos 0))
  (if (regexec x2h:re-allprintable-chars s)
    (sxp:print-chardata s stream)	;optimize common case
    (catch 'Done (while t		;else quote 8-bit chars
	(if (regexec x2h:re-print-chars s pos)
	  (progn
	    (sxp:print-chardata (regsub x2h:re-print-chars 0) stream)
	    (setq pos (1 (getn x2h:re-print-chars 0)))
	  )
	  
	  (not (getn s pos)) (throw 'Done)
	  
	  (progn 
	    (print-format stream 
	      (get x2h:latin-chars (get s pos) '(subseq s pos (+ pos 1)))
	    )
	    (incf pos))
)))))

;;=============================================================================
;;                    misc utils
;;=============================================================================
(defmacrod catch-error-with-message (mess &rest forms)
  `(with (catch-error-with-message:err t)
    (catch 'ALL ,@forms (setq catch-error-with-message:err ()))
    (if catch-error-with-message:err 
      (fatal-error 1 ,mess)
)))

(defun x2h:load (file)
  (if include_dirs
    (catch 'Found
      (dolist (dir include_dirs)
	(if (= "" dir) (setq dir "."))
	(if (file-stats (+ dir "/" file))
	  (throw 'Found (x2h:load-file (+ dir "/" file)))
	)
      )
      (fatal-error 1 "kxhtml: file %0 not found in include directories!\n")
    )
    (x2h:load-file file)
))

(defun x2h:load-file (file  &aux 
    (fd (open file :error ()))
  )
  (if fd
    (sxp:parse fd :entities html40entities)
    (fatal-error 1 "kxhtml: file %0 not found!\n" file)
))	

;;=============================================================================
;;                    main
;;=============================================================================
(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***
