#!/usr/local/bin/perl

######################################################################
#
# This is a "pretty printer" for code
# it takes various types of code as input, tries to identify it, 
# and outputs html with highlighted keywords, comments, etc.
#
# Copyright 1999 Greg Spencer (greg_spencer@acm.org)
#
######################################################################

# Here is where we add the various configurations.  Each instantiation of
# these classes contains the same API for accessing things.  They each have
# a method for determining if a particular file is of a particular type,
# called "IsA".

package TxtType;
######################################################################
# text file filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    # it's always at least a text file -- we check this one *last*
    return 1;
}

sub GetHighlightList {
    my @highlight = ();
    return \@highlight;
}

sub GetKeywords {
    my %keywords = ();
    return \%keywords;
}

sub GetColors {
    my %color = ();

    return \%color;
}

sub GetStyles {
    my %style = ();
    return \%style;
}

package HtmlType;
######################################################################
# Html source.
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $suffix = $filename;
    $suffix =~ s/.*?([^\/\\]+)$/$1/; # get basename
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($suffix =~ m/\.(htm|html)$/i) {
#	print STDERR "It's an HTML file!\n";
	return 1;
    }
    if ($sample=~m/<\s*(html|body).*>/i) { # use html or body tag
#	    print STDERR "It's an HTML file!\n";
	    return 1;
    }
#    print STDERR "It's not an HTML file.\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "variable");
    return \@highlight;
}

sub GetKeywords {
    my %keywords = (
		    "keyword" => '(&lt;[/!?]?[-_=A-Za-z0-9\s]+(?:.*?&gt;)?|&gt;)',
		    "variable" => '((?:[%]|&amp;)[#a-zA-Z0-9]+;?)',
		    "comment start" => '&lt;!--',
		    "comment end" => '--&gt;',
		    "string start" => '\'"',
		    "string end" => '\'"'
		    );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "#589a00",
		 "comment" => "#00582e",
		 "variable" => "#ff5d00",
		 "string" => "#ae222f",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 "variable" => "B",
		 "string" => "I",
		 );
    return \%style;
}

package CxxType;
######################################################################
# C/C++/Microsoft Resource filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $suffix = $filename;
    $suffix =~ s/.*?([^\/\\]+)$/$1/; # get basename
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($suffix =~ m/\.(c|cpp|cxx|c\+\+|cc|h|hcc|h\+\+|incl?|rc)$/i) {
#	print STDERR "It's a C++ file!\n";
	return 1;
    }
    if ($sample=~m/-\*-\s*([-\w+.]+)\s*-\*-/) { # use emacs hints, if present
	if ($1 =~ m/^(c\+\+|cc|c)$/i ) {
#	    print STDERR "It's a C++ file!\n";
	    return 1;
	}
    }
#    print STDERR "It's not a C++ file.\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "preprocessor", "type", "protection", "members");
    return \@highlight;
}

sub GetKeywords {
    my $operators = '[-[<>+*%(^!=&|]+[]=)]?';
    my $token = '[a-zA-Z_]\w*';
    my %keywords = (
		    "type" => '\b(auto|bool|char|class|const|double|enum|extern|float|friend|inline|int|long|register|short|signed|static|struct|template|typedef|union|unsigned|virtual|void|volatile)\b',
		    "protection" => '\b(public|private|protected)\b',
		    "preprocessor" => '(^#\s*\w+)',
		    "members" => "((?:$token\\s*::\\s*)+(?:~?$token|operator\\s*(?:\\s+$token|$operators)))",
		    "keyword" => '((?:\b(break|case|catch|continue|default|delete|do|false|for|goto|new|return|switch|then|this|throw|true|try|while)\b)|(?:(?!\#).\b(?:else|if)))',
		    "comment start" => '/\*',
		    "comment end" => '\*/',
		    "string start" => '\'"',
		    "string end" => '\'"',
		    "comment inline" => '//'
		    );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "#589a00",
		 "comment" => "#00582e",
		 "type" => "#00acac",
		 "preprocessor" => "#ff5d00",
		 "protection" => "#1f0058",
		 "members" => "#000080",
		 "string" => "#ae222f",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 "string" => "I",
		 "type" => "B",
		 "preprocessor" => "B",
		 "protection" => "I",
		 "members" => "B",
		 );
    return \%style;
}

