Hi Alex and Jon,

>> Indenting is impossible to do well I think because the function does
>> not know what is going to happen in the body (the 'xml' function knows
>
> I think so, too. This is also the reason why the functions in
> "lib/xhtml.l" don't do any efforts to indent. And with this <xml>
> function we go a little in the direction of HTML (as Jon also mentioned
> in his initial post).

So it is possible.  The file implementing <xml> function is attached.
I might improve formatting/indenting in the original 'xml' function
later.

I welcome any comments on the code.

> Ah, I was not aware that this is also legal in XML.

I double checked and it is legal, see http://www.w3.org/TR/REC-xml/#syntax

   ...they MUST be escaped using either numeric character references
   or the strings "&amp;" and "&lt;" respectively. The right angle
   bracket...

* Usage of the attached code

The "top-level" <xml> call can be:

(<xml> T => returns list suitable as input for 'xml' function
(<xml> NIL -3 T => writes to NIL (stdout) with 3 tabs indenting and xml decl
(<xml> "/tmp/a" 3 => writes to "/tmp/a" with 3 spaces indenting
(<xml> => writes to NIL (stdout) with no indenting

(and 4 (<xml> NIL -3 T
   (<xml> hoy id 123 class 'yes att "Xml" at @
      (<xml> inner1)
      (<xml> text id 123 dx (+ 3 4) dy (* 3 4)
         xx "you & me"
         yy "<![CDATA[\"Me, Myself & <I>\"]]>"
         (xmlPrin "No font & color arguments yet") )
      (<xml> inner2 fun "abc"
         (xmlPrin "Hi 1 asfdlkasjhfdshad")
         (<xml> line x 0 y 0 dx 100 dy 100
            (xmlPrin "thick" @))
         (xmlPrin "Hi 2") )
      (<xml> inner3
         (<xml> inner3a
            (<xml> inner3a1) ) )
      (<xml> inner4 fun "abc") ) ) )

will print

<?xml version="1.0" encoding="utf-8"?>
<hoy id="123" class="yes" att="Xml" at="4">
        <inner1/>
        <text id="123" dx="7" dy="12" xx="you &#38; me" 
yy="&#60;![CDATA[&#34;Me, Myself &#38; &#60;I>&#34;]]>">No font &#38; color 
arguments yet</text>
        <inner2 fun="abc">Hi 1 asfdlkasjhfdshad<line x="0" y="0" dx="100" 
dy="100">thick4</line>Hi 2</inner2>
        <inner3>
                <inner3a>
                        <inner3a1/>
                </inner3a>
        </inner3>
        <inner4 fun="abc"/>
</hoy>

Thanks,

Tomas

(de "xmlL" "Lst"
   (let "Att" @
      (push '"Xml"
         (make
            (link (pop '"Lst"))
            (let "Att" (make
                          (while (and "Lst" (atom (car "Lst")))
                             (link (cons (pop '"Lst")
                                         (eval (pop '"Lst") 1))) ) )
               (let "Xml" NIL
                  (let @ "At"
                     (run "Lst") )
                  (ifn "Xml"
                     (when "Att"
                        (link "Att") )
                     (link "Att")
                     (chain (flip "Xml")) ) ) ) ) ) ) )

(de "xmlO" "Lst"
   (let ("Att" @
         "Tag" (pop '"Lst") )
      (when "Nl"
         (prinl)
         (when "Pre"
            (prin "Pre") ))
      (prin "<" "Tag")
      (while (and "Lst" (atom (car "Lst")))
         (prin " " (pop '"Lst") "=\"")
         (escXml (eval (pop '"Lst") 1))
         (prin "\"") )
      (ifn "Lst"
         (prin "/>")
         (prin ">")
         (use "Nlx"
            (let (@ "At"
                  "Nl" "N"
                  "Pre" (cons "Pre" "Nn"))
               (run "Lst")
               (setq "Nlx" "Nl") )
            (when "Nlx"
               (prinl)
               (when "Pre"
                  (prin "Pre") )) )
         (prin "</" "Tag" ">") ) ) )

(de <xml> "Lst"
   (let ("At" @
         "Out" (when (and "Lst" (atom (car "Lst")))
                  (eval (pop '"Lst") 1) ))
      (if (=T "Out")
         (let ("Xml" NIL
               <xml> "xmlL"
               xmlPrin '(@ (push '"Xml" (pass pack))) )
            (let @ "At"
               (run "Lst") )
            (car (flip "Xml")) )
         (let ("N" (when (and "Lst" (atom (car "Lst")))
                        (eval (pop '"Lst") 1) )
               "Decl" (when (and "Lst" (atom (car "Lst")))
                         (eval (pop '"Lst") 1) )
               "Nn" NIL
               "Nl" NIL
               "Pre" NIL
               <xml> "xmlO"
               xmlPrin '(@ (off "Nl") (mapc escXml (rest))) )
            (when "N"
               (do (abs "N")
                  (push '"Nn" (if (lt0 "N") "^I" " "))) )
            (out "Out"
               (when "Decl"
                  (xml? T) )
               (let @ "At"
                  (run "Lst") ) ) ) ) ) )

(de escXml (X)
   (for C (chop X)
      (prin (case C
               ("\"" "&quot;")
               ("&" "&amp;")
               ("<" "&lt;")
               (">" "&gt;")
               (T C) ) ) ) )

Reply via email to