package xm::css::mkhtml4;
use strict;
use xm::o;
use xm::css::sheet;
use xm::css::find;
use xm::xhtml;

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;
    my $xhtml = "xhtmldef"; # index to $xm{xhtml}{..}
    $xhtml = "xhtmlbasic" if exists $o{xhtmlbasic};

    print STDERR "<!xhtml missing ", scalar %{$xm{"xhtml"}{$xhtml}}," !>"
	if not exists $xm{xhtml}{$xhtml}{pre};

#    "1", ${$xm{xhtml}{$xhtml}}{pre},
#    "1", ${$xm{xhtml}{$xhtml}}{pre},
#    "1", ${$xm{xhtml}{$xhtml}}{pre},
#    "1", ${$xm{xhtml}{$xhtml}}{pre},
#    "1", ${$xm{xhtml}{$xhtml}}{pre};
    
    # first the combiners
    s{ ((<\w+=[^<>]*>)+) } { my $v = $1; $v =~ s/<>/ /; $v }gsex;
    s{ ((</\w+=[^<>]*>)+) } { my $v = $1; $v =~ s/<>/ /; $v }gsex;
    s{ <(\w[\w.:-]*)><(\w+=[^<>]*)> } { "<$1 $2>" }gsex;
    s{ <(\w[\w.:-]*)/><(\w+=[^<>]*)> } { "<$1 $2/>" }gsex;
    s{ </(\w+=[^<>]*)><(/\w[\w.:-]*)> } { "<$2 $1>" }gsex;

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

    # last the spans...
    my ($a,$k,$r,$m);

    s{ <(\w[\w.:-]*)([^<>]*)> } 
    { 
	$k = $1;
        $a = $2; 

	if (exists $xm{xhtml}{$xhtml}{$k})
	{
	    $r = "<".$k.$a.">"; # leave xhtml tags as they are 
	    $r =~ s/>$/ \/>/ if $xm{xhtml}{$xhtml}{$k} == 1 and $a !~ /\/$/;
	    $$used{"/$k"} = 1;
	}else{
	    $$used{$k} = 1;

	    $m = "span";
	    if (exists $$css{$k} and exists $$css{$k}{_markup} 
		and $$css{$k}{_markup} !~ /^\s*$/)
	    { $m = $$css{$k}{_markup}; $m =~ s{\.}{><}gs; }

	    $r = "<".$m." class=\"$k\"".$a.">";

	    if (exists $$css{$k})
	    {
		my $class = " class=\"$k\"";

		if ($r =~ /<(table|tr|td)\b/)
		{
		    $class .= " width=\"".$$css{$k}{"width"}."\""
			if exists $$css{$k}{"width"};
		    $class .= " bgcolor=\"".$$css{$k}{"background-color"}."\""
			if exists $$css{$k}{"background-color"};
		    $class .= " cellspacing=\""
			.$$css{$k}{"border-spacing"}."\""
			if exists $$css{$k}{"border-spacing"};
		}

		if (exists $$css{$k}{set})
		{
		    $class .= " ".$$css{$k}{set};
		}
			
		$r = "<".$m.$class.$a.">";

		#  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 .= " cellspacing=\""
			    .$$css{$k}{"border-spacing"}."\""
			    if exists $$css{$k}{"border-spacing"};
			$r .= "><tr><td><$m class=\"$k\"".$a.">";
		    }
		    elsif ($$css{$k}{xm} eq "into")
		    {
			$r = "<".$m.$class.$a.">";
		    }
		    elsif ($$css{$k}{xm} eq "hidden")
		    {
			$r .= "<!-- ";
		    }
		    elsif ($$css{$k}{xm} eq "span")
		    {
			$r = "<".$m.$class.">"
				."<".$$css{$k}{xm}." class=\"$k\"".$a.">";
		    }else{
			if (length $$css{$k}{_markup})
			{
			    $r = "<".$m.$class.">"
				."<".$$css{$k}{xm}." ".$a.">";
			}else{
			    $r = "<".$m.$class.">"
				."<".$$css{$k}{xm}." class=\"$k\"".$a.">";
			}
		    }
		} # xm special

		if (exists $$css{$k}{bef}) # before
		{
		    if ($$css{$k}{bef} eq "\n") { $r .= "\n"; }
		    else { $r = $$css{$k}{bef}.$r; }
		}
	    
		if (exists $$css{$k}{add}) # inner add
		{
		    if ($$css{$k}{add} eq "\n") { $r .= "\n"; }
		    else { $r .= $$css{$k}{add}; }
		}
	    }
	};

	$m = ""; 
	if ($k ne "a")
	{
	    while ($a =~ /\sid=(\w+|\"[^\"]*\")/sg)
	    { $m .= "<a name=$1 />" };
	    while ($a =~ /\shref=(\w+|\"[^\"]*\")/sg)
	    { $r .= "<a href=$1 />" }; # wait with expansion until later...
	}
	$m.$r
	}gsex;
    
    s{ </(\w[\w.:-]*)([^<>]*)> } 
    { 
	$k = $1;
	$a = $2;
	# $a should be tidied up
	
	if (exists $xm{xhtml}{$xhtml}{$k})
	{
	    $r = "</".$k.">"; # leave xhtml tags as they are 
	    $$used{"/$k"} = 1;
	}else{
	    $$used{$k} = 1;
	    $m = "span";
	    if (exists $$css{$k} and length $$css{$k}{_markup} 
		and $$css{$k}{_markup} !~ /^\s*$/)
	    {
		$r = $$css{$k}{_markup} ."."; 
		$m = "";
		$r =~ s{ ([\w+\-]+)\. }{ $m = $1.".".$m; "" }gsex;
		$m =~ s{ \.$ } {""}sex; $m =~ s{ \. }{"></"}gsex;
	    }
	    $r = "</".$m.$a.">";
	    
	    # look for no-span markups
	    if (exists $$css{$k})
	    {
		# the table-special
		if (exists $$css{$k}{xm})
		{
		    if ($$css{$k}{xm} eq "table")
		    {
			$r = "</".$m.$a."></td></tr></table>";
		    }
		    elsif ($$css{$k}{xm} eq "into")
		    {
			$r = "</".$m.$a.">";
		    }
		    elsif ($$css{$k}{xm} eq "hidden")
		    {
			$r = " -->".$r;
		    }else{
			$r = "</".$$css{$k}{xm}.$a."></".$m.">";
		    }
		}

		if (exists $$css{$k}{aft}) # after
		{
		    if ($$css{$k}{aft} eq "\n") { $r .= "\n"; } 
		    else { $r .= $$css{$k}{aft}; }
		}
		if (exists $$css{$k}{end}) # inner end
		{
		    if ($$css{$k}{end} eq "\n") { $r .= "\n"; } 
		    else { $r = $$css{$k}{end}.$r; }
		}
	    }
	}
	while ($a =~ /\shref\b/sg) { $r = "<a href />".$r; }
	$r
    }gsex;

    # innermost href-pairs are now made into a proper <a href=>..</a> sequence
    s{<a href=([^<>]*) />((?:.(?!<a href\b))*.)<a href />} {<a href=$1 >$2</a>}gs;
    # other href-singular-sequences are taken out
    s{<a href=([^<>]*) />} {<a hrefOFF=$1 />}gs;
    s{<a href />} {}gs;

    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::mkhtml4::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;