package VrmlType;
######################################################################
# VRML file class
# There's an awful lot of non-vrml stuff here, but that's
# because it highlights javascript too.
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $suffix = $filename;
    $suffix =~ s/.*?([^\/\\]+)$/$1/; # get basename
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($suffix =~ m/\.(wrl|pfx)$/i) {
#	print STDERR "It's a VRML file!\n";
	return 1;
    }
    if ($sample=~m/#\s*(vrml|inventor)\s+v[0-9.]+/i) {
#       print STDERR "It's a VRML file!\n";
	return 1;
    }
#    print STDERR "It's not a VRML file.\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "type", "members", "vrml keyword");
    return \@highlight;
}

sub GetKeywords {
    my %keywords = (
		    "type" => '\b(bool|class|float|int|unsigned|var|DEF|PROTO|EXTERNPROTO|USE)\b',
		    "keyword" => '((?:\b(break|case|catch|continue|default|delete|do|false|for|goto|new|return|switch|then|this|true|while|nul)\b)|(?:(?!\#).\b(?:else|if)))',
		    "members" => '(function\s+\w+\s*\(.*?\))',
		    "vrml keyword" => '\b(AsciiText|Cone|Cube|Cylinder|IndexedFaceSet|IndexedLineSet|PointSet|Sphere|Coordinate3|FontStyle|Info|LOD|Material|MaterialBinding|Normal|NormalBinding|Texture2|Texture2Transform|TextureCoordinate2|ShapeHints|MatrixTransform|Rotation|Scale|Transform|Translation|OrthographicCamera|PerspectiveCamera|DirectionalLight|PointLight|SpotLight|Group|Separator|Switch|TransformSeparator|WWWAnchor|WWWInline|Anchor|Appearance|AudioClip|Background|Billboard|Box|Collision|Color|ColorInterpolator|Coordinate|CoordinateInterpolator|CylinderSensor|DiskSensor|ElevationGrid|Extrusion|Fog|FontStyle|ImageTexture|Inline|MovieTexture|NavigationInfo|NormalInterpolator|OrientationInterpolator|PixelTexture|PlaneSensor|PositionInterpolator|ProximitySensor|ScalarInterpolator|Script|Shape|Sound|SphereSensor|Text|TextureTransform|TextureCoordinate|TimeSensor|TouchSensor|Viewpoint|VisibilitySensor|WorldInfo|eventIn|eventOut|field|exposedField|ROUTE|TO|IS|TRUE|FALSE|NULL)\b',
		    "string start" => '\'"',
		    "string end" => '\'"',
		    "comment inline" => '//|#'
		    );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "#589a00",
		 "comment" => "#00582e",
		 "type" => "#00acac",
		 "vrml keyword" => "#1f0058",
		 "members" => "#000080",
		 "string" => "#ae222f",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 "string" => "I",
		 "type" => "B",
		 "vrml keyword" => "B",
		 "members" => "B",
		 );
    return \%style;
}

package IDLType;
######################################################################
# Microsoft ODL/IDL filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $suffix = $filename;
    $suffix =~ s/.*?([^\/\\]+)$/$1/; # get basename
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($suffix =~ m/\.(odl|idl)$/i) {
#	print STDERR "It's an ODL/IDL file!\n";
	return 1;
    }
    if ($sample=~m/-\*-\s*([-\w+.]+)\s*-\*-/) { # use emacs hints, if present (yea, right!)
	if ($1 =~ m/^(odl|idl)$/i ) {
#	    print STDERR "It's an ODL/IDL file!\n";
	    return 1;
	}
    }
#    print STDERR "It's not an ODL/IDL file.\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "directive", "interface", "typekind", "attribute");
    return \@highlight;
}

