Hi Alex,
>> BTW, did you have a chance to experiment with the new extensions of
>> 'eval' and 'run'? I feel that the new 'lst' argument (for excluding
>> specific symbols from the process) was a good idea.
>
> I think it was a good idea too.
I have attached the <xml> function which makes use of the new
feature:-) See the xml2.l and xml2-test.l files.
I have also attached an "improved" version of the 'xml' function (file
xml-my.l) which allows to switch off line breaks or use tabs for
indenting.
Would it be a good idea for these to become part of picolisp as we
discussed earlier? The attached version fixes all the doubts against
it as discussed in this thread so far...
Cheers,
Tomas
# "top-level" <xml> sets up xml output
# - use prin (file/fd arg to out) + indenting lt0 tab, gt0 spaces + <?xml
decl?
# - or T create list formated for 'xml' function
# recursive <xml> tag [attr val]* ...
# pair or NIL attr key starts "body"
# NIL attr val not output, use T '((T . attr)) to output empty attr
# atom in body => xprin, pair => eval
# xprin, xrun
(de "xmlL" Lst
(push '"Xml"
(make
(link (pop 'Lst))
(let Att (make
(while (and Lst (car Lst) (atom (car Lst)))
(let K (pop 'Lst)
(if (=T K)
(for X (eval (pop 'Lst) 1)
(if (=T (car X))
(link (cons (cdr X) NIL))
(when (cdr X)
(link X) ) ) )
(when (eval (pop 'Lst) 1)
(link (cons K @)) ) ) ) ) )
(let "Xml" NIL
(xrun Lst)
(ifn "Xml"
(when Att
(link Att) )
(link Att)
(chain (flip "Xml")) ) ) ) ) ) )
(de "xmlO" Lst
(let Tag (pop 'Lst)
(when "Nl"
(prinl)
(when "Pre"
(prin "Pre") ) )
(prin "<" Tag)
(while (and Lst (car Lst) (atom (car Lst)))
(let K (pop 'Lst)
(if (=T K)
(for X (eval (pop 'Lst) 1)
(if (=T (car X))
(prin " " (cdr X) "=\"\"")
(when (cdr X)
(prin " " (car X) "=\"")
(escXml (cdr X))
(prin "\"") ) ) )
(when (eval (pop 'Lst) 1)
(prin " " K "=\"")
(escXml @)
(prin "\"") ) ) ) )
(ifn Lst
(prin "/>")
(prin ">")
(use Nl
(let ("Nl" "N"
"Pre" (cons "Pre" "Nn") )
(xrun Lst)
(setq Nl "Nl") )
(when Nl
(prinl)
(when "Pre"
(prin "Pre") ) ) )
(prin "</" Tag ">") ) ) )
(de <xml> Lst
(let Out (and Lst (atom (car Lst)) (eval (pop 'Lst) 1))
(if (=T Out)
(let (<xml> "xmlL"
xprin '(@ (push '"Xml" (pass pack)))
xrun '((Lst Ofs)
(default Ofs 2)
(for X Lst
(if (pair X)
(eval X Ofs '("Xml"))
(when (eval X Ofs '("Xml"))
(xprin @) ) ) ) )
"Xml" NIL )
(run Lst 1 '(<xml> xprin xrun "Xml"))
(car (flip "Xml")) )
(let (<xml> "xmlO"
xprin '(@ (off "Nl") (mapc escXml (rest)))
xrun '((Lst Ofs)
(default Ofs 2)
(for X Lst
(if (pair X)
(eval X Ofs '("Nl" "Pre"))
(when (eval X Ofs '("Nl" "Pre"))
(xprin @) ) ) ) )
"N" (and Lst (atom (car Lst)) (eval (pop 'Lst) 1))
"Nn" NIL
"Nl" NIL
"Pre" NIL )
(when "N"
(do (abs "N")
(push '"Nn" (if (lt0 "N") "^I" " ")) ) )
(out Out
(when (and Lst (atom (car Lst)) (eval (pop 'Lst) 1))
(xml? T) )
(run Lst 1 '(<xml> xprin xrun "N" "Nn" "Nl" "Pre")) ) ) ) ) )
(de escXml (X)
(for C (chop X)
(prin (case C
("\"" """)
("&" "&")
("<" "<")
(">" ">")
(T C) ) ) ) )
# ~/lisp/picoLisp/p xml2.l xml2-test.l -bye
(de xmlTest (N Out Str . Prg)
(prinl "test " N " "
(if (= (chop Str)
(if Out
(pipe (run Prg 1)
(till) )
(run Prg 1) ) )
"OK"
"Fail" ) ) )
(xmlTest 1 T
"<text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text>"
(<xml>
(<xml> text id 123 dx (+ 3 4) dy (* 3 4) xx "you & me"
yy "<![CDATA[\"Me, Myself & <I>\"]]>"
(xprin "No font & color arguments yet") ) ) )
(xmlTest 2 T
"<hoy id=\"123\"><inner fun=\"abc\"/></hoy>"
(<xml>
(<xml> hoy id 123
(<xml> inner fun "abc") ) ) )
(xmlTest 3 T
"<hoy id=\"123\"><inner1/><text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you &
me\" yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font
& color arguments yet</text><inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line
x=\"0\" y=\"0\" dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2><inner3
fun=\"abc\"/></hoy>"
(<xml>
(<xml> hoy id 123
(<xml> inner1)
(<xml> text id 123 dx (+ 3 4) dy (* 3 4) xx "you & me"
yy "<![CDATA[\"Me, Myself & <I>\"]]>"
(ht:Prin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) )
(xmlTest 4 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\"><inner1/><text
id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\" yy=\"<![CDATA["Me,
Myself & <I>"]]>\">No font & color arguments
yet</text><inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\"
dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2><inner3 fun=\"abc\"/></hoy>"
(and 4
(<xml>
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) ) )
(xmlTest 5 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\" sym=\"Xml\" sym2=\"Lst\"
sym3=\"T\"><inner1/><text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text><inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line
x=\"0\" y=\"0\" dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2><inner3
fun=\"abc\"/></hoy>"
(and 4
(<xml>
(<xml> hoy id 123 class 'yes att "Xml" at @ sym 'Xml sym1 NIL sym2 'Lst
sym3 T
(<xml> inner1)
(<xml> text id 123 dx (+ 3 4) dy (* 3 4) xx "you & me"
yy "<![CDATA[\"Me, Myself & <I>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) ) )
(xmlTest 6 NIL
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\"><inner1/><text
id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\" yy=\"<![CDATA["Me,
Myself & <I>"]]>\">No font & color arguments
yet</text><inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\"
dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2><inner3 fun=\"abc\"/></hoy>"
(let F "/tmp/a"
(call "rm" "-f" F)
(and 4
(<xml> F
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) )
(in F
(till) ) ) )
(xmlTest 7 NIL
'(hoy ((id . 123) (class . yes) (att . "Xml") (at . 4)) (inner1) (text ((id
. 123) (dx . 7) (dy . 12) (xx . "you & me") (yy . "<![CDATA[\"Me, Myself &
<I>\"]]>")) "No font & color arguments yet") (inner2 ((fun . "abc")) "Hi 1
asfdlkasjhfdshad" (line ((x . 0) (y . 0) (dx . 100) (dy . 100)) "thick") "Hi
2") (inner3 ((fun . "abc"))))
(and 4
(<xml> T
(<xml> hoy id 123 class 'yes att "Xml" at @ sym1 NIL
(<xml> inner1)
(<xml> text id 123 dx (+ 3 4) dy (* 3 4) xx "you & me"
yy "<![CDATA[\"Me, Myself & <I>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) ) )
(xmlTest 8 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\">
<inner1/>
<text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text>
<inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\"
dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2>
<inner3 fun=\"abc\"/>
</hoy>"
(and 4
(<xml> NIL -1
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3 fun "abc") ) ) ) )
(xmlTest 9 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\">
<inner1/>
<text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text>
<inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\"
dx=\"100\" dy=\"100\">thick</line>Hi 2</inner2>
<inner3>
<inner3a>
<inner3a1/>
</inner3a>
</inner3>
<inner4 fun=\"abc\"/>
</hoy>"
(and 4
(<xml> NIL -1
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3
(<xml> inner3a
(<xml> inner3a1) ) )
(<xml> inner4 fun "abc") ) ) ) )
(xmlTest 10 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\"><inner1/><text
id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\" yy=\"<![CDATA["Me,
Myself & <I>"]]>\">No font & 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>"
(and 4
(<xml>
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick" @))
(xprin "Hi 2") )
(<xml> inner3
(<xml> inner3a
(<xml> inner3a1) ) )
(<xml> inner4 fun "abc") ) ) ) )
(xmlTest 11 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\">
<inner1/>
<text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text>
<inner2 fun=\"abc\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\" dx=\"100\"
dy=\"100\">thick</line>Hi 2</inner2>
<inner3>
<inner3a>
<inner3a1/>
</inner3a>
</inner3>
<inner4 fun=\"abc\"/>
</hoy>"
(and 4
(<xml> NIL 2
(<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>\"]]>"
(xprin "No font & color arguments yet") )
(<xml> inner2 fun "abc"
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100
(xprin "thick") )
(xprin "Hi 2") )
(<xml> inner3
(<xml> inner3a
(<xml> inner3a1) ) )
(<xml> inner4 fun "abc") ) ) ) )
(xmlTest 12 T
"<hoy id=\"123\" class=\"yes\" att=\"Xml\" at=\"4\">
<inner1/>
<text id=\"123\" dx=\"7\" dy=\"12\" xx=\"you & me\" at2=\"4\"
yy=\"<![CDATA["Me, Myself & <I>"]]>\">No font &
color arguments yet</text>
<inner2 fun=\"abc\" five=\"5\">Hi 1 asfdlkasjhfdshad<line x=\"0\" y=\"0\"
dx=\"100\" dy=\"100\" five2=\"5\">thickfive3=5</line>Hi 2</inner2>
<inner3>
<inner3a>
<inner3a1/>
</inner3a>
</inner3>
<inner4 fun=\"abc\"/>
</hoy>"
(and 4
(<xml> NIL 2
(<xml> hoy id 123 class 'yes att "Xml" at @ att Att lst Lst
(<xml> inner1)
(<xml> text id 123 dx (+ 3 4) dy (* 3 4) xx "you & me" at2 @
yy "<![CDATA[\"Me, Myself & <I>\"]]>"
(xprin "No font & color arguments yet") )
(and 5
(<xml> inner2 fun "abc" five @
(xprin "Hi 1 asfdlkasjhfdshad")
(<xml> line x 0 y 0 dx 100 dy 100 five2 @
(xprin "thick")
(xprin "five3=" @) )
(xprin "Hi 2") ) )
(<xml> inner3
(<xml> inner3a
(<xml> inner3a1) ) )
(<xml> inner4 fun "abc") ) ) ) )
(xmlTest 13 T
"<text id=\"123\" dx=\"7\"/>"
(<xml>
(<xml> text id 123 dx (+ 3 4) hi) ) )
(xmlTest 14 T
"<text id=\"123\" dx=\"7\">hi12345</text>"
(<xml>
(<xml> text id 123 dx (+ 3 4) NIL "hi" 1 2 3 (xprin 4) 5) ) )
(xmlTest 15 T
"<text id=\"123\" dx=\"7\">9hi12345</text>"
(let Hi 9
(<xml>
(<xml> text id 123 dx (+ 3 4) NIL Hi "hi" 1 2 3 (xprin 4) 5) ) ) )
(de <b> @
(<xml> b (pass xprin)) )
(xmlTest 16 T
"<text id=\"123\" dx=\"7\"><b>9hi153</b></text>"
(let Hi 9
(<xml>
(<xml> text id 123 dx (+ 3 4)
(<b> Hi "hi" 1 (+ 2 3) 3) ) ) ) )
(de <p> Prg
(<xml> p (xrun Prg)) )
(xmlTest 17 T
"<text id=\"123\" dx=\"7\"><p>9hi153<span>yes</span></p></text>"
(let Hi 9
(<xml>
(<xml> text id 123 dx (+ 3 4)
(<p> Hi "hi" 1 (xprin (+ 2 3)) 3
(<xml> span NIL "yes") ) ) ) ) )
(xmlTest 18 T
"<text id=\"123\" dx=\"7\">9hi1<hello two=\"2\" three=\"3\" four=\"4\"
end=\"\" five=\"5\">M</hello></text>"
(let Hi 9
(<xml>
(<xml> text id 123 dx (+ 3 4) NIL Hi "hi" 1
(<xml> hello two 2 T '((three . 3) (four . 4) (T . end)) five 5
NIL "M") ) ) ) )
(xmlTest 19 NIL
'(text ((id . 123) (dx . 7)) "9" "hi" "1"
(hello ((two . 2) (three . 3) (four . 4) (end . NIL) (five . 5)) "M"))
(let Hi 9
(<xml> T
(<xml> text id 123 dx (+ 3 4) NIL Hi "hi" 1
(<xml> hello two 2 T '((three . 3) (four . 4) (T . end)) five 5
NIL "M") ) ) ) )
# ~/lisp/picoLisp/p @lib/xml.l xml-my.l -bye
# output N: NIL => no line breaks, gt0 line breaks + spaces, lt0 linebreaks +
tabs
(de xml (Lst N)
(if Lst
(let (Nn NIL Nl NIL Pre NIL)
(when N
(do (abs N)
(push 'Nn (if (lt0 N) "^I" " ")) ) )
(xml_ Lst) )
(_xml) ) )
(de xml_ (Lst)
(let Tag (pop 'Lst)
(when Nl
(prinl)
(when Pre
(prin Pre) ) )
(prin "<" Tag)
(for X (pop 'Lst)
(prin " " (car X) "=\"")
(escXml (cdr X))
(prin "\"") )
(ifn Lst
(prin "/>")
(prin ">")
(use Nlx
(let (Nl N
Pre (cons Pre Nn) )
(for X Lst
(if (pair X)
(xml_ X)
(off Nl)
(escXml X) ) )
(setq Nlx Nl) )
(when Nlx
(prinl)
(when Pre
(prin Pre) ) ) )
(prin "</" Tag ">") ) ) )
(xml '(hoy ((id . 123) (class . yes) (att . "Xml") (at . 4)) (inner1) (text
((id . 123) (dx . 7) (dy . 12) (xx . "you & me") (yy . "<![CDATA[\"Me, Myself &
<I>\"]]>")) "No font & color arguments yet") (inner2 ((fun . "abc")) "Hi 1
asfdlkasjhfdshad" (line ((x . 0) (y . 0) (dx . 100) (dy . 100)) "thick") "Hi
2") (inner3 ((fun . "abc"))) (inner4 ((fun . "abc")) (inner4a NIL (inner4a1)
(inner4a2 NIL NIL)))) 2)
# $ ~/lisp/picoLisp/p @lib/xml.l xml-my.l -bye
# # xml redefined
# <hoy id="123" class="yes" att="Xml" at="4">
# <inner1/>
# <text id="123" dx="7" dy="12" xx="you & me"
yy="<![CDATA["Me, Myself & <I>"]]>">No font & color
arguments yet</text>
# <inner2 fun="abc">Hi 1 asfdlkasjhfdshad<line x="0" y="0" dx="100"
dy="100">thick</line>Hi 2</inner2>
# <inner3 fun="abc"/>
# <inner4 fun="abc">
# <inner4a>
# <inner4a1/>
# <inner4a2></inner4a2>
# </inner4a>
# </inner4>
# </hoy>
