#!/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;,...

  - understanding .kxf (Koala Xml Form) files, a different syntax for xml

  - skipping optional auto-execution headers of the form #!...
  
  - checking for alt tags on images
    (put an ampty alt tag to get rid of message)

  - auto-computing images widths and height (needs external programs
    gif2pnm, png2pnm, jpeginfo)

  - 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>
    or:
    «#tag-name replacement»   if input is in the Koala Xml Form XML variant
    
    And macros definition can be of many types:

    * ALIAS:
    ---------
    <macro name="tag-name" type="alias">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)
     Note: type="alias" is the default and can be omitted

    * 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 or an "include" macro below

    <macro type="include">path</macro>
      Adds path to include_path.

    * TEXT:
    ---------
    <macro  name="tag-name" type="text">format-string</macro>
      will replace the element by the XML node in format-string, with %% 
      expansed to:
	%%{gee} ==> contents of sub-element of name gee
	%%{gee/bar/foo} ==> contents of sub-element of name foo of sub-element
	of name bar of sub-element of name gee
	%%{gee/bar/foo=def} ==> same, but with value def if not present
        %%{nodespath@foo} ==> value of attribute foo if present, else ""
        %%{nodepath@foo=bar} ==> value of attribute foo, "bar" if not present
        %%{} ==> contents (children), pretty-printed into a string
        %%   ==> %%
      e.g.: <macro name="I" type="text">&lt;img src="%%{}"/></macro>

    * 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. The EXEC and SHELL languages are mandatory.
    Possible languages are:
    
    EXEC
    <macro name="tag-name" type="exec" command="command" arg1="arg1".../>
      will fork the external command "command" with the arguments arg1..argN
      the command and argument strings are scanned and sequences %%{...} are
      expansed by the same rules as for the FORMAT macro type
      The attributes are provided to the command as env vars
      e.g: <macro type="exec" name="curdate" command="date"/>
           will transform elements <curdate TZ="GMT+1"/> into the current
	   date string with the environment variable TZ set to "GMT+1"
      Attributes can also be given at definition time as default value, they 
      can be overriden at invocation time:
           <macro type="exec" name="strlen" string="%{}" command="bash"
	          arg1="-c" arg2='echo "${#string}"'/>
           will be replaced by the length of contents:
	   <strlen>a string of twenty-nine chars</strlen> ==> 29
      The result is trimmed at beginning and end of its whitespace. You can
      provide the attribute trim_result='false' (only at definition) if you 
      want to disable this.

    SHELL
    <macro name="tag-name" type="shell" shell="ksh">shell command</macro>
      This works like an EXEC macro, but the commands are executed in the same
      shell environment.
      If shell is not provided, the one listed in the env var SHELL is used
      Env variables can be specified as for the EXEC macro as attributes
      The strlen example above can thus be written:
      <macro type="shell" name="strlen" string="%{}">echo "${#string}"</macro>

    PYTHON
    <macro name="tag-name" type="python" shell="python">python program</macro>
      This is just like the shell command, but with a python interpreter.
      Default is to invoke "python", or the shell attributes if given, or
      the value of the env variable PYTHON.

    KLONE (obsolete)
    <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)

    * FORMAT:
    ---------
    <macro  name="tag-name" type="format">format-string</macro>
      will replace the element by the XML node in format-string, with %% 
      expansed to:
        %%{foo} ==> value of attribute foo if present, else ""
        %%{foo=bar} ==> value of attribute foo, "bar" if not present
        %%{} ==> XML contents (children), pretty-printed into a string
        %%   ==> %%
        %%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
      e.g.: <macro type="format">I &lt;img src="%%2"/></macro>
      If format-string is empty, the tag and its contents are deleted
      If an attribute value expands to <>, the attribute is removed. Thus to
      pass attribute align if present, write: align="%{align=<>}"
      NOTE: this is obsoleted by the "text" type and should not be used

    * 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

      IMPORTANT: whitespace may still be removed if no character data is 
      present in tag contents, only sub-elements. To this effect, it is 
      recommended to use instead the processing instruction 
      kxhtml:preserve-whitespace followed by the tags to be protected, both 
      in input and output (the no-indent macro only protects on output).
      e.g: if we define a <code> macro expansed in a <pre>, we should put a
	<? kxhtml:preserve-whitespace code ?> declaration in the header
      Or you can set the xml:space="preserve" attribute on the element

    ("-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 or .kxf files found if the corresponding .html 
is obsolete")
	("-R" () force-rebuild "like -r, but forces regeneration of all files")
	("-new" () create-new "just outputs a skeleton file of an empty
document, useful as a reminder")
	("-qk" () quote-kxf "acts just as a filter to quote data to be 
included in .kxf file (chars « and »)")
    ("-nw" () no-warnings "do not print warnings for questionable HTML practices")
    ("-d" basedir filedir "base directory from which to look for images
useful when processing stdin")
	("-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 a ]
)
;; 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 ())
)
(setq re-path (regcomp "^(.*[/])[^/]+$"))
(if filedir
  (if ({regcomp "[/]$"} filedir) () (nconc filedir "/"))
  filename
  (if (re-path filename)
    (setq filedir (1 re-path))
    (setq filedir "")
  )
  t
  (setq filedir "")
)

(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)
))