sub GetKeywords {
    my $operators = '[-[<>+*%(^!=&|]+[]=)]?';
    my $token = '[a-zA-Z_]\w*';
    my %keywords = (
		    "keyword" => '\b(library|typedef|module|coclass|cpp_quote)\b',
		    "directive" => '\b(importlib|import)\b',
		    "interface" => "\\b((?:disp)?interface\\s+$token\\s*:\\s*$token)\\b",
		    "typekind" => '\b(enum|struct|union|base_type|far|auto|bool|char|class|const|double|enum|extern|float|friend|inline|int|long|register|short|signed|static|struct|template|union|unsigned|virtual|void|volatile|public|private|protected)\b',
		    "attribute" => '\b(auto_handle|callback|context_handle|endpoint|first_is|handle|helpcontext|helpstring|hidden|ignore|implicit_handle|in|last_is|length_is|local|max_is|object|out|pointer_default|ptr|ref|size_is|string|switch_type|transmit_as|unique|uuid|version)\b',
		    "comment start" => '/\*',
		    "comment end" => '\*/',
		    "string start" => '\'"',
		    "string end" => '\'"',
		    "comment inline" => '//'
		    );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "#00acac",
		 "comment" => "#00582e",
		 "string" => "#ae222f",
		 "directive" => "#ff5d00",
		 "typekind" => "#580000",
		 "attribute" => "#589a00",
		 "interface" => "#000080",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 "string" => "I",
		 "typekind" => "B",
		 "attribute" => "B",
		 "directive" => "B",
		 "interface" => "B",
		 );
    return \%style;
}

package MakeType;
######################################################################
# Makefile filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $basename = $filename;
    $basename =~ s/.*?([^\/\\]+)$/$1/; # get basename
    my $suffix = $basename;
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($basename =~ m/makefile/i) {
#	print STDERR "It's a Makefile!\n";
	return 1;
    }
    # Cosmo-specific -- this gets leafdefs and ismdefs files.
    if ($basename =~ m/.*(defs|rules)$/i) {
#	print STDERR "It's a Makefile!\n";
	return 1;
    }
    if ($suffix =~ m/\.mak/i) {
#	print STDERR "It's a Makefile!\n";
	return 1;
    }
    if ($sample=~m/-\*-\s*([-\w+.]+)\s*-\*-/) { # use emacs hints, if present
	if ($1 =~ m/make/i) {
#	    print STDERR "It's a Makefile!\n";
	    return 1;
	}
    }
#    print STDERR "It's not a Makefile.\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "macroassign", "dependency", "variables");
    return \@highlight;
}

sub GetKeywords {
    my %keywords = 
	(
	 "keyword" => "^(include|ifndef|ifdef|if|else|endif|define|endef)",
	 
	 # Regex used to find macro assignment lines in a makefile.
	 "macroassign" => "^(\\w*\\s*[*:+]?:?=)",

	 # Variable references even in targets/strings/comments:
	 "variables" => "(\\\$[({](?:[A-Za-z_][\\w:.=]*[})]))",

	 # Regex used to find dependency lines in a makefile.
	 "dependency" => "^([^\\s#:]+(?:\\s+[^\\s#:]+)*\\s*:(?:\\s*|[^=\\n].*))\$",
	 # comment regexp
	 "comment inline" => '#'
	 );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "#584c00",
		 "comment" => "#00582e",
		 "macroassign" => "#580000",
		 "dependency" => "#003358",
		 "variables" => "#1f0058",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 "macroassign" => "B",
		 "dependency" => "B",
		 "variables" => "I",
		 );
    return \%style;
}

package CollectType;
######################################################################
# InstallBuilder collection filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $basename = $filename;
    $basename =~ s/.*?([^\/\\]+)$/$1/; # get basename
    my $suffix = $basename;
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($basename =~ m/collect\..+/i) {
#	print STDERR "It's an InstallBuilder collection file!\n";
	return 1;
    }
#    print STDERR "It's not an InstallBuilder collection file .\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword", "tag");
    return \@highlight;
}

sub GetKeywords {
    my %keywords = 
	(
	 "keyword" => '^(\s*(file|dir))',

	 # IDB tag
	 "tag" => '(\s+\w+)$',

	 # comment regexp
	 "comment inline" => '#'
	 );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "green",
		 "tag" => "maroon",
		 "comment" => "purple",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "tag" => "B",
		 "comment" => "I",
		 );
    return \%style;
}

