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