(if quote-kxf (with (buffer (String *standard-input*))
    (replace-string buffer {regcomp "«|»"} ["«" "«-»" "»" "«+»"]
      :all t :quote t)
    (if (= (length buffer) (write-chars buffer))
      (exit 0)
      (exit 1)
)))

(when recursive
  (with (re (re-nocase "^(.*)[.](xhtml|kxf)$")
      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 (&aux
    (x2h:macros (Hashtable ()))		;plist of macros definitions
  )
  ;;  (setq sxp:print-indent-string ())	;HTML is sensitive to indent (<pre>)
  (kxf:parse-hook t)
  ;; load headers
  (dolist (header header_files) 
    (dolist (included_node (x2h:load header))
      (x2h:expanse-macros-node included_node)
  ))
  (skip-unix-magic-number in filename)
  (catch-error-with-message
    "kxhtml: Error in xml input, aborting.\n"
    (setq tree (sxp:parse in :filename filename :entities html40entities
	:whitespace-keeping-tags no-indents
    ))
    (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)
  (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 in 
;; the x2h:macros plist 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))
    )
    (not (seek ["file" "include"] (xnl:get-attribute node :type)))
    (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))
    )
    ;; exec macros
    (= (xnl:get-attribute node :type) "exec")
    (put x2h:macros (intern name) 
      (list :exec 
	(make-exec-call (xnl:attributes node) name)
	(make-env-vars (xnl:attributes node) name)
	(/= "false" (getn (xnl:attributes node) :trim_result))
    ))

    ;; shell macros
    (= (xnl:get-attribute node :type) "shell")
    (put x2h:macros (intern name) 
      (list :exec 
	(make-shell-call (xnl:attributes node) name)
	(make-env-vars-shell (xnl:attributes node) name)
	(/= "false" (getn (xnl:attributes node) :trim_result))
    ))

    ;; python macros
    (= (xnl:get-attribute node :type) "python")
    (put x2h:macros (intern name) 
      (list :exec 
	(make-python-call (xnl:attributes node) name)
	(make-env-vars-shell (xnl:attributes node) name)
	(/= "false" (getn (xnl:attributes node) :trim_result))
    ))

    ;; include files
    (= (xnl:get-attribute node :type) "file")
    (with (filename (x2h:node-contents-as-string node))
      (dolist (included_node (x2h:load filename))
	(x2h:expanse-macros-node included_node)
    ))
    (= (xnl:get-attribute node :type) "include")
    (with (filename (x2h:node-contents-as-string node))
      (if include_dirs
	(lappend include_dirs filename)
	(setq include_dirs (list filename))
    ))
    ;; format string
    (= (xnl:get-attribute node :type) "format")
    (put x2h:macros (intern name) (list :format  
	(if (and (= 1 (length (xnl:children node)))
	    (typep (0 (xnl:children node)) String)
	  )
	  (0 (xnl:children node))
	  contents
    )))

    ;; text string
    (= (xnl:get-attribute node :type) "text")
    (put x2h:macros (intern name) (list :text 
	(if (and (= 1 (length (xnl:children node)))
	    (typep (0 (xnl:children node)) String)
	  )
	  (0 (xnl:children node))
	  contents
    )))
    
    ;; no-indent
    (= (xnl:get-attribute node :type) "no-indent")
    (lappend no-indents 
      (intern (trim-spaces (x2h:node-contents-as-string node)))
    )
    ;; none: alias/tag macros
    (or (= (xnl:get-attribute node :type) "alias")
      (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
		:whitespace-keeping-tags no-indents
	      )
	  ))
	  (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
      ;; recurse first to expand child first
      (if (0 node)
	(dolist (child (xnl:children node))
	  (x2h:expanse-macros-node child)
	)
      )
      ;; then do the node
      (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
	    )
	    (= :exec (0 repl-list))	;=== exec and shell macros
	    (with (contents (x2h:node-contents-as-string node)
		call (list) out () exp () oldenv (list) attributes 
		(copy (2 repl-list))
	      )
	      (dolist (arg (1 repl-list))
		(lappend call (x2h:replace-attributes arg node contents
		))
	      )
	      (dohash (var val (xnl:attributes node))
		(put attributes (subseq var 1) val)
	      )
	      (with (expval ())
		(dohash (var val attributes)
		  (if (/= "<>" (setq expval 
			(x2h:replace-attributes val node contents)
		    )) (progn
		      (lappend oldenv var)
		      (lappend oldenv (getenv var))
		      (putenv var expval)
	      ))))
	      (if (= " shell" (0 call))
		(setq exp (execute-shell-command (1 call))) ; shell
		(= " python" (0 call))
		(setq exp (execute-shell-command (1 call))) ; python
		t (progn
		  (system call :output 'out) ; exec
		  (setq exp (String out))
	      ))

	      (if (3 repl-list) (setq exp (trim-result exp)))
	      (dohash (var val oldenv)
		(putenv var val)
	      )
	      
	      (catch-error-with-message
		"kxhtml: error in XML contents of expansion of an exec macro, aborting\n"
		(setq res (sxp:parse exp :forest t :filename  
		    (+ "Macro expansion of name: " (xnl:name node))
		    :entities html40entities
		    :whitespace-keeping-tags no-indents
		  )
	      ))
	      (replace-list node (list () res))
	      (dolist (child res)
		(x2h:expanse-macros-node child) ; re-process the replacement
	      )
	    )
	    
	    (= :format (0 repl-list))	;=== format
	    (with (
		contents (x2h:node-contents-as-string node)
		format-string (remove-invalid-att (x2h:replace-attributes 
		  (1 repl-list) node contents)
		)
		exp 
		(print-format String format-string
		  contents ;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 format macro, aborting\n"
		(setq res (sxp:parse exp :forest t :filename  
		    (+ "Macro expansion of name: " (xnl:name node))
		    :entities html40entities
		    :whitespace-keeping-tags no-indents
		  )
	      ))
	      (replace-list node (list () res))
	      (dolist (child res)
		(x2h:expanse-macros-node child) ; re-process the replacement
	      )
	    )
	    (= :text (0 repl-list))	;=== text
	    (with (
		exp (x2h:replace-text (1 repl-list) node)
		res ()
	      )
	      (catch-error-with-message
		"kxhtml: error in XML contents of expansion of a format macro, aborting\n"
		(setq res (sxp:parse exp :forest t :filename  
		    (+ "Macro expansion of name: " (xnl:name node))
		    :entities html40entities
		    :whitespace-keeping-tags no-indents
		  )
	      ))
	      (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
	    )
	))
      )
    )
  )
)