package SpecType;
######################################################################
# InstallBuilder specification filetype class
######################################################################

sub new {
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
#    $self->init(@args);
    return $self;
}

sub IsA {
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    my $basename = $filename;
    $basename =~ s/.*?([^\/\\]+)$/$1/; # get basename
    my $suffix = $basename;
    $suffix =~ s/.*(\.[^.\/\\]+)$/$1/; # get suffix of basename, if any
    if ($basename =~ m/spec\.dat/i) {
#	print STDERR "It's an InstallBuilder spec file!\n";
	return 1;
    }
#    print STDERR "It's not an InstallBuilder spec file .\n";
    return 0;
}

sub GetHighlightList {
    my @highlight = ("keyword");
    return \@highlight;
}

sub GetKeywords {
    my %keywords = 
	(
	 "keyword" => '^(\s*(product|uiName|defaultInstallDir|endproduct|subsys|export|endsubsys))',

	 # comment regexp
	 "comment inline" => '#'
	 );
    return \%keywords;
}

sub GetColors {
    my %color = (
		 "keyword" => "green",
		 "comment" => "purple",
		 );

    return \%color;
}

sub GetStyles {
    my %style = (
		 "keyword" => "B",
		 "comment" => "I",
		 );
    return \%style;
}

package SourceType;
# always check TxtType last, since it always returns true.
@types = qw(CxxType MakeType CollectType SpecType IDLType HtmlType VrmlType TxtType) unless @types;

sub FindSourceType {
    my $filename = shift;
    my $sample = shift;

#    print STDERR "There are ".($#types+1)." types.\n";

    foreach (@types) {
#	print STDERR "Testing $_...\n";
	my $tester = eval("new $_");
	return $tester if $tester->IsA($filename,$sample);
    }
    return undef;
}

package SourceToHtml;

######################################################################
#
# Variable Init
#
######################################################################

# constructor
sub new { 
    my $type = shift;
    my $self = {};
    my @args = @_;
    bless $self;
    $self->init(@args);
    return $self;
}

sub init {
    # constructor takes: 
    # (file, sample, numbering, confidential, standalone, timestamp, title)
    my $self = shift;
    my $filename = shift;
    my $sample = shift;
    $self->{"number lines"}=shift;
    $self->{"confidential"}=shift;
    $self->{"standalone"}=shift;
    $self->{"extra cols"}=[];
    $self->{"extra colwidths"}=[];
    my $timestamp = shift;
    my $title = shift;
    my $label = shift;
    $self->{"timestamp"}="";

    $self->{"stamp label"} = "Listing Date:";
    if ("$timestamp" eq "1") {
	$self->{"timestamp"}=&Timestamp(time);
    }
    elsif ($timestamp) {
	$self->{"timestamp"}= $timestamp;
	$self->{"stamp label"} = $label if $label;
    }
#    $self->{"timestamp"}=&Timestamp(time) if ($timestamp == 1);
    $self->{"title"} = $title;
    $self->{"head"} = $self->{"title"};
    $self->{"title"} =~ s|[^\s]*[/\\](.+)$|$1|;
    $self->{"user keys"} = "";
    $self->{"user color"} = "#000080";
    $self->{"user style"} = "B";
    $self->{"output"} = "";

#    print STDERR "File: $filename\n";
#    print STDERR "Sample: $sample\n";
    my $typeinfo = SourceType::FindSourceType($filename,$sample);
#    print STDERR "Found File Type.\n";
    if ($typeinfo == undef) {
#	print STDERR "Unable to determine source type -- no highlighting performed.\n";
	$self->{"highlight"} = [];
	$self->{"keywords"} = "";
	$self->{"color"} = "";
	$self->{"style"} = "";
    }
    else {	
    	$self->{"highlight"} = $typeinfo->GetHighlightList();
	$self->{"keywords"} = $typeinfo->GetKeywords();
	$self->{"color"} = $typeinfo->GetColors();
	$self->{"style"} = $typeinfo->GetStyles();
    }
}

