package xm::css::mkhtml;
use strict;
use xm::o;
use xm::css::sheet;
use xm::css::find;

sub DESC {"
  the primary output stream is converted to html4-style, that is
  we provide a header and footer and may include a css-stylesheet,
  that can be given as -css=file. If the input contains xm-format
  markups in all-uppercase, they are always converted to font-classes
  whose outline can be given in the css-stylesheet.

   note: with the uppercase-notion, this perlcode does not need to have 
   any special knowledge about the html-outline of the markups in use.
   
  special extension: 
      if the .css contains declarations of the form 
          pre.FORMAT { ... background-color: ... }
      then a <pre>-section is generated instead of a <span>-section and
      the <pre>-section is surrounded by a 100\%-table with background
      given in the pre... (netscape4 does loose with nested-<pre>s when
      somewhere there was a <td>s with a class).
"}

sub body
{
    local $_ = shift;
    my $css = shift;
    my $used = shift; $used = { } if not defined $used;
    
    # first the combiners

    s{ ((<\w+=[^<>]*>)+) } { my $v = $1; $v =~ s/<>/ /; $v }gsex;
    s{ ((</\w+=[^<>]*>)+) } { my $v = $1; $v =~ s/<>/ /; $v }gsex;
    s{ <([A-Z]+\d*)><(\w+=[^<>]*)> } { "<$1: $2>" }gsex;
    s{ <([A-Z]+\d*)/><(\w+=[^<>]*)> } { "<$1: $2/>" }gsex;
    s{ </(\w+=[^<>]*)><(/[A-Z]+\d*)> } { "<$2: $1>" }gsex;

    # any attribute left alone?
    s{ </?(\w+=[^<>]*)> } { "<!-- $1 -->" }gsex;

    # last the spans...
    my ($a,$k,$r,$m);
  
    s{ <([A-Z]+\d*)(>|: [^<>]*>) } 
    { 
	$k = $1;
        $a = $2; 
	$a =~ s/^://;
        $$used{$k} = 1;
	$r = "<span class=\"$k\"".$a;

	# print STDERR "look for no-span markups [$css]";
	if (exists $$css{$k} and length $$css{$k}{_markup})
        {
	    $m = $$css{$k}{_markup}; $m =~ s{\.}{><}gs;
	    $r = "<".$m." class=\"$k\"".$a; # the default

	    # some specials
	    if (exists $$css{$k}{xm})
	    {
		if ($$css{$k}{xm} eq "table")
		{
		    $r = "<table";
		    if (exists $$css{$k}{"width"})
		    {
			$r .= " width=\"".$$css{$k}{"width"}."\"";
		    }else{
			$r .= " width=\"100%\"";
		    }
		    $r .= " bgcolor=\"".$$css{$k}{"background-color"}."\""
		        if exists $$css{$k}{"background-color"};
		    $r .= "><tr><td><$m class=\"$k\"".$a;
		}else{
		    $r = "<".$m."><".$$css{$k}{xm}." class=\"$k\"".$a;
		}
	    }
        };
	$m = ""; 
	while ($a =~ /\sid=(\w+|\"[^\"]*\")(?=[>|\s])/sg)
	{ $m .= "<a name=$1 />" }
	$m.$r
    }gsex;
    
    s{ </([A-Z]+\d*)(>|: [^<>]*>) } 
    { 
	$k = $1; 
        $$used{$k} = 1;
	$r = "</span>";

	# look for no-span markups
	if (exists $$css{$k} and length $$css{$k}{_markup})
        {
	    $r = $$css{$k}{_markup} ."."; 
	    $m = "";
	    $r =~ s{([\w+\-]+)\.}{ $m = $1.".".$m; "" }gsex;
	    $m =~ s{\.$} {}; $m =~ s{\.}{></}gs;
	    $r = "</".$m.">";

	    # the table-special
	    if (exists $$css{$k}{xm})
	    {
		if ($$css{$k}{xm} eq "table")
		{
		    $r = "</".$m."></td></tr></table>";
		}else{
		    $r = "</".$$css{$k}{xm}."></".$m.">";
		}
	    }
        };
	$r
    }gsex;

	return $_;
}

sub DO
{
    my $files = shift;
    $main::package = $0 if not defined $main::package;
    $o{css} = $main::package if not exists $o{css};

    my $F;
    for $F (@$files)
    {
        my $css = { };
        my $txt;
        my $used = { 
	    "/body" => 1, 
	    "/a:link" => 1, 
	    "/a:visited" => 1, 
	    "/a:active" => 1 
	    };
        $css = xm::css::find::fileandload($F,$o{css});
	die "no css found" if (!defined $css);

        if (open F,"<$F")
        {
            $txt = join("",<F>);
            close F;
        }

        $F =~ s/\.$o{ext}// if exists $o{ext};
        $F .= ".html";
        
        # print STDERR "<in:",length $txt,">";
        $txt = xm::css::mkhtml::body($txt,$css,$used);
        # print STDERR "<out:",length $txt,">";
        
        while ($txt =~ m{ \< (\/\w\w+) \> }gsx) 
	{ $$used{$1} = 1;  }
        while ($txt =~ m{ \<[^<>]* \s class=(\w+) (\>|\s[^<>]*\>) }gsx)
	{ $$used{$1} = 1;  }
        while ($txt =~ m{ \<[^<>]* \s class=\"(\w+)\" (\>|\s[^<>]*\>) }gsx) 
	{ $$used{$1} = 1;  }
        
        my $head = "";
        $txt  =~ s{ (\<meta\b (?:\s+\w+=\"[^\"<>]*\")+ \s*/?>)\s? } 
	{ $head .= $1."\n"; "" }gsex;

        my $pre = "";
        $head =~ s{ \<meta\b \s+name=\"[Ss]ubject\" 
			\s+content=\"([^\"<>]*)\" \s*/?>\s? } 
	{ $pre = "<title>".$1."</title>\n"; $& }gsex;
        $head =~ s{ \<meta\b \s+name=\"[Tt]itle\" 
			\s+content=\"([^\"<>]*)\" \s*/?>\s? } 
	{ $pre = "<title>".$1."</title>\n"; "" }gsex;
        $head = $pre.$head;
        
        if (length $css) { 
            my $date = `date`; chomp($date);
            my $usedcss = xm::css::sheet::assheetuse($css,$used);
            $head .= "<meta name=\"generator\" content=\"".$main::package
		."\" date=\"".$date."\" />\n";
            $head .= "<style>\n".$usedcss."\n</style>\n" 
		if length $usedcss; 
        }
       
        if (open F, ">$F")
        {
            print F "<html><head>\n",$head;
            print F "</head><body>\n";
            print F "<pre>" if defined $o{pre};
            print F $txt;
            print F "</pre>" if defined $o{pre};
            print F "\n</body></html>";
        }
    }
}

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

1;
								      1;