;; Replaces forms %{xxx} by value of attribute xxx in node
;; %{xxx=yyy} means that yyy is the default value
;; Warning: if an attribute value begins with <, delete attribute totally
(setq x2h:replace-attributes-re (regcomp "%{([^}=]+)(=([^}]*))?}"))
(setq x2h:replace-attributes-re-empty (regcomp "%{}"))

(defun x2h:replace-attributes (s node contents &aux 
  )
  (if (x2h:replace-attributes-re s)
    (setq s (replace-string (copy s) x2h:replace-attributes-re 
	x2h:replace-attributes-do :all t :quote t
  )))
  (if (x2h:replace-attributes-re-empty s)
    (setq s (replace-string (copy s) x2h:replace-attributes-re-empty contents 
	:all t :quote t
  )))
  s
)

(setq x2h:remove-invalid-att-re (regcomp (+ "(([A-Za-z][-A-Za-z0-9._]*)"
      "[ \t\n\r]*" "=" "[ \t\n\r]*" "(\"&lt;>\"|'&lt;>'))"
)))
(defun remove-invalid-att (s)
  (replace-string s x2h:remove-invalid-att-re "" :all t :quote t)
)
(defun x2h:replace-attributes-do (re &aux
    (name (intern (+ ":" (re 1))))
  )
  (get (xnl:attributes node) 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 :raw 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)
  (children-in-XML (xnl:children node))
)

;; general text replacement by node sons and attributes
;; expands %{xxx} forms into, where xxx is:
;;  location=defval     value at location or defval
;;  location: 
;;    <empty>           contents of node
;;    node(/node)*      contents of subnodes
;;    nodepath@attribute value of attribute one nodepath
;;    attribute can be *, meaning include also the name 