######################################################################
#
# Member functions
#
######################################################################

sub SetUserKeywords {
    my $self = shift;
    if (@_) {
	push (@{$self->{"highlight"}},"user");
	@{$self->{"user keys"}} = '\b('."@_".')\b';
    }
    else { #remove "user" from the list.
	@{$self->{"user keys"}} = "";
	my @newlist = ();
	while ($_ = shift @{$self->{"highlight"}}) {
	    push(@newlist,$_) if $_ ne "user";
	}
	@{$self->{"highlight"}} = @newlist;
    }
}

# args are the index of the column to set, and a reference
# to the array to set it to.
sub SetExtraColumn {
    my $self = shift;
    my $idx = shift;
    if ($idx > scalar(@{$self->{"extra cols"}})) {
	$idx = scalar(@{$self->{"extra cols"}});
    }
    ${$self->{"extra colwidths"}}[$idx] = shift;
    ${$self->{"extra cols"}}[$idx] = shift;
}

sub Print {
    my $self = shift;
    $self->{"output"} .= "@_";
}

sub PrintStandaloneHeader {
    my $self = shift;
    $self->Print("<HTML>");
    if ($self->{"head"}) {
	my $tmp = " (".$self->{"timestamp"}.")" if $self->{"timestamp"};
	$self->Print("<TITLE>".$self->{"head"}." $tmp</TITLE>\n");
    }
    else {
	my $tmp = "-- Generated ".$self->{"timestamp"} if $self->{"timestamp"};
	$self->Print("<TITLE>Source Listing $tmp</TITLE>\n");
    }
    $self->Print("<BODY bgcolor=#ffffff text=black>");
}

sub PrintHeader {
    my $self = shift;
    return if (!$self->{"title"} &&
	       !$self->{"timestamp"} &&
	       !$self->{"confidential"});

    my $lefthead="";
    my $righthead="";
    my $middlehead="";

    $self->Print("<FONT size=3>");
    
    if ($self->{"title"}) {
	$lefthead="<B>".$self->{"title"}."</B>";
    }
    
    if ($self->{"timestamp"}) {
	$righthead="<FONT size=2>".$self->{"stamp label"}." ".
	    $self->{"timestamp"}."</FONT>";
    }
    
    if ($self->{"confidential"}) {
	$middlehead=$self->{"confidential"};
    }
    
    $self->Print("<TABLE width=100% cols=3><TD align=left>$lefthead".
	    "<TD align=center>$middlehead".
	    "<TD align=right>$righthead<TR></TABLE>\n</FONT>\n");
}

sub Timestamp {
    local($ltime) = shift;
    local(@now);
    local($ampm) = "AM";
    local($month);
    local($weekday);
    @now = localtime($ltime);
    if ($now[2]>12 && $now[2]!=24) {
        $now[2] -= 12;
        $ampm = "PM";
    }
    elsif ($now[2] == 12) {
	# fix for "noon"
        $ampm = "PM";
    }
    elsif ($now[2] == 24) {
	# fix for "midnight"
        $ampm = "AM";
        $now[2] = 12;
    }
  switch1: {
      $month="Jan", last switch1 if ($now[4] == 0);
      $month="Feb", last switch1 if ($now[4] == 1);
      $month="Mar", last switch1 if ($now[4] == 2);
      $month="Apr", last switch1 if ($now[4] == 3);
      $month="May", last switch1 if ($now[4] == 4);
      $month="Jun", last switch1 if ($now[4] == 5);
      $month="Jul", last switch1 if ($now[4] == 6);
      $month="Aug", last switch1 if ($now[4] == 7);
      $month="Sep", last switch1 if ($now[4] == 8);
      $month="Oct", last switch1 if ($now[4] == 9);
      $month="Nov", last switch1 if ($now[4] == 10);
      $month="Dec", last switch1 if ($now[4] == 11);
  }
      
  switch2: {
      $weekday="Sun", last switch2 if ($now[6] == 0);
      $weekday="Mon", last switch2 if ($now[6] == 1);
      $weekday="Tue", last switch2 if ($now[6] == 2);
      $weekday="Wed", last switch2 if ($now[6] == 3);
      $weekday="Thu", last switch2 if ($now[6] == 4);
      $weekday="Fri", last switch2 if ($now[6] == 5);
      $weekday="Sat", last switch2 if ($now[6] == 6);
  }

    return sprintf ("%02d:%02d:%02d $ampm $weekday $month %02d, 19%02d",
            $now[2],$now[1],$now[0],$now[3],$now[5]);
}

