package xm::pfe::grabfcode;
use strict;
use xm::o;

sub DESC
{"
  will look for a CDOC-comment followed by 'FCode' and a symbol-name
  in round braces. Simply mark the 'FCode' with <CDCLFCODE> for later
  lookups. (or will look for CDCL containing an FCode statement)
"}

sub may_be_id
{
    my ($a,$b) = @_;
    return "<id=\"".$a."-fcode\">" if $b =~ /\<CBLK|\{/;
    return "";
}


sub DO
{
    my $in = shift;

    $in =~ s{ <CDOC(\s[^<>]*)?> ((?:.(?!</?CDOC[\s>]))*.) </CDOC(\s[^<>]*)?> 
		  (\s*(?:<CDCL>)?\s*)
              ((?:[a-z]+\s+)* FCode) 
		  (\s*\(\s*) (\w+) (\s*\)\s*(?:</CDCL>)?\s*) 
		([\;\{]|<CBLK[\s>]) } 
            { "<CDCLFCODE>".may_be_id($7,$9)
              ."<CDOCFCODE$1>".$2."</CDOCFCODE$3>".$4
              ."<TYPEFCODE>".$5."</TYPEFCODE>".$6
              ."<NAMEFCODE>".$7."</NAMEFCODE>".$8
              ."</CDCLFCODE>".$9 }gsex;

    # other CDEFS 
    $in =~ s{ <CDCL(\s[^<>]*)?>
              ((?:\w+\s+)* FCode) (\s*\(\s*) (\w+) (\s*\)\s*) 
		  </CDCL(\s[^<>]*)?> } 
            { "<CDCLFCODE$1>"
              ."<TYPEFCODE>".$2."</TYPEFCODE>".$3
              ."<NAMEFCODE>".$4."</NAMEFCODE>".$5
              ."</CDCLFCODE$6>" }gsex;
   
    return $in;
}

sub ARGS { return    xm::o::args_stdin(@_,DESC); }
sub main { return DO(xm::o::args_stdin(@_,DESC)); }

1;