;; re: 1 is nodepath or empty, 
;; 3 attribute present?, 4 attribute name or *
;; 5 defval present?, 6 defval
x2h:replace-text-re = (regcomp (+ "%{"
    "([A-Za-z][-A-Za-z0-9._]*([/][A-Za-z][-A-Za-z0-9._]*)*)?"
    ;;1                      2  
    "([@]([A-Za-z][-A-Za-z0-9._]*|[*]))?([=]([^}]*))?"
    ;;3  4                              5   6        
    "}"
))

(defun x2h:replace-text (s node &aux
  )
 (replace-string (copy s) x2h:replace-text-re x2h:replace-text-do 
    :all t :quote t
  )
)

;; global used: node
x2h:replace-text-re-node = (regcomp 
  "^([A-Za-z][-A-Za-z0-9._]*)([-A-Za-z0-9._/]*)$"
)
(defun x2h:replace-text-do (re &aux
    (n node)
    (nodepath (re 1))
    (renode x2h:replace-text-re-node)
    value
  )
  (while (and n  (renode nodepath))
    (setq n (find-subnode n (intern (renode 1))))
    (setq nodepath (renode 2))
  )
  (setq value
    (if n (progn
	(if (/= "" (re 3))			;attribute?
	  (if (= (re 4) "*") (progn	;all attributes
	      (attributes-list-string (xnl:attributes n))
	    )
	    (progn			;one att value
	      (xnl:get-attribute n (intern (+ ":" (re 4))))
	    )
	  )
	  (progn				;no att? contents
	    (children-in-XML (xnl:children n))
	  )
	)
      )
    )
  )
  (if value value
    (if (re 5)
      (re 6)
      ""
  ))
)

(defun find-subnode (node tag)
  (catch 'Found
    (dolist (child (xnl:children node))
      (if (and (typep child List) (= tag (xnl:name child)))
	(throw 'Found child)
))))

(defun make-exec-call (attplist name &aux (n 1) arg (call (list)))
  (lappend call (get attplist :command '(fatal-error 1 
	"kxhtml: exec macro %0 need a command attribute!\n" name)
  ))
  (while (setq arg (getn attplist (intern (+ ":arg" (String n)))))
    (lappend call arg)
    (incf n)
  )
  call
)

;; a shell call has " shell" as command
(defun make-shell-call (attplist name &aux (n 1) arg)
  (list " shell" contents)
)

;; a pyhton call has " python" as command
(defun make-python-call (attplist name &aux (n 1) arg)
  (list " python" contents)
)

(setq make-env-vars:re (regcomp 
    "^(:command|:type|:trim_result|:name|:arg[0-9]+)$"))
(defun make-env-vars (attplist name &aux 
    (env (list))
    var
  )
  (dohash (att value attplist)
    (unless (make-env-vars:re att)
      (setq var (substring-ptr att 1))
      (lappend env var)
      (lappend env value)
  ))
  env
)

(setq make-env-vars-shell:re (regcomp 
    "^(:shell|:type|:trim_result|:name)$"))
(defun make-env-vars-shell (attplist name &aux 
    (env (list))
    var
  )
  (dohash (att value attplist)
    (unless (make-env-vars:re att)
      (setq var (substring-ptr att 1))
      (lappend env var)
      (lappend env value)
  ))
  env
)

(setq trim-result:re1 (regcomp "^[ \t\n\r]+"))
(setq trim-result:re2 (regcomp "[ \t\n\r]+$"))
(defun trim-result (s)
  (if (trim-result:re1 s) (setq s (subseq s (1 (getn trim-result:re1 0)))))
  (if (trim-result:re2 s) (setq s (subseq s 0 (0 (getn trim-result:re2 0)))))
  s
)

;;=============================================================================
;;                    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 rname children attributes t)
	(vector rname children attributes)
    ))
  )
  (if (seek no-indents name) (put res 4 t)) ;mark for no indent
  res
)

;; we set PIs to sxp to handle declarations of preserve-whitespace

(setq sxp:parse-PI-hook:re (regcomp 
    "^[ \t\n\r]*kxhtml:preserve-whitespace[ \t\n\r]+(.*)$"
))
(defun sxp:parse-PI-hook (pi &aux)
  (if (regexec sxp:parse-PI-hook:re pi)
    (doregexp (re "[a-zA-Z_:][-a-zA-Z0-9_:.\xb7]*" 
	(regsub sxp:parse-PI-hook:re 1)
      )
      (with (tag (intern (regsub re 0)))
      (lappend no-indents tag)
      (put sxp:keep-whitespace-tags tag t)	;internal list of xml-sxp!
    ))
))