sub Words {
    my $self = shift;
    my $arg = shift;

    $suffix="";
    if ($self->{"keywords"}{"comment inline"} &&
	$arg=~m{(.*?)($self->{"keywords"}{"comment inline"})(.*)}) {
	chomp $3;
	$suffix = "<FONT color=".$self->{"color"}{"comment"}."><".$self->{"style"}{"comment"}.">".$2.$3."</".$self->{"style"}{"comment"}."></FONT><BR>";
	$arg=$1;
    }
    if ($self->{"keywords"}{"string start"}) {
	my $i;
	my $starts = $self->{"keywords"}{"string start"};
	my $ends = $self->{"keywords"}{"string end"};
	for ($i = 0; $i<length($starts); $i++) {
	    my $st = substr($starts,$i,1);
	    my $en = substr($ends,$i,1);
	    $st=~s/&/&amp;/g;
	    $st=~s/\"/&quot;/g;
	    $st=~s/</&lt;/g;
	    $st=~s/>/&gt;/g;
	    $en=~s/&/&amp;/g;
	    $en=~s/\"/&quot;/g;
	    $en=~s/</&lt;/g;
	    $en=~s/>/&gt;/g;
	    if ($arg=~m{(.*?)\Q$st\E(.*?)\Q$en\E(.*)}) {
		my $p1 = $1;
		my $p2 = $2;
		my $p3 = $3;
		my $part1 = $self->Words($p1);
		$part1=~s/<BR>//g;
		my $part2 = $p2;
		my $part3 = $self->Words($p3);
		$part3=~s/<BR>//g;
		$suffix=~s/<BR>//g;
		return $part1.
		    "<FONT color=".$self->{"color"}{"string"}.
			"><".$self->{"style"}{"string"}.">$st".
			    $part2."$en</".$self->{"style"}{"string"}."></FONT>".
				$part3.$suffix."<BR>";
	    }
	}

    }


    foreach (@{$self->{"highlight"}}) {
	if ($self->{"color"}{$_} eq "") {
	    print STDERR "Highlight type '$_' doesn't have a color...\n";
	}
	if ($self->{"style"}{$_} eq "") {
	    print STDERR "Highlight type '$_' doesn't have a style...\n";
	}
	if ($_ ne "user") {
	    $begin = "<FONT color=".$self->{"color"}{$_}."><".$self->{"style"}{$_}.">";
	    $end = "</".$self->{"style"}{$_}."></FONT>";
	    $search= $self->{"keywords"}{$_};
	}
	else {
	    $begin = "<FONT color=".$self->{"user color"}."><".$self->{"user style"}.">";
	    $end = "</".$self->{"user style"}."></FONT>";
	    $search= $self->{"user keys"};
	}
	$arg=~s{$search}{$begin$1$end}g;
    }
    return $arg.$suffix;
}

# this is health care for html escape sequences... :-)
sub metachar {
    s/&/&amp;/g;
    s/\"/&quot;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
}

######################################################################
#
# Convert member
#
######################################################################

