source: to-imperative/trunk/java/refal/refal/plus/XML.rf @ 3964

$module "refal.plus.XML";

$use Convert Stream StdIO;

$func? IsBlank t.term = ;
IsBlank \{ ' '; '\n'; '\r'; '\t'; };

$func? IsBlankOrDelim t.delim t.term = ;
IsBlankOrDelim t.delim t.term, t.term : \{ ' '; '\n'; '\r'; '\t'; t.delim; };

$func GetDelims s.stream t.delim = e.expr; // no e.delim at the end
GetDelims s.stream t.delim = 
  GO $iter {
    <Get_While s.stream &IsBlank> :: e, {
      <Scanc s.stream t.delim> : v = e.expr STOP;
      <Get_Until s.stream &IsBlankOrDelim t.delim> : v.head = e.expr ' ' v.head GO;
      e.expr STOP;
    };
  } :: e.expr s.flag, s.flag : STOP =
  { e.expr : ' ' e.head = e.head; e.expr; };

$func? GetXMLFormat s.stream = e.comment;

GetXMLFormat s.stream,
  <Scans s.stream '<?'> : '<?' =
  <Get_Delims s.stream '?>'> : e.format '?>',
  '<?' e.format '?>';


$func? GetComment s.stream = e.comment;

GetComment s.stream,
  <Scans s.stream '<!--'> : '<!--' =
  <Get_Delims s.stream '-->'> : e.comment '-->',
  '<!--' e.comment '-->';

$func? GetCDATA s.stream = e.cdata;

GetCDATA s.stream,
  <Scans s.stream '<![CDATA['> : '<![CDATA[' =
  <Get_Delims s.stream ']]>'> : e.cdata ']]>',
  '<![CDATA[' e.cdata ']]>';

$func? GetTag s.stream = e.text (e.tag);

GetTag s.stream =
  <GetDelims s.stream '<'> :: e.text,
  //<Get_Delim s.stream '<'> : e.text '<',
  <Ungets s.stream '<'>, {
    <GetXMLFormat s.stream> : '<?' e.format '?>',
      e.text ((XML_FORMAT) e.format) <GetTag s.stream>;
    <GetComment s.stream> : '<!--' e.comment '-->',
      e.text ((COMMENT) e.comment) <GetTag s.stream>;
    <GetCDATA s.stream> : '<![CDATA[' e.cdata ']]>',
      e.text ((CDATA) e.cdata) <GetTag s.stream>;
    e.text (<GetDelims s.stream '>'> '>');
    //e.text (<Get_Delim s.stream '>'>);
  };

$func SplitAttrs e = e;
SplitAttrs e.attrs,
  () (e.attrs) $iter {
    e.attrs : e.key '=' '"' e.value '"' e.tail =
      { e.tail : ' ' e.tail1 = e.tail1; e.tail; } :: e.tail,      
      (e.keyvalues (<ToWord e.key> <ToWord e.value> )) (e.tail);
  } :: (e.keyvalues) (e.attrs),
  e.attrs : /* empty */ =
  e.keyvalues;

$func SplitName e = (e) e;

SplitName {
  e.name ' ' e.attrs = (e.name) <SplitAttrs e.attrs>; 
  e.name = (e.name); 
};

$func? ReadTag s.stream e.tag = t;

ReadTag s.stream e.tag, e.tag : {
  '<' e.name '/>' =
    <SplitName e.name> :: (e.name) e.attrs, 
    (<ToWord e.name> ((ATTRIBUTES) e.attrs));
  '<' e.name '>' =
    <SplitName e.name> :: (e.name) e.attrs,
    <GetTag s.stream> $iter e.text <ReadTag s.stream e.tag> <GetTag s.stream> :: e.text (e.tag),
    e.tag : '</' e.name '>',
    (<ToWord e.name> ((ATTRIBUTES) e.attrs) e.text);
};

$public $func? Read s = e;

Read s.stream = <GetTag s.stream> : e.text (e.tag), e.text <ReadTag s.stream e.tag>;

$func Main = e;

Main =
  <WriteLn <Read <Expr_Open '<Z>as<C/><B>b<!--<Z></Z>--></B><C>c</C></Z>'>>>;