package xm::pfe::xdefdoc;
use strict;
use xm::o;
use xm::sub;

sub DESC
{"
  will look for some CDOC-comments introduced with '/**' ... this
  one is only for pfe - it will only recognize those enclosed by
  <ITEMXDOC> and <CDCLFCODE>
"}

sub format_forth_callscheme
{
    return "" if not defined $_[0] or $_[0] =~ /^\s*$/;
    # for now, keep it just simple...
    return "<XDEFSTACK>".$_[0]."</XDEFSTACK>";
}

sub format_after_callscheme
{
    return "<XDEFXTRA>".$_[0]."</XDEFXTRA>" if $_[0] !~ /^\s*$/;
    return $_[0];
}

sub format_xdef
{
    if ($_[0] =~ /^(\".*\")$/)
    {
	my $v = $1;
	$v = xm::sub::C($v);
	$v =~ s/<([^<>]*)>/&lt;$1&gt;/;
	$v =~ s/<([^<>]*)>/&lt;$1&gt;/;
	$v =~ s/\"/&quot;/g;
	return " <XDEF>".$v."</XDEF> ";
    }
    if ($_[0] =~ /^(\'.*\')$/)
    {
	my $v = $1;
	$v = xm::sub::C($v);
	$v =~ s/<([^<>]*)>/&lt;$1&gt;/;
	$v =~ s/<([^<>]*)>/&lt;$1&gt;/;
	$v =~ s/\"/&quot;/g;
	return " <XDEF>".$v."</XDEF> ";
    }
    return "<XDEF>".$_[0]."</XDEF>";
}

sub format_fcode
{
    my $in = $_[0];

    my ($a,$b,$c,$d,$e,$f);
    
    $in =~ s{ (^\/\*\*) ([\ \t]+) ([^\"\'\s]\S*|\'[^\']*\'|\"[^\"]*\") 
		  ([\ \t]*) (\([^\(\)]*\))? (.*) }
    {
	($a,$b,$c,$d,$e,$f) = ($1,$2,$3,$4,$5,$6);
	"<XDEFDOC>"."\/\*<XDEFSTART>\*</XDEFSTART>".$b
	    .format_xdef($c).$d
		.format_forth_callscheme($e)
		    .format_after_callscheme($f)
			."</XDEFDOC>"
    }gmex;

    return $in;
}


sub DO
{
    my $in = shift;

    $in =~ s{ (<CDCLFCODE(?:\s[^<>]*)?>(?:<[^<>]*>)*) 
		  (\/\*\*(?:.(?!</?CDCLFCODE[\s>]))*.) 
		      (</CDCLFCODE(?:\s[^<>]*)?>) 
		} 
            { $1.format_fcode($2).$3
            }gsex;

    $in =~ s{ (<ITEMXDOC>(?:<[^<>]*>)*) 
		  (\/\*\*(?:.(?!</?ITEMXDOC[\s>]))*.) 
		      (</ITEMXDOC(?:\s[^<>]*)?>)
		} 
            { $1.format_fcode($2).$3
            }gsex;
   
    return $in;
}

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

1;