sub Convert {
    my $self = shift;
    my @input = @_;
    my $linecnt=0;    
    my $incomment=0;

    if ($self->{"standalone"}) {
	$self->PrintStandaloneHeader();
    }
    
    $self->PrintHeader();

    $self->Print("<HR>") if ($self->{"title"} ||
			     $self->{"timestamp"} ||
			     $self->{"confidential"});

    if ($self->{"number lines"}) {
	my $numcols = 3 + scalar(@{$self->{"extra cols"}});
	$self->Print("<TABLE cols=$numcols border=0 cellpadding=0 cellspacing=0>");
    }
    else {
	$self->Print("<CODE><PRE>");
    }

    while ($_ = shift(@input)) {
	if ($self->{"number lines"} && $linecnt%10 == 0) {
	    $self->Print("<TD valign=top align=right width=25><font color=#808080 size=-1><i>\n");
	    $self->Print("<A name=\"Line$linecnt\">$linecnt</A>\n");
	    $self->Print("</i></font>\n");
	    for ($j=0;$j<scalar(@{$self->{"extra cols"}});$j++) {
		$self->Print("<TD valign=top align=center width=".$self->{"extra colwidths"}[$j].">\n");
		$self->Print("<tt>");
		for ($i=0;$i<10;$i++) {
		    $self->Print($self->{"extra cols"}[$j][$linecnt+$i]."<BR>\n");
		}
		$self->Print("</tt>");
	    }
	    $self->Print("<TD width=5><pre> </pre><td valign=top align=default><code><pre>");
	    if ($incomment) {
		$self->Print("<FONT color=".$self->{"color"}{"comment"}."><".$self->{"style"}{"comment"}.">");
	    }
	}
	$linecnt++;
	
	# quote html stuff
	&metachar($_);
	
	# fix multi-line comments (if any)
	if ($self->{"keywords"}{"comment start"}) {
	    my $start = $self->{"keywords"}{"comment start"};
	    my $end = $self->{"keywords"}{"comment end"};
	  lather:
	    if ($incomment && m@(.*)($end)(.*)@) {
		$self->Print($1.$2."</".$self->{"style"}{"comment"}."></FONT> ");
		$incomment = 0;
		chomp $3;
		$_ = $3."\n";
	    }
	    if ($incomment) { goto rinse; }
	    elsif (m@(.*)($start)(.*)@) {
		$self->Print($self->Words($1).
			     "<FONT color=".$self->{"color"}{"comment"}."><".$self->{"style"}{"comment"}.">".$2);
		chomp $3;
		$_=$3."\n";
		$incomment = 1;
		goto lather;
	    }
	}
	
	$_=$self->Words($_);
	
      rinse:
	$self->Print($_);
	if ($self->{"number lines"} && $linecnt%10 == 0) {
	    $self->Print("<TR>");
	}
    }
    if ($self->{"number lines"}) {
	$self->Print("</TABLE>");
    }
    else {
	$self->Print("</PRE></CODE>");
    }
    
    $self->Print("<HR>") if ($self->{"title"} ||
			     $self->{"timestamp"} ||
			     $self->{"confidential"});
    
    $self->PrintHeader();

    if ($self->{"standalone"}) {
	$self->Print("</BODY>");
	$self->Print("</HTML>\n");
    }

    # now zero the output
    my $retval = $self->{"output"};
    $self->{"output"} = "";
    return $retval;
}

sub Highlight {
    my $self = shift;
    my @input = @_;
    my $linecnt=0;    
    my $incomment=0;

    $self->Print("<CODE><PRE>");

    while ($_ = shift(@input)) {
	# quote html stuff
	&metachar;
	
	# fix multi-line comments (if any)
	if ($self->{"keywords"}{"comment start"}) {
	    my $start = $self->{"keywords"}{"comment start"};
	    my $end = $self->{"keywords"}{"comment end"};
	  lather:
	    if ($incomment && m@(.*)($end)(.*)@) {
		$self->Print($1.$2."</".$self->{"style"}{"comment"}."></FONT> ");
		$incomment = 0;
		chomp $3;
		$_ = $3."\n";
	    }
	    if ($incomment) { goto rinse; }
	    elsif (m@(.*)($start)(.*)@) {
		$self->Print($self->Words($1).
			     "<FONT color=".$self->{"color"}{"comment"}."><".$self->{"style"}{"comment"}.">".$2);
		chomp $3;
		$_=$3."\n";
		$incomment = 1;
		goto lather;
	    }
	}
	
	$_=$self->Words($_);
	
      rinse:
	$self->Print($_);
    }
    $self->Print("</PRE></CODE>");

    # now zero the output
    my $retval = $self->{"output"};
    $self->{"output"} = "";
    return $retval;
}