Changes in XML prettyprinter
parent
e37ccf190e
commit
99172b6f79
|
@ -1,8 +1,32 @@
|
|||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces kernel ;
|
||||
USING: namespaces kernel assocs sequences ;
|
||||
IN: xml.entities
|
||||
|
||||
: entities-out
|
||||
H{
|
||||
{ CHAR: < "<" }
|
||||
{ CHAR: > ">" }
|
||||
{ CHAR: & "&" }
|
||||
} ;
|
||||
|
||||
: quoted-entities-out
|
||||
H{
|
||||
{ CHAR: & "&" }
|
||||
{ CHAR: ' "'" }
|
||||
{ CHAR: " """ }
|
||||
} ;
|
||||
|
||||
: 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
|
||||
H{
|
||||
{ "lt" CHAR: < }
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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
|
||||
|
||||
SYMBOL: xml-pprint?
|
||||
|
@ -13,10 +13,11 @@ SYMBOL: indenter
|
|||
: sensitive? ( tag -- ? )
|
||||
sensitive-tags get swap [ names-match? ] curry contains? ;
|
||||
|
||||
: indent-string ( -- string )
|
||||
indentation get indenter get <repetition> concat ;
|
||||
|
||||
: ?indent ( -- )
|
||||
xml-pprint? get [
|
||||
nl indentation get indenter get <repetition> [ write ] each
|
||||
] when ;
|
||||
xml-pprint? get [ nl indent-string write ] when ;
|
||||
|
||||
: indent ( -- )
|
||||
xml-pprint? get [ 1 indentation +@ ] when ;
|
||||
|
@ -35,30 +36,6 @@ SYMBOL: indenter
|
|||
[ dup empty? swap string? and not ] subset
|
||||
] when ;
|
||||
|
||||
: entities-out
|
||||
H{
|
||||
{ CHAR: < "<" }
|
||||
{ CHAR: > ">" }
|
||||
{ CHAR: & "&" }
|
||||
} ;
|
||||
|
||||
: quoted-entities-out
|
||||
H{
|
||||
{ CHAR: & "&" }
|
||||
{ CHAR: ' "'" }
|
||||
{ CHAR: " """ }
|
||||
} ;
|
||||
|
||||
: 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 -- )
|
||||
dup name-space f like
|
||||
[ write CHAR: : write1 ] when*
|
||||
|
@ -76,10 +53,11 @@ SYMBOL: indenter
|
|||
GENERIC: write-item ( object -- )
|
||||
|
||||
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 -- )
|
||||
CHAR: < write1
|
||||
?indent CHAR: < write1
|
||||
dup print-name tag-attrs print-attrs ;
|
||||
|
||||
M: contained-tag write-item
|
||||
|
@ -87,7 +65,7 @@ M: contained-tag write-item
|
|||
|
||||
: write-children ( tag -- )
|
||||
indent tag-children ?filter-children
|
||||
[ ?indent write-item ] each unindent ;
|
||||
[ write-item ] each unindent ;
|
||||
|
||||
: write-end-tag ( tag -- )
|
||||
?indent "</" write print-name CHAR: > write1 ;
|
||||
|
@ -112,7 +90,7 @@ M: instruction write-item
|
|||
"<?xml version=\"" write dup prolog-version write
|
||||
"\" encoding=\"" write dup prolog-encoding write
|
||||
prolog-standalone [ "\" standalone=\"yes" write ] when
|
||||
"\"?>\n" write ;
|
||||
"\"?>" write ;
|
||||
|
||||
: write-chunk ( seq -- )
|
||||
[ write-item ] each ;
|
||||
|
|
Loading…
Reference in New Issue