1 ! Copyright (C) 2006, 2007 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces kernel xml.data xml.utilities assocs splitting
4 sequences parser lexer quotations sequences.lib xml.utilities ;
7 : comment, ( string -- ) <comment> , ;
8 : directive, ( string -- ) <directive> , ;
9 : instruction, ( string -- ) <instruction> , ;
12 : (tag,) ( name attrs quot -- tag )
13 -rot >r >r V{ } make r> r> rot <tag> ; inline
14 : tag*, ( name attrs quot -- )
17 : contained*, ( name attrs -- )
20 : tag, ( name quot -- ) f swap tag*, ; inline
21 : contained, ( name -- ) f contained*, ; inline
23 : make-xml* ( name attrs quot -- xml )
24 (tag,) build-xml ; inline
25 : make-xml ( name quot -- xml )
26 f swap make-xml* ; inline
28 ! Word-based XML literal syntax
29 : parsed-name ( accum -- accum )
30 scan ":" split1 [ f <name> ] [ <name-tag> ] if* parsed ;
32 : run-combinator ( accum quot1 quot2 -- accum )
33 >r [ ] like parsed r> [ parsed ] each ;
35 : parse-tag-contents ( accum contained? -- accum )
36 [ \ contained*, parsed ] [
38 [ POSTPONE: [ \ tag*, parsed ]
39 [ "Expected [ missing" throw ] if
44 : attributes-parsed ( accum quot -- accum )
45 dup empty? [ drop f parsed ] [
46 >r \ >r parsed r> parsed
47 [ H{ } make-assoc r> swap ] [ parsed ] each
52 \ >> parse-until >quotation
53 attributes-parsed \ contained? get
54 ] with-scope parse-tag-contents ; parsing
57 \ call parsed parsed-name \ set parsed ; parsing
60 \ contained? on ; parsing
62 : parse-special ( accum end-token word -- accum )
63 >r parse-tokens " " join parsed r> parsed ;
65 : <!-- "-->" \ comment, parse-special ; parsing
67 : <! ">" \ directive, parse-special ; parsing
69 : <? "?>" \ instruction, parse-special ; parsing
71 : >xml-document ( seq -- xml )
72 dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap
73 [ tag? ] split-around <xml> ;
78 \ XML> [ >quotation ] parse-literal
79 { } parsed \ make parsed \ >xml-document parsed ; parsing