;;=============================================================================
;;                    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)))
  )
  ;; add a comment to avoid editing generated file
  (insert (xnl:children tree) 0
    (xnl:new "!-- Generated file: *** DO NOT EDIT THIS! ***, but the .kxf or .xhtml --")
  )
  (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)

  (setqn sxp:re-print-chars sxp:re-print-chars-e
    sxp:re-print-attval-chars sxp:re-print-attval-chars-e
    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 (getn html-checkable-tags (0 node)) 
    (if no-warnings ()
      (html-warnings node))
  )
  (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))
	(if (/= :xml:space key) (progn
	    (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
	      (4 node)			;or node is marked as no-indent
	    )
	    (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 (or (3 node) (typep (xnl:name node) String))
	  (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))
)))))

;;=============================================================================
;;                    html warnings
;;=============================================================================
;; warns for some common html errors on output
(setq html-checkable-tags (Hashtable [img t IMG t]))
(setq html-warnings:re-img (re-nocase "img"))
(defun html-warnings (node &aux)
  (if (html-warnings:re-img (0 node)) 
    (if (getn (xnl:attributes node) :src) 
      (with (src (getn (xnl:attributes node) :src))
	(if (or (not (getn (xnl:attributes node) :height))
	    (not (getn (xnl:attributes node) :width))
	  )
	  (progn
	    (PF *stderr* "Warning: no dimensions set for image %0" src)
	    (with (dims (get-img-dims src))
	      (if dims (progn
		  (PF *stderr* ", set to:  width='%0' height='%1'" (0 dims) (1 dims))
		  (xnl:set-attribute node :width (0 dims))
		  (xnl:set-attribute node :height (1 dims))
	    )))
	    (PF *stderr* "\n")
	))
	(if (getn (xnl:attributes node) :alt)
	  (if (= "" (getn (xnl:attributes node) :alt))
	    (delete (xnl:attributes node) :alt)
	  )
	  (PF *stderr* "Warning: no ALT tag set for image %0\n" src
	))
      )
      (PF *stderr* "Warning: no SRC for image!\n")
)))

;; Compute dims of image, retuns pair (x y) or ()
(setq distant-url-re (regcomp "^[a-zA-Z]+:([.][a-zA-Z]+)$"))
(defun get-img-dims (filename)
  (if (distant-url-re filename) 
    (with (dims ()
	  tempfile (+ "/tmp/kxhtml" (String *current-process-id*)
	  (distant-url-re 0)
	))
      (if (/= 0 (wait (system (list "wget" "-O" tempfile "-q" filename))))
	(PF *stderr* "Warning: cannot get image URL %0\n" filename)
	(progn
	  (setq dims (get-imgfile-dims tempfile))
	  (wait (system (list "rm" "-f" tempfile)))
	  dims
	)
    ))
    (get-imgfile-dims (+ filedir filename))
))

(setqn
  re-jpg (re-nocase "[.]jpe?g$")
  re-gif (re-nocase "[.]gif$")
  re-png (re-nocase "[.]png$")
)
(defun get-imgfile-dims (filename &aux fd (dims (list)))
  (catch 'EOF
    (if
      (re-jpg filename) (progn
	(system (list "jpeginfo" "-l" filename) :output 'fd)
	(match " ([0-9]+) x ([0-9]+) " (read-line fd "") 1 2)
      )
      (re-gif filename) (progn
	(system (list  "giftopnm" filename) :output 'fd)
	(read-line fd)			;skip head
	(match "^([0-9]+) ([0-9]+)" (read-line fd "") 1 2)
      )
      (re-png filename) (progn
	(system (list  "pngtopnm" filename) :output 'fd)
	(read-line fd)			;skip head
	(match "^([0-9]+) ([0-9]+)" (read-line fd "") 1 2)
      )
      (progn
	(PF *stderr* "Warning: unknown image type: %0\n" filename)
	()
      )
)))

;;=============================================================================
;;                    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
      :whitespace-keeping-tags no-indents :forest t)
    (fatal-error 1 "kxhtml: file %0 not found!\n" file)
))	

;; Expands «#foo ...» into «macro(name=foo) ...»
(setq kxf:bad-tag-hook-re (regcomp "^#(([a-zA-Z_:][-a-zA-Z0-9._:\xb7]*)|(/[a-zA-Z_:][-a-zA-Z0-9._:\xb7]*))(=?)"))

