[Gd-chatter] r10777 - trunk/libraries/xml-parser

[turbo24prg at gwydiondylan.org]

Author: turbo24prg
Date: Sun Jun  4 10:23:39 2006
New Revision: 10777

Added:
   trunk/libraries/xml-parser/stream-parser.dylan   (contents, props changed)
Modified:
   trunk/libraries/xml-parser/library.dylan
   trunk/libraries/xml-parser/simple-xml.dylan
   trunk/libraries/xml-parser/xml-parser.lid
Log:
Bug: 7306
* stream-parser draft


Modified: trunk/libraries/xml-parser/library.dylan
==============================================================================
--- trunk/libraries/xml-parser/library.dylan	(original)
+++ trunk/libraries/xml-parser/library.dylan	Sun Jun  4 10:23:39 2006
@@ -9,6 +9,7 @@
   use system, import: { file-system };
 
   export xml-parser,
+    xml-stream-parser,
     simple-xml,
     %productions,
     printing;
@@ -20,7 +21,7 @@
   create <document>, <element>, <node-mixin>, <attribute>, <xml>, <processing-instruction>,
     <entity-reference>, <add-parents>, <char-reference>, <comment>, <tag>,
     <char-string>, <dtd>, <internal-entity>, <external-entity>,
-    text, text-setter, name, name-setter, name-with-proper-capitalization,
+    text, text-setter, unfiltered-text, name, name-setter, name-with-proper-capitalization,
     root, char;
 
   create entity-value, attributes, attributes-setter, *dtd-paths*,
@@ -139,4 +140,16 @@
     real-name,
     start-tag;
     
-end module printing;
+end module simple-xml;
+
+define module xml-stream-parser
+  use common-dylan;
+  use common-extensions;
+  use streams;
+  use xml-parser;
+  use %productions;
+
+  export <xml-stream-parser>,
+    stream, stream-setter, parse;
+    
+end module xml-stream-parser;

Modified: trunk/libraries/xml-parser/simple-xml.dylan
==============================================================================
--- trunk/libraries/xml-parser/simple-xml.dylan	(original)
+++ trunk/libraries/xml-parser/simple-xml.dylan	Sun Jun  4 10:23:39 2006
@@ -221,11 +221,13 @@
           end, element.node-children);
 end method elements;
 
-define open generic add-element (element :: <element>, node :: <element>);
-define method add-element (element :: <element>, node :: <element>) 
+define open generic add-element (element :: <element>, node :: <xml>);
+define method add-element (element :: <element>, node :: <xml>) 
  => (res :: <element>);
   element.node-children := add(element.node-children, node);
-  node.element-parent := element;
+  if (object-class(node) = <element>)
+    node.element-parent := element;
+  end if;
   element;
 end method add-element;
 

Added: trunk/libraries/xml-parser/stream-parser.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/xml-parser/stream-parser.dylan	Sun Jun  4 10:23:39 2006
@@ -0,0 +1,93 @@
+module: xml-stream-parser
+synopsis: 
+author: 
+copyright:
+
+define class <xml-stream-parser> (<object>)
+  slot stream :: <stream>,
+    required-init-keyword: stream:;
+  slot opened-elements :: <deque> = make(<deque>);
+  slot text-buffer :: <string> = "";
+  slot tag-buffer :: <string> = "";
+  slot parsing-tag? :: <boolean> = #f;
+  slot parsing-root? :: <boolean> = #f;
+end class <xml-stream-parser>;
+
+define method parse (parser :: <xml-stream-parser>)
+  while (~ stream-at-end?(parser.stream))
+    let received = read-element(parser.stream);
+
+    dispatch(parser, received, parser.parsing-tag?, parser.parsing-root?);
+  end while;
+end method parse;
+
+define generic dispatch (parser :: <xml-stream-parser>, char :: <character>, in-tag? :: <boolean>, in-root? :: <boolean>) => ();
+
+define method dispatch (parser :: <xml-stream-parser>, char == '<', in-tag? == #f, in-root? :: <boolean>) => ();
+  parser.parsing-tag? := #t;
+  parser.tag-buffer := add!(parser.tag-buffer, char);
+end method;
+
+define method dispatch (parser :: <xml-stream-parser>, char == '<', in-tag? == #f, in-root? == #t) => ();
+///!!! signal (text)
+///??? even if only whitespaces?
+  parser.text-buffer := "";
+  next-method();
+end method;
+
+define method dispatch (parser :: <xml-stream-parser>, char :: <character>, in-tag? == #f, in-root? == #f) => ();
+  if (~ whitespace?(char))
+//!!! error (chars outside root element)
+  end if;
+end method;
+
+define method dispatch (parser :: <xml-stream-parser>, char :: <character>, in-tag? == #f, in-root? == #t) => ();
+  parser.text-buffer := add!(parser.text-buffer, char);
+end method;
+ 
+define method dispatch (parser :: <xml-stream-parser>, char :: <character>, in-tag? == #t, in-root? :: <boolean>) => ();
+  if (~ whitespace?(char))
+    parser.tag-buffer := add!(parser.tag-buffer, char);
+  end if;
+end method;
+
+define method dispatch (parser :: <xml-stream-parser>, char == '>', in-tag? == #t, in-root? :: <boolean>) => ();
+  next-method();
+
+  block (skip-next)
+    let (index, start-tag, attributes, opened-element?) = scan-start-tag(parser.tag-buffer);
+    if (start-tag)
+      if (opened-element?) push-last(parser.opened-elements, start-tag) end if;
+//!!! call handle-start-tag (start-tag, attributes, opened-element?)
+      skip-next();
+    end if;
+    
+    let (index, end-tag) = scan-end-tag(parser.tag-buffer);
+    if (end-tag)
+      if (as(<symbol>, end-tag) ~= last(parser.opened-elements))
+//!!! error (tag mismatch)
+      else
+        pop-last(parser.opened-elements);
+//!!! call handle-end-tag (end-tag)
+      end if;
+      skip-next();
+    end if;
+
+    let (index, processing-instruction) = scan-xml-decl(parser.tag-buffer);
+    if (processing-instruction)
+//!!! call handle-processing-instruction (processing-instruction)
+      skip-next();
+    end if;
+  end block;
+  parser.tag-buffer := "";
+  parser.parsing-tag? := #f;
+end method;
+
+define method whitespace? (char :: <character>) 
+ => (res :: <boolean>);
+  instance?(char, one-of('\n', '\t', '\r'))
+end method whitespace?;
+
+define method handle-tag-start (parser :: <xml-stream-parser>, name :: <symbol>, attributes :: <sequence>)
+  
+end method handle-tag-start;

Modified: trunk/libraries/xml-parser/xml-parser.lid
==============================================================================
--- trunk/libraries/xml-parser/xml-parser.lid	(original)
+++ trunk/libraries/xml-parser/xml-parser.lid	Sun Jun  4 10:23:39 2006
@@ -7,3 +7,4 @@
 	collect
 	productions
 	simple-xml
+  stream-parser