steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changes in XML prettyprinter

db4
Daniel Ehrenberg 2008-01-30 15:03:02 -06:00
parent e37ccf190e
commit 99172b6f79
2 changed files with 35 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/xml/entities/entities.factor
View File

@ -1,8 +1,32 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg ! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel ; USING: namespaces kernel assocs sequences ;
IN: xml.entities IN: xml.entities
: entities-out
H{
{ CHAR: < "&lt;" }
{ CHAR: > "&gt;" }
{ CHAR: & "&amp;" }
} ;
: quoted-entities-out
H{
{ CHAR: & "&amp;" }
{ CHAR: ' "&apos;" }
{ CHAR: " "&quot;" }
} ;
: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
[ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
: escape-string ( str -- newstr )
entities-out escape-string-by ;
: escape-quoted-string ( str -- newstr )
quoted-entities-out escape-string-by ;
: entities : entities
H{ H{
{ "lt" CHAR: < } { "lt" CHAR: < }

42
extra/xml/writer/writer.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg ! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables kernel math namespaces sequences strings USING: hashtables kernel math namespaces sequences strings
io io.streams.string xml.data assocs ; io io.streams.string xml.data assocs wrap xml.entities ;
IN: xml.writer IN: xml.writer
SYMBOL: xml-pprint? SYMBOL: xml-pprint?
@ -13,10 +13,11 @@ SYMBOL: indenter
: sensitive? ( tag -- ? ) : sensitive? ( tag -- ? )
sensitive-tags get swap [ names-match? ] curry contains? ; sensitive-tags get swap [ names-match? ] curry contains? ;
: indent-string ( -- string )
indentation get indenter get <repetition> concat ;
: ?indent ( -- ) : ?indent ( -- )
xml-pprint? get [ xml-pprint? get [ nl indent-string write ] when ;
nl indentation get indenter get <repetition> [ write ] each
] when ;
: indent ( -- ) : indent ( -- )
xml-pprint? get [ 1 indentation +@ ] when ; xml-pprint? get [ 1 indentation +@ ] when ;
@ -35,30 +36,6 @@ SYMBOL: indenter
[ dup empty? swap string? and not ] subset [ dup empty? swap string? and not ] subset
] when ; ] when ;
: entities-out
H{
{ CHAR: < "&lt;" }
{ CHAR: > "&gt;" }
{ CHAR: & "&amp;" }
} ;
: quoted-entities-out
H{
{ CHAR: & "&amp;" }
{ CHAR: ' "&apos;" }
{ CHAR: " "&quot;" }
} ;
: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
[ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
: escape-string ( str -- newstr )
entities-out escape-string-by ;
: escape-quoted-string ( str -- newstr )
quoted-entities-out escape-string-by ;
: print-name ( name -- ) : print-name ( name -- )
dup name-space f like dup name-space f like
[ write CHAR: : write1 ] when* [ write CHAR: : write1 ] when*
@ -76,10 +53,11 @@ SYMBOL: indenter
GENERIC: write-item ( object -- ) GENERIC: write-item ( object -- )
M: string write-item M: string write-item
escape-string write ; escape-string xml-pprint? over empty? not and
[ nl 80 indent-string indented-break ] when write ;
: write-tag ( tag -- ) : write-tag ( tag -- )
CHAR: < write1 ?indent CHAR: < write1
dup print-name tag-attrs print-attrs ; dup print-name tag-attrs print-attrs ;
M: contained-tag write-item M: contained-tag write-item
@ -87,7 +65,7 @@ M: contained-tag write-item
: write-children ( tag -- ) : write-children ( tag -- )
indent tag-children ?filter-children indent tag-children ?filter-children
[ ?indent write-item ] each unindent ; [ write-item ] each unindent ;
: write-end-tag ( tag -- ) : write-end-tag ( tag -- )
?indent "</" write print-name CHAR: > write1 ; ?indent "</" write print-name CHAR: > write1 ;
@ -112,7 +90,7 @@ M: instruction write-item
"<?xml version=\"" write dup prolog-version write "<?xml version=\"" write dup prolog-version write
"\" encoding=\"" write dup prolog-encoding write "\" encoding=\"" write dup prolog-encoding write
prolog-standalone [ "\" standalone=\"yes" write ] when prolog-standalone [ "\" standalone=\"yes" write ] when
"\"?>\n" write ; "\"?>" write ;
: write-chunk ( seq -- ) : write-chunk ( seq -- )
[ write-item ] each ; [ write-item ] each ;