(defun kxf:bad-tag-hook ()
  (if (kxf:bad-tag-hook-re buffer pos) 
    (with (elt () name (kxf:bad-tag-hook-re 1))
      (incf pos)
      (setq elt (kxf:PS-element))
      (xnl:name elt 'macro)
      (xnl:set-attribute elt :name name)
      elt
    )
    :error
  )
)

;; skips optional #! first line in a fd, if not reading from stdin
(defun skip-unix-magic-number (fd filename)
  (if (and filename
      (not (regexec (regcomp "^#!") (read-line fd "")))
    )
    (file-position fd 0)
))

;;=============================================================================
;;                    Subshell handling
;;=============================================================================
(setqn
  execute-shell-command:pid ()
  execute-shell-command:shell ()
  execute-shell-command:in ()
  execute-shell-command:out ()
  execute-shell-command:marker 
  "mrNzfOYamldhPN9hA=uQ0hM5w1hd3Y-MPSTVuXO6zz@OXWithI/mJ_rC8cvgZFaZSMC5LRf4Jkb"
  execute-shell-command:marker-re (regcomp (+ 
      "^(.*)" execute-shell-command:marker "$"))
)
(defun execute-shell-command (command &optional shell &aux 
    (res (copy "")) line
  )
  (if (not execute-shell-command:pid) (execute-shell-command:start shell))
  (PF execute-shell-command:in "%0\necho '%1'\n" command
    execute-shell-command:marker)
  (flush execute-shell-command:in)
  (catch 'EOF
    (while line = (read-line execute-shell-command:out)
      (if (execute-shell-command:marker-re line) (progn
	  (nconc res (execute-shell-command:marker-re 1))
	  (throw 'EOF)
	)
	(nconc res (if (/= "" res) "\n" "") line)
  )))
  res
)

(defun execute-shell-command:start (&optional shell)
  (if (not shell) (setq shell (getenv "SHELL")))
  (if (not shell) (setq shell  "/bin/sh"))
  (setq execute-shell-command:shell shell)
  (setq execute-shell-command:pid
    (system (list shell)
      :input 'execute-shell-command:in
      :output 'execute-shell-command:out
      :error 'execute-shell-command:out
  ))
)

;;=============================================================================
;;                    Subpython handling
;;=============================================================================
(setqn
  subpython-command:pid ()
  subpython-command:shell ()
  subpython-command:in ()
  subpython-command:out ()
  subpython-command:marker 
  "mrNzfOYamldhPN9hA=uQ0hM5w1hd3Y-MPSTVuXO6zz@OXWithI/mJ_rC8cvgZFaZSMC5LRf4Jkb"
  subpython-command:marker-re (regcomp (+ 
      "^(.*)" subpython-command:marker "$"))
)
(defun subpython-command (command &optional shell &aux 
    (res (copy "")) line
  )
  (if (not subpython-command:pid) (subpython-command:start shell))
  (PF subpython-command:in "%0\n#%1\n" command
    subpython-command:marker)
  (flush subpython-command:in)
  (catch 'EOF
    (while line = (read-line subpython-command:out)
      (if (subpython-command:marker-re line) (progn
	  (nconc res (subpython-command:marker-re 1))
	  (throw 'EOF)
	)
	(nconc res (if (/= "" res) "\n" "") line)
  )))
  res
)

subpython-command:progname = (+ "/tmp/exec-python." (String *process-id*))
subpython-command:prog = (+ 
import os, sys
text=""
line="begin"
#os.unlink(" subpython-command:progname ")
while line != "":
  line=sys.stdin.readline()
  if line == "# subpython-command:marker \n" :
    exec text
    text = ""
    print " subpython-command:marker "
    sys.stdout.flush()
  else:
    text = text + line

)    

(defun subpython-command:start (&optional shell &aux fd)
  (if (not shell) (setq shell (getenv "PYTHON")))
  (if (not shell) (setq shell  "python"))
  (setq subpython-command:shell shell)
  fd = (open subpython-command:progname 
    :direction :output :if-exists :supersede)
  (print-format fd "%0\n" subpython-command:prog)
  (close fd)
  (setq subpython-command:pid
    (system (list shell "-u" subpython-command:progname)
      :input 'subpython-command:in
      :output 'subpython-command:out
;;      :error 'subpython-command:out
  ))
)
;;=============================================================================
;;                    main
;;=============================================================================
(main)

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