#! /usr/bin/env perl

# Author: Daniel Pfeiffer <occitan@esperanto.org>

print "@ARGV";

$opt = '-newwindow';
$style = "$ENV{HOME}/.opera/html2html.css";

$style = -r( $style ) ?
    "<link rel=stylesheet type='text/css' href='$style'>" :
    <<'EOF';
<style type="text/css">

.ml		{ font-size: x-small }

.tag		{ color: rgb(   0,   0, 255 ) }
.attr		{ color: rgb( 255,   0, 255 ) }
.value		{ color: rgb( 160,  32, 240 ) }

.comment	{ color: rgb( 128, 128, 128 ) }
.decl		{ color: rgb(   0, 200,   0 ) }
.xmldecl	{ color: rgb( 165,  42,  42 ) }

.entity		{ color: rgb( 255, 165,   0 ) }

.script		{ color: rgb(   0, 100,   0 ) }
.keyword	{ font-weight: bold }
.style		{ color: rgb(   0,   0, 139 ) }
.textarea	{ color: rgb(  64,  64,  64 ) }

.applet		{ background-color: rgb( 144, 238, 144 ) }
.form		{ background-color: rgb( 211, 211, 255 ) }
.head		{ background-color: rgb( 238, 238, 238 ) }
.iframe		{ background-color: rgb( 245, 245, 220 ) }
.layer		{ background-color: rgb( 255, 255,   0 ) }
.map		{ background-color: rgb( 173, 216, 230 ) }
.noframes,
.noscript	{ background-color: rgb( 255, 182, 193 ) }

body		{ background-color: white }

</style>
EOF


if( $ARGV[0] =~ /^-(?:[?h]|-help)$/ ) {
    print <<'EOF';
html2html[ -p|--newpage][ file]
Transforms file or stdin to html code showing the highlighted html or xml
source of file.  The result is shown in opera.  You can set this command as
your external viewer in opera.  That in fact makes it an internal viewer.
Without the option it creates a new window.

You can change the appearance of highlighting by copying all stylesheet lines
out of this script into a file ~/.opera/html2html.css and modifying that.
This is recommended even if you don't change it as opera doesn't need to
reparse it.

A few tags, such as headlines, text-attrs, lists and rough table row
structure are also performed.  This is supposed to ease recognition of the
result, and to help in getting an overview of the structure.  Entities have
a hover display of the character.
EOF
    exit;
} elsif( $ARGV[0] =~ /^-(?:p|-?newpage)$/ ) {
    $opt = '-newpage';
    shift;
}

sub mask($) {
    my $copy = $_[0];
    for( $copy ) {
	s/&/&amp;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
    }
    $copy;
}

sub tag($) {
    my( $copy, $insert, $after ) = mask $_[0];
    for( $copy ) {
	$br = /^(?: (?:[bh]r) | \/?(?:[duo]l|dir|menu|blockquote|bq) | \/(?:h[1-6]|p|li|pre) )\b/xis;
	if( /^(\/?)(h[1-6]|p|li|su[bp]|d[td])\b/is ) {
	    $insert = $1 . $2;
	    $after = $1;
	} elsif( /^(\/?)([bh]r|pre|tt|[bius]|small|big|strike|em|strong|code|samp|kbd|var|dfn|cite|blockquote|bq|dl)\b/is ) {
	    $insert = $1 . $2;
	    $after = ! $1;
	    $pre = lc( $2 ) eq 'pre' && $after;
	} elsif( /^(\/?)([uo]l|dir|menu)\b/is ) {
	    $insert = $1 . 'ul';
	    $after = ! $1;
	} elsif( /^((\/?)table)\b/is ) {
	    $insert = $2 ? $1 : "$1 border><tr><td";
	    $after = $2;
	    $br = 1;
	} elsif( /^tr\b/is ) {
	    $insert = 'tr><td';
	    $br = 1;
	} elsif( $base && /^(\/?)(?:a|img)\b/is ) {
	    $insert = $copy;
	    $after = ! $1;
	} elsif( /^(\/?)(applet|form|head|iframe|layer|map|noframes|noscript)\b/is ) {
	    $insert = $1 ? '/div' : "div class=$2";
	    $after = $1;
	} elsif( /^(?:(base)|meta)\b/is ) {
	    $base = 1 if $1;
	    $insert = $copy;
	    $after = 1;
	}
	s(^(/?)([\w.:-]+)|([\w.:-]+)(?:(\s*=\s*)('.*?'|".*?"|[^\s]+))?) {
	    $2 ? "$1<span class=tag>$2</span>" :
	    "<span class=attr>$3</span>" . ($4 ? "$4<nobr class=value>$5</nobr>" : '')
	}esg;
	s/\n/<br>\n/g unless $pre;
    }
    $copy = "<ml>&lt;$copy&gt;</ml>";
    (!$insert) ? $copy :
	$after ? "$copy<$insert>" :
	"<$insert>$copy";
}

sub masked_block($$$) {
    my $class = lc substr $_[2], 1;
    my $open = tag $_[0];
    my $content = mask $_[1];
    my $close = tag $_[2];
    if( $class eq 'script' ) {
	$content =~ s,\b(abstract|boolean|break|byte|case|catch|char|class|const|continue|default|delete|do|double|else|export|extends|false|final|finally|float|for|function|goto|if|implements|in|instanceof|int|long|native|new|null|package|private|protected|public|return|short|static|super|switch|synchronized|this|throw|throws|transient|true|try|typeof|var|void|while|with)\b,<span class=keyword>$1</span>,g;
	$content =~ s,(//.*|&lt;!(?:--|\[CDATA\[)|\]\]&gt;),<span class=comment>$1</span>,mg;
    }
    "$open<pre class=$class>$content</pre>$close";
}

sub br() {
    my $tmp = $br;
    $br = 0;
    $tmp;
}

sub nontag($$;$$) {
    my $content = mask $_[0];
    $content =~ s/\n/<br>\n/g unless $pre;
    "<span class=ml>&lt;$_[2]<span class=$_[1]>$content</span>$_[3]&gt;</span>";
}


undef $/;
$_ = <>;
($title) = m!<title\b.*?>\s*(.*?)\s*</title\b.*?>!si
    and !$title
    and $title = '...';


s( (\n) |
   &(\#?\w+;?) |
   <(?: !--(.*?)-- |
	!([^>]+?(?:\[.+\])?) |
	\?(.+?)\? |
	((script|style|textarea)\b[^>]*?)> \n? (.*?) \n? <(/\7) |
	(.+?)
   )> )
{
    $1 ? ((br || $pre) ? "\n" : "<br>\n") :
    $2 ? "<span class=entity title='&$2'>&amp;$2</span>" :
    defined( $3 ) ? nontag $3, comment => '!--', '--' :
    $4 ? nontag $4, decl => '!' :
    $5 ? nontag $5, xmldecl => '?', '?' :
    $6 ? masked_block $6, $8, $9 :
    tag $10;
}esigx;

s!</ml><ml>!!g;
s!<(?=ml>)!<span class=!g;
s!</ml>!</span>!g;

$file = '/tmp/html2html-' . rand( $$ ) . '.html';
open F, "> $file";
print F "<title>[$title] Source</title>";
print F $style;
print F;
close F;

exec 'opera', $opt, $file;