#!/perl

use strict;
use warnings;
my $vers = '0.0.5'; # fourth iteration, expanding line array ... LOOKS GOOD - settling down!!!
my $WHITE_PATTERN2 = "^[ \t\n\r]*\$"; # spacey if ($var =~ /$WHITE_PATTERN2/o ) { ...}
my $tab_stg = '&nbsp;&nbsp;&nbsp;'; # replace tabs, with 3 spaces
my $verb2 = 0;
my $perlstx = 'C:/Program Files/EditPlus 2/perl.stx';
my $DELIMITER = '(){}[]-+*/=~!&|<>?:;.,';
my @stx = ();
my @stxc;
my $htmsps = 0; # set after htmlise()
my $htmnbs = '';
my $dbgon = 0; # 1 DOUBLES HTML OUTPUT FOR COMPARISON
my $colorON = 1;
my $logfil = 'templog.txt';
my @logmsgs = ();
my $infile = shift || '.';
my $outfil = shift || 'tempout.htm';
my ($OF, $IF, $LF, $STX);
my $name;
###               l.blue brown  l.br  s.gr pink   mauve  b.gr   l.br  blue wh    l.gr
my @TTTypes  = qw(array comment unass  s-quote scalar functions d-quote hash reserved other unass);
my @TTColors = qw(match orange regex green color1 color2 color3 peach blue white grey);
for $name (@TTColors) {
	no strict 'refs';       # allow symbol table manipulation
    *$name = *{uc $name} = sub { "<TT class='$name'>@_</TT>" };
	### *$name = *{uc $name} = sub { "<TT class='$name'>\n@_\n</TT>" };
}
###my @colors = qw(red blue green yellow orange purple violet);
my @colors = qw(red yellow purple violet);
for $name (@colors) {
	no strict 'refs';       # allow symbol table manipulation
    *$name = *{uc $name} = sub { "<FONT COLOR='$name'>@_</FONT>" };
}

my @PPunct = ("&", "&&", "&&=", "&=",
	"<", "<<", "<<=", "<&=", "<&",
	"<=", "<==>", ">", ">&", ">>",
	">>=", ">=",
	"*", "**", "**=", "*=", "*?",
	"@", "@*,", "@_",
	"`", "\\",
	"!", "!=",
	"^", "^=",
	":", ",", "\$",
	".", "\"",
	"=", "=>", "==", "=~",
	">", "#", "-", "->",
	"-*-", "-=", "--", "-|",
	"%", "%=", 
	"+", "+=", "++", "+?",
	"#", "?", "?:", "?...?",
	"'", "\"", ";", "#!",
	"/", "/=", "//", "/.../",
	"~", "~~",
	"_","|", "|=", "|-", "||", "||=",
	"/o"
	);

my $msg = '';
my ($line, $txt);
my $i = 0;
my ($cnt1, $cnt2);
my $inbraces = 0;

if ($infile eq '.') {
	die "No input file given ...\n";
}
open $LF, ">$logfil" or die "Can NOT open LOG file $logfil!\n";

tolog ("$0 Started " . localtime(time()) . " ...\n");
if (! -f $infile) {
	die "Input file [$infile] NOT FOUND! ...\n";
}

tolog ("Opening $infile ...\n");
open $IF, "<$infile" or die "Can not OPEN $infile!\n";
tolog ("Loading $infile ...\n");
my @lines = <$IF>; # slurp whole file, to an array of lines
close($IF);

open $STX, "<$perlstx" or die "Can NOT locate $perlstx file...\n";
@stx = <$STX>;
close($STX);

open $OF, ">$outfil" or die "Can not create $outfil!\n";

###### pre-process perl.stx file ######################################
$i = @stx;
tolog ("List of $i STX file lines...\n");
my %stxh;
my @ResWds = ();
my @BFuncs = ();
my %HResWds;
my %HBFuncs;
my $sw = 0; # no switch on
foreach $line (@stx) {
	chomp $line;
	my $ll = length($line); # get LENGTH of file line
	my @a;
	my $k;
	my $v;
	my $c = substr ($line, 0, 1);
	$msg = '';
	if ($c eq ';') { # comment
		$msg = 'comment only';
	} elsif ($c eq '#') { # hash item=value
		$msg = ' hash';
		@a = split('=', $line); # get key/value
		($k, $v) = @a;
		$k = substr($k, 1);
		###$stxh{$a[0]} = $a[1];
		if ( exists $stxh{$k} ) {
			if ($stxh{$k} eq $v) {
				$msg .= ' same ';
			} else {
				$msg .= ' new ';
			}
			$stxh{$k} .= '|' . $v;
			###$v = $stxh{$k};
		} else {
			$stxh{$k} = $v;
		}
		### $msg .= ' k=' . $a[0] . ' v=' . $a[1] . '-'; 
		###$msg .= ' k=' . $k . ' v=' . $v . ' - '; 
		$msg .= ' k=' . $k . ' v=' . $stxh{$k} . ' - '; 
		#KEYWORD=Reserved words
		#KEYWORD=Built-in functions
		if ($k eq 'KEYWORD') {
			if ($v eq 'Reserved words') {
				$sw = 1;
				$msg .= '(ResWds)';
			} elsif ($v eq 'Built-in functions') {
				$sw = 2;
				$msg .= '(BFuncs)';
			} else {
				$sw = 0;
			}
		}
	}

	if ($ll > 1) {
		if ($sw == 1) {
			push(@ResWds, $line);
			if ( exists $HResWds{$line} ) {
				die "Duplicate RESERVE WORD [$line]\n"
			}
			$HResWds{$line} = $line;
			$msg .= " - rw+";
		} elsif ($sw == 2) {
			push(@BFuncs, $line);
			if ( exists $HBFuncs{$line} ) {
				die "Duplicate BUILT-IN FUNCTION [$line]\n"
			}
			$HBFuncs{$line} = $line;
			$msg .= " - bf+";
		}
	}
	tolog ($line . $msg . "\n") if $verb2;
}

$line = 'new';
if ( ! exists $HBFuncs{$line} ) {
	$msg = ' ++Added';
	push(@BFuncs, $line);
	$HBFuncs{$line} = $line;
	tolog ($line . $msg . "\n");
}

$cnt1 = @ResWds;
$cnt2 = @BFuncs;
tolog ("END List of $i STX file lines...rw=$cnt1 bf=$cnt2 \n");
###### end-process perl.stx file ######################################


add_html_head( $OF, $infile );
### add_html_tail($OF);

my $lncnt = @lines; # get count
tolog ("Processing $infile ... $lncnt lines\n");
my $lc = 0;
my $dnpara = 1;
my @lnbits;
my $chk;
my $istxt = 1;
## my $func;
prt ("<p>\n");
foreach $line (@lines) {
	$txt = $line;
	chomp $txt;
	@lnbits = split(' ',$txt);
	$lc++;
	$istxt = 1; # assume text
	if ($txt =~ /$WHITE_PATTERN2/o ) {
		$txt = "</p>\n<p>\n"; # CLOSE paragraph, and open
		$istxt = 0; # NOT text
	} else {
		$txt = white(htmlise($txt));
		$txt .= "<br>\n";
	}

	if ( $istxt ) {
		if ($dbgon) {
			tolog ("Simple WHITE-ised to HTML file ...\n") if $verb2;
			prt ($txt); # just for COMPARISON
		}
	} else { ## if (! $istxt) {
		tolog ("Simple WHITE-ised to HTML file ...\n") if $verb2;
		prt ($txt); # just for COMPARISON
	}

	if ($istxt) {
		###do_line_parse ($line);
		tolog ("Per line component parsing to HTML file ...\n") if $verb2;
		do_line_parse ($line);
	}
}

tolog ("Processed $lc lines of $infile ... written to $outfil ... add tail ...\n");
prt ("</p>\n");
add_html_tail($OF);

showarrcnts();

tolog ("$0 Ended " . localtime(time()) . " ...\n");

close($OF);
 system $outfil;
# system $logfil;

sub prt {
	tolog (@_);
	print $OF @_;
}

sub addTTitem {
	my ($fh, $nm, $bd, $bg) = @_;
	print $fh <<"EOF3";
.$nm { BACKGROUND-COLOR: $bg }
EOF3

}

sub addTTitem_full {
	my ($fh, $nm, $bd, $bg) = @_;
	print $fh <<"EOF3";
.$nm
{
    BORDER-TOP: $bd 1px solid;
    BORDER-LEFT-WIDTH: 1px;
    BORDER-LEFT-COLOR: $bd;
    PADDING-BOTTOM: 1px;
    PADDING-TOP: 1px;
    BORDER-BOTTOM: $bd 1px solid;
    WHITE-SPACE: nowrap;
    BACKGROUND-COLOR: $bg;
    BORDER-RIGHT-WIDTH: 1px;
    BORDER-RIGHT-COLOR: $bd
}
EOF3

}

sub add_html_style {
	my ($fh) = @_;
	print $fh <<"EOF1";
<style><!--
TT
{
    FONT-FAMILY: 'Andale Mono', 'Lucida Console', monospace
}
EOF1

#################################
###my @TTset = qw( match #0066ff #e8f4ff string #0000ff #ccccff );
 my @TTset = (
	 "match", "#0066ff", "#e8f4ff",
	 "string", "#0000ff", "#ccccff",
	 "orange", "#ff6600", "#ffcc99",
	 "regex",  "#ff6600", "#fff4e8",
	 "green",  "#006400", "#ccffcc",
	 "color1", "#ff6600", "#ff99cc",
	 "color2", "#0066ff", "#cc99ff",
	 "color3", "#00a000", "#ccff99",
	 "peach",  "#0066ff", "peachpuff",
	 "blue",   "blue",    "powderblue",
	 "white",  "#909090", "#ffffff",
	 "grey",   "#909090", "#dddddd" );

 my $nm;
 my $bd;
 my $bg;
 my $mx = @TTset;
 tolog ("Processing $mx / 3 styles ...\n");
 tolog ( @TTset . "\n" );
 my $i;
 ## ??while (($nm, $bd, $bg) = @TTset) {
 for ($i = 0; $i < ($mx / 3); $i++) {
	 $nm = $TTset[($i*3)+0];
	 $bd = $TTset[($i*3)+1];
	 $bg = $TTset[($i*3)+2]; 
	 addTTitem ($fh, $nm, $bd, $bg);
 }
###################################

	print $fh <<"EOF2";
--></style>
EOF2

}

sub add_html_head {
	my ($fh, $hdr) = @_;
	print $fh <<"EOF";
<html>
<!-- P26.2005.05.10 geoffmclane.com perl
	HTML generated using p2html5.pl - 
  -->
<head>
<title>$hdr</title>
</head>
EOF
	# dynamic block of style - could be put to a file ...
	add_html_style($fh);

	print $fh <<"EOF";
<body>
<h1 align="center">$hdr</h1>

<p align="center"><a href="perl.htm">back</a></p>

<table align="center" width="90%" border="2" bgcolor="#eeeeff">
 <tr>
 <td>

EOF

}

sub add_html_tail {
	my ($fh) = @_;

	print $fh <<"EOF";
 </td>
 </tr>
</table>
EOF

	add_color_samp($fh);

	print $fh <<"EOF";
<p align="center"><a href="perl.htm">back</a></p>

</body>
</html>
EOF

}

my @TypeColor = (
	###if ($c eq '#') { # comment component - should be to end-of-line, or more ...
	"comment", ### $func = \&orange;
	###} elsif ($c eq "'") { ## "' # does it start with quotes DOUBLE or SINGLE
	"s.quote", ### $func = \&green;
	###	} elsif ($c eq '"') {
	"d.quote", ### $func = \&color3;
	###} elsif ($c eq '$') { # start of scalar
	"scalar", ### $func = \&color1;
	###} elsif ($c eq '@') { # start of array
	"array", ### $func = \&match;
	###} elsif ($c eq '%') { # start of hash
	"hash", ### $func = \&peach;
	###} elsif ( exists $HResWds{$tx2} ) {
	"reserved", ### $func = \&blue;
	### } elsif ( exists $HBFuncs{$tx2} ) {
	"functions", ### $func = \&color2;
	### } else {
	"other" ### $func = \&white;}
	);


sub add_color_samp {
	my ($fh) = @_;
	my $i = 0;
### my @TTColors = qw(match orange  regex  green   color1 color2    color3  peach blue    white grey);
### my @TTTypes  = qw(array comment unass  s-quote scalar functions d-quote hash reserved other unass);
	print $fh "<p>Colour Key : Type - Attribute<br>";
	###print $fh "<table border='1'>\n";
	print $fh '<table border="1" bgcolor="#eeeeff">';
	print $fh "\n";
	foreach $name (@TTColors) {
		print $fh "<tr><td>\n";
		###no strict 'refs'; # allow symbol table manipulation
		my $func = \&$name; ## get the function - the auto-generated sub
		###$txt = \&$name($name);
		$msg = $TTTypes[$i];
		$msg .= ' - ';
		$msg .= $name;
		###$txt = $func->($name); # suround/encase the text
		$txt = $func->($msg); # suround/encase the text
		print $fh "[";
		###print $fh match($name);
		print $fh $txt;
		print $fh "]";
		$i++;
		print $fh "</tr></td>\n";
	}
	print $fh "</table>\n";
	print $fh "</p>\n";
}

sub tolog {
	print @_;
	print $LF @_;
}

sub xceptchr {
	my ($chr) = @_;
	if (($chr eq ':') || ($chr eq '=') || ($chr eq '|') || ($chr eq ',')) {
		return 1;
	}
	return 0;
}

### NOT passed an ALL-SPACEY line
sub do_line_parse {
	my ($tx) = @_;
	chomp $tx;
	my @copybits; ## keep, for ORIGINAL space work 'replacement'
	my $tx2 = $tx;
	my $tx3;
	my $tx4 = htmlise($tx); ## the HTML'ISED string
	my $txsp = ''; # frontend SPACEY stuff
	### no way ! my $txsp = $htmnbs; # frontend SPACEY stuff
	my $tx5;
	my $tx6;
	my $c1 = substr ($tx, 0, 1); # get and keep first char
	@lnbits = split (' ', $tx); # initial split spaces
	my $c2 = substr ($lnbits[0], 0, 1); # get POTENTIAL new first char
	my $pos1 = index ($tx, $c2); # get pos of first array char, in string
	my $gotfes = 0; # no frontend space
	if ($pos1 > 0) {
		$gotfes = 1; # mark, got frontend space
		$txsp = substr($tx, 0, $pos1); # get SPACEY at FRONT
	}
	my $cnt = @lnbits; # count of componets, so far
	my $cntorg = $cnt; # keep original SIZE, $cnt is 'adjusted' during ...
	my $i = 0;
	my $i2 = 0;
	my $i3 = 0;
	my @sp11;
	my $nct = 0; # count AFTER array 'adjustments' ...
	my $ln = length($tx2); # get length of line, not soooo important
	my $ch = substr ($tx2, 0, 1); # get first char, for fast decisions
	my $c = $ch; ### copy of FIRST char
	if ($lnbits[0] =~ m/^\#/) {
		#######################################################
		# is comment
		tolog ("Is comment - try ...\n");
		###$tx3 = green($tx4);
		$tx3 = orange($tx4);
		$tx3 .= "<br>\n";
		prt ($tx3);
		#######################################################
	} else {
		tolog ("########### parse run one ###############################\n") if $verb2;
		## does not START with a # comment char
		$i2 = 0;
		$i3 = 0;
		my $ichg = 0; ### count of bit changes
		### first run - to re-combine quoted text within LINE ARRAY
		$i2 = 0; ### init line 'bits' counter
		$ichg = 0;
		@logmsgs = (); ### clear LOG message stack
		###tolog ("{ comps $cntorg\n"); # log COUNT at start
		$msg = ("{ comps $cntorg\n"); # log COUNT at start
		push(@logmsgs,$msg); ## accumulate
		foreach $tx2 (@lnbits) {
			$i2++; # PRE-BUMP THE COUNT
			$msg = $tx2; # set line bit
			$ln = length($tx2);
			$ch = substr ($tx2, 0, 1);
			$i = 0;
			### special +?.*^$()[]{}|\
			### if ($tx2 =~ /^['"]/ ) { ## "' # does it start with quotes d or s
			if (($ch eq '"')||($ch eq "'")) {
				### $msg .= " begin quote";
				$i = 1; # set JOIN
				if ($ln > 1) {
					$tx3 = substr ($tx2, 1, $ln - 1); # get past quote 
					if ( $tx3 =~ /$ch/) {
						$pos1 = index ($tx3, $ch); # get position of next quote
						$i = 0;
					}
				}
				if ($i) {
					# should JOIN until the END OF QUOTE
					$i3 = 0;
					for ($i = $i2; $i < $cnt; $i++) {
						$tx3 = $lnbits[$i]; # get next
						$tx2 .= ' '; # add back space
						$tx2 .= $tx3; ### $lnbits[$i];
						$i3++; ### count 'bits' to DELETE
						$ichg++; ### count a CHANGE
						if ($tx3 =~ /$ch/) {
							last; # exit when terminator found
						}
					}
					$lnbits[$i2 - 1] = $tx2; # put back single quoted message
					###splice (@lnbits, $i2, $cnt - $i2); # collapse following items
					splice (@lnbits, $i2, $i3); # collapse following items
					$msg .= ", now joined, to its end";
					$cnt = @lnbits; ### UPDATE THE COUNT
				}
			} elsif ($ch eq '#') { # if starts with a comment
				## should join to end of line
				$i3 = 0;
				for ($i = $i2; $i < $cnt; $i++) {
					$tx3 = $lnbits[$i];
					$tx2 .= ' ';
					$tx2 .= $tx3; ### $lnbits[$i];
					$i3++;
					$ichg++;
				}
				$msg .= ' joined ';
				$msg .= $lnbits[$i2 - 1];
				$msg .= ' to ';
				$msg .= $tx2;
				$lnbits[$i2 - 1] = $tx2; # put back single quoted message
				$msg .= ' sp ' . $i2 . ' ' . $i3 . '[';
				splice (@lnbits, $i2, $i3); # collapse following items
				$msg .= "], line comment";
				$cnt = @lnbits;
				$i3++;
			} else {
				## not begin quote ' or ", nor begin # ...
				$c = 0;
				$tx3 = substr($tx2,1);
				if (($ch eq '$') || ($ch eq '@') || ($ch eq '%')) {
					# start of a scalor, array, hash ... move on to next
					$c = gotdelim($tx3);
					if ( length($tx3) && ($c) && ! xceptchr($c) ) {  # got first split point, AFTER $var ...
						$pos1 = index ($tx3,$c);
					}
				} else {
					$tx3 = $tx2;
					my $c3 = gotdelim($tx3);
					if ( length($tx3) && ($c3) ) {  # got first split point
						$pos1 = index ($tx3,$c3);
					} # process $tx3
				}

				if ($c && ! xceptchr($c) ) {
					$msg .= ' *D ';
					$msg .= $c;
					$msg .= '* ';
				}

				if ( exists $HResWds{$tx2} ) {
					$msg .= ' *B*'; ### blue('R');
				}
				if ( exists $HBFuncs{$tx2} ) {
					$msg .= ' *P*';
				}
			}

			###tolog ($msg . "\n");
			$msg .= "\n"; # add end of line
			push(@logmsgs, $msg); ### store the LOG
		} # for array list of line components === ONLY DOING JOINING

		$nct = @lnbits;
		if ($cnt != $nct) {
			die "***FIX a COUNT UPDATE $cnt $nct $cntorg ????\n";
		}
		if ($cntorg == $nct) {
			$msg = "} end comps $cntorg\n";
		} else {
			$msg = ("} end comps $cntorg, adj. $nct " . ($cntorg - $nct) . "\n");
		}
		push(@logmsgs, $msg);

		if ($ichg || $verb2) {
			tolog ( "Run 1 made " . $ichg . " changes in line - CHECK CHANGE\n" );
			foreach $msg (@logmsgs) {
				tolog($msg);
			}
		} else {
			### no change
			if ($verb2) {
				tolog ("No change\n");
			}
		}

		@copybits = @lnbits; ### take a SNAP of this QUOTE ONLY EXPANSION
		### want to RETURN the line to this SPACING, if possible ###
		tolog ("########### parse run two ###############################\n") if $verb2;
		#################### DO IT ALL NOW ###################
		###tolog ("{ comps $nct\n"); # log COUNT at start
		@logmsgs = ();
		$msg = ("{ comps $nct\n"); # log COUNT at start
		push(@logmsgs,$msg); ## accumulate
		$i2 = 0; ### init line 'bits' counter
		$ichg = 0;
		foreach $tx2 (@lnbits) {
			$i2++; # PRE-BUMP THE COUNT
			$msg = $tx2;
			$ln = length($tx2);
			$ch = substr ($tx2, 0, 1);
			$i = 0;
			### special +?.*^$()[]{}|\
			### if ($tx2 =~ /^['"]/ ) { ## "' # does it start with quotes d or s
			if (($ch eq '"')||($ch eq "'")) {
				#########################################
				### $msg .= " begin quote";
				$i = 1; # set JOIN
				if ($ln > 1) {
					$tx3 = substr ($tx2, 1, $ln - 1); # get past quote 
					if ( $tx3 =~ /$ch/) {
						$pos1 = index ($tx3, $ch); # get position of next quote
						if ($pos1 > 0) {
							$tx5 = substr ($tx2, 0, ($pos1 + 1 + 1)); # get WHOLE QUOTE
							$tx3 = substr ($tx3, ($pos1 + 1)); # get ending text, if ANY
							if (length($tx3)) {
								$msg .= ' DONE WOULD SPLIT ';
								$msg .= '[';
								$msg .= $tx5;
								$msg .= ']';
								$msg .= '[';
								$msg .= $tx3;
								$msg .= ']?';
								$lnbits[$i2 - 1] = $tx5; # put back adjusted first
								splice (@lnbits, $i2, 0, $tx3); # insert 1 new items
								$cnt = @lnbits; ### ADJUST COUNT ITERATOR
								$ichg++;
							}
						}
						$msg .= " b&e same quotes";
						$i = 0;
					}
				}
				if ($i) {
					# should JOIN until the END
					$i3 = 0;
					for ($i = $i2; $i < $cnt; $i++) {
						$tx3 = $lnbits[$i]; # get next
						$tx2 .= ' '; # add back space
						$tx2 .= $tx3; ### $lnbits[$i];
						$i3++;
						$ichg++;
						if ($tx3 =~ /$ch/) {
							last; # exit when terminator found
						}
					}
					$lnbits[$i2 - 1] = $tx2; # put back single quoted message
					###splice (@lnbits, $i2, $cnt - $i2); # collapse following items
					splice (@lnbits, $i2, $i3); # collapse following items
					$msg = $tx2;
					$msg .= ", now joined, to its end";
					$cnt = @lnbits; ### UPDATE THE COUNT
				}
				$i3++;
				#########################################
			} elsif ($ch eq '#') { # if starts with a comment
				#########################################
				## should join to end of line
				$i3 = 0;
				for ($i = $i2; $i < $cnt; $i++) {
					$tx3 = $lnbits[$i];
					$tx2 .= ' ';
					$tx2 .= $tx3; ### $lnbits[$i];
					$i3++;
					$ichg++;
				}
				$msg .= ' joined ';
				$msg .= $lnbits[$i2 - 1];
				$msg .= ' to ';
				$msg .= $tx2;
				$lnbits[$i2 - 1] = $tx2; # put back single quoted message
				###splice (@lnbits, $i2, $cnt - $i2); # collapse following items
				$msg .= ' sp ' . $i2 . ' ' . $i3 . '[';
				splice (@lnbits, $i2, $i3); # collapse following items
				### $msg = $tx2;
				$msg .= "], line comment";
				$cnt = @lnbits;
				$i3++;
				#########################################
			} else {
				#########################################
				## not begin quote ' or ", nor begin # ...
				my $c = 0;
				$tx3 = substr($tx2,1); 
				if (($ch eq '$') || ($ch eq '@') || ($ch eq '%')) {
					# start of a scalor, array, hash ... move on to next
					$c = gotdelim($tx3);
					if ( length($tx3) && ($c) && ! xceptchr($c) ) {  # got first split point, AFTER $var ...
						$pos1 = index ($tx3,$c);
						if ($pos1 > 0) {
							$i3 = 0;
							$tx5 = $ch; # put first char back
							$tx5 .= substr ($tx3, 0, $pos1); # get up to CHAR
							@sp11 = ($c);
							$tx3 = substr ($tx3, ($pos1 + 1)); # get ending text, if any
							if (length($tx3)) {
								push(@sp11, $tx3); # put in slurp
								if ((($c eq '(') && (substr($tx3,0,1) eq ')')) ||
									(($c eq '+') && (substr($tx3,0,1) eq '+')) ) { # eg check *split* [$sock->accept][(][);]
									$i3 = 1; # some EXCEPTIONS
								}
							}
							if ($i3) {
								$msg = '*NO* *split* [';
							} else {
								$msg = 'DONE *split* [';
							}
							$msg .= $tx5 . '][';
							$msg .= $c . ']';
							if (length($tx3)) {
								$msg .= '[';
								$msg .= $tx3 . ']';
							}
							$msg .= "\n";
							push(@logmsgs,$msg);
							###tolog ($msg . "\n");
							if ($i3 == 0) {
								$lnbits[$i2 - 1] = $tx5; # put back first split
								splice (@lnbits, $i2, 0, @sp11); # insert 1 or 2 new items
								$cnt = @lnbits; ### ADJUST COUNT ITERATOR
								$ichg++;
							}
						}
						$msg = $tx2; # put original message back
					}
				} else {
				## not begin quote ' or ", nor begin # ...
					### and is NOT if (($ch eq '$') || ($ch eq '@') || ($ch eq '%')) {
					$tx3 = $tx2;
					my $c3 = gotdelim($tx3);
					###if ( length($tx3) && ($c3) ) {  # got first split point
					if ( ($ln) && ($c3) ) {  # got first split point
						$pos1 = index ($tx3,$c3);
						if ( $pos1 > 0 ) { # if the first char, or ...
							### we have something, a million other variations
							##my $ts = '\\';
							##$ts .= $c3;
							##@sp11 = split ($ts, $tx3);
							$tx5 = substr ($tx3, 0, $pos1); # get up to CHAR
							###@sp11 = ($tx5, $c3);
							@sp11 = ($c3);
							$tx3 = substr ($tx3, ($pos1 + 1)); # get ending text, if any
							if (length($tx3)) {
								push(@sp11, $tx3); # put in slurp
							}
							###if (($c3 ne ':') && ($c3 ne '=') && ($c3 ne '|')) {
							if ( ! xceptchr($c3) ) {
								$msg = 'done Split [';
								$msg .= $tx5 . '][';
								$msg .= $c3 . ']';
								if (length($tx3)) {
									$msg .= '[';
									$msg .= $tx3 . ']';
								}
								tolog ($msg . "\n");
								$lnbits[$i2 - 1] = $tx5; # put back first split
								###splice (@lnbits, $i2, 0, $c3);
								###if (length($tx3)) {
								###	splice (@lnbits, ($i2+1), 0, $tx3);
								###}
								splice (@lnbits, $i2, 0, @sp11); # insert 1 or 2 new items
								##splice (@lnbits, ($i2 - 1), 1, @sp11); # INSERT into array at this pos
								$cnt = @lnbits; ### ADJUST COUNT ITERATOR
								$ichg++;
							}
						} elsif ( $pos1 == 0 ) {
							$tx3 = substr ($tx3, ($pos1 + 1)); # get ending text, if any
							if (length($tx3)) {
								@sp11 = ($c3, $tx3); # put in slurp
								### if (($c3 ne ':') && ($c3 ne '=') && ($c3 ne '|')) {
								if ( ! xceptchr($c3) ) {
									$msg = 'DONE SPLIT [';
									$msg .= $c3 . '][';
									$msg .= $tx3 . ']';
									##tolog ($msg . "\n");
									$msg .= "\n";
									push(@logmsgs,$msg);
									###tolog (@sp11 . "\n");
									##splice (@lnbits, ($i2 - 1), 1, @sp11); # INSERT into array at this pos
									$lnbits[$i2 - 1] = $c3; # put back first split
									splice (@lnbits, $i2, 0, $tx3);
									$ichg++;
									$cnt = @lnbits; ### ADJUST COUNT ITERATOR
								}
							}
						} else {
							###	last;
							die "ERROR: Unresolved POSITION - can not happen ...\n";
						}
					} # process $tx3
				}
				#########################################
				$msg = $tx2;
				if ($c && ! xceptchr($c) ) {
					$msg .= ' *D ';
					$msg .= $c;
					$msg .= '* ';
				}

				if ( exists $HResWds{$tx2} ) {
					$msg .= ' *B*'; ### blue('R');
					$i3++;
				}
				if ( exists $HBFuncs{$tx2} ) {
					$msg .= ' *P*';
					$i3++;
				}

				if ( $ln < 3 ) {
					### tolog ( "*PUNC* CHECK [" . $tx2 . "]\n" );
					if ( ispunctuat ( $tx2 ) ) {
						$msg .= ' *PUNC*';
					}
				}

				#########################################
			}

			### tolog ($msg . "\n");
			$msg .= "\n";
			push(@logmsgs,$msg);

		} # for array list of line components

		$nct = @lnbits;
		if ($cnt != $nct) {
			die "***FIX a COUNT UPDATE $cnt $nct $cntorg ????\n";
		}
		if ($cntorg == $nct) {
			$msg = ("} end comps $cntorg\n");
		} else {
			$msg = ("} end comps $cntorg, adj. $nct " . ($cntorg - $nct) . "\n");
		}

		push(@logmsgs,$msg);

		if ($ichg || $verb2) {
			tolog ( "Run 2 Made " . $ichg . " changes in line - CHECK CHANGE\n" );
			foreach $msg (@logmsgs) {
				tolog($msg);
			}
		} else {
			### no change
			if ($verb2) {
				tolog ("Run 2 - No change\n");
			}
		}

		tolog ("########### output run ###############################\n") if $verb2;

		### tolog ("{{ $nct");
		@logmsgs = ();
		$msg = ("{{ $nct");
		push(@logmsgs,$msg);

		### perpare for HTML output
		###########################

		$tx3 = ''; # clear FRONTEND output
		### $tx3 = $txsp; # get the FRONTEND SPACE
		if (($c1 eq ' ') || ($c1 eq "\t")) {
			die "ERROR: Missed a case above ...\n" if ! $gotfes; # MISS FRONTEND SPACE
			### $tx3 .= ' '; # add last space back
			$tx3 = white(htmlise($txsp));
			## $tx3 = '&nbsp; ';
			## $tx3 = htmlise($txsp); # space to HTML
			if ($verb2) {
				$msg = "\nSpace=[\n";
				$msg .= $txsp;
				$msg .= "]\n[";
				$msg .= $tx3;
				$msg .= ']';
				tolog ($msg . "\n");
			}
		} else {
			die "ERROR: Missed a case above ...\n" if $gotfes; # MISS FRONTEND SPACE
		}


		#############################################
		$i3 = 0; # init COUNTER
		my $func;
		$i2 = 0;
		$i = 0;
		$ln = 0;
		foreach $tx2 (@lnbits) { # process for OUTPUT
			### we have @copybits = @lnbits; ### take a SNAP of this QUOTE ONLY EXPANSION
			if ($i3) { # was (length($tx3)) {
				### this should REMEMBER the original 'line-spacing', and re-apply it now
				$tx6 = substr ($tx6, $ln); ### get next line 'bit'
				### note, no actual CHECK that they are the EQUAL!!!
				### if ($msg eq $tx2) { ### should work also ...
				if (length($tx6)) {
					$nct = 0; ### no SPACE addition yet
				} else {
					$i2++; ### bump to NEXT
					$tx6 = $copybits[$i2]; ### get the 'copy', for 'formatting'
					$i = length($tx6); ## len of COPY
					$c1 = substr ($tx6, 0, 1); ### and first char
					$nct = 1; ### add back SPACE, per original file
				}
				if ($nct) {
					###$tx3 .= white(' '); # add back 'space' between LINE components
					$tx3 .= ' '; # add back 'space' between LINE components/bits
				}
			} else {
				## first, so no space added = START 'spacer' 
				$tx6 = $copybits[$i2]; ### get the 'copy', for 'formatting'
				$i = length($tx6); ## len of COPY
				$c1 = substr ($tx6, 0, 1); ### and first char
			}

			$ln = length($tx2); # length this line 'bit'
			$c = substr ($tx2, 0, 1); # get FIRST CHAR
			$msg = $tx2; # get copy of the line
			$tx5 = htmlise($msg); # make it HTML form
			### case of the first CHARACTER - established TYPE of this line bit
			if ($c eq '#') { # comment component - should be to end-of-line, or more ...
				$func = \&orange;
			} elsif ($c eq "'") { ## "' # does it start with quotes DOUBLE or SINGLE
				$func = \&green;
			} elsif ($c eq '"') {
				$func = \&color3;
			} elsif ($c eq '$') {
				# start of scalar
				$func = \&color1;
			} elsif ($c eq '@') {
				# start of array
				$func = \&match;
			} elsif ($c eq '%') {
				# start of hash
				$func = \&peach;
			} elsif ( exists $HResWds{$tx2} ) {
				$func = \&blue;
			} elsif ( exists $HBFuncs{$tx2} ) {
				$func = \&color2;
			} else {
				$func = \&white;
			}

			$msg = $func->($tx5); # get the HTML form mainly '<' -> '&lt;' changes
			$tx3 .= $msg;
			###tolog (' [' . $msg . ']');
			###tolog (' [' . $tx2 . ']');
			$msg = (' [' . $tx2 . ']');
			push(@logmsgs,$msg);
			$i3++; ## count a line item
			$msg = $tx2; ### keep LAST line 'bit' ...
		} ### loop while line 'bits'

		##### done line output #####
		### tolog ("}}\n");
		$msg = ("}}\n");
		push(@logmsgs,$msg);
		foreach $msg (@logmsgs) {
			tolog($msg);
		}
		$tx3 .= "<br>\n";
		### tolog ($tx3);
		prt ($tx3);
		#######################################################
	} ### comment line summarily dealt with ...
}

### globals
### my $htmsps = 0;
### my $htmnbs = '';
sub htmlise {
	my ($txt) = @_;
	$htmsps = 0;
	$htmnbs = '';
	# convert to HTML
	$txt =~ s/\t/$tab_stg /g; # substitute TAB characters
	$txt =~ s/"/&quot;/g; # sub double quotes
	$txt =~ s/\</&lt;/g; # sub less than tag beginning
	$txt =~ s/\>/&gt;/g; # and html/xml tag ending
	my $ln = length($txt); # get the final length
	if (substr ($txt, 0, 1) eq ' ') { # if starts with a space
		### my $htmsps = 0;
		### my $htmnbs = '&nbsp;';
		## $htmsps = 0;
		$htmnbs = '&nbsp;';
		for ($htmsps = 1; $htmsps < $ln; $htmsps++) {
			if (substr ($txt, $htmsps, 1) ne ' ') {
				last;
			}
			$htmnbs .= '&nbsp;' if $htmsps > 1;
		}
		$htmsps-- if $htmsps > 1; # back off last space, if more than 1
		tolog ("Replacing $htmsps with [$htmnbs] ...\n") if $verb2;
		$txt =~ s/ {$htmsps}/$htmnbs/; # replace (N) spaces with '&nbsp; x N
		if ($verb2) {
			my (@vals) = split;
			while (@vals) {
				my ($vc) = shift (@vals);
				tolog ("[$vc] ");
			}
			tolog ("\n");
		}
	} # if it was space beginning

	#if ($func) {
	#	$txt = $func->($txt);
	#}
	#$txt .= "<br>\n";
	return $txt;
}

sub gotdelim {
	my ($tx) = @_;
	my $c;
	my $mx = length($DELIMITER); ### = '(){}[]-+*/=~!&|<>?:;.,';
	my @ar = split (//, $DELIMITER);
	my $i = 0;
	foreach $c (@ar) {
		my $ts = '\\';
		$ts .= $c;
		if ($tx =~ /$ts/) {
			# return 1;
			return $c;
		}
		$i++;
	}
	return 0;
}

sub ispunctuat {
	my ($cp) = @_;
	foreach my $cc (@PPunct) {
		###tolog ("Comaring [$cc] with [$cp]...\n");
		if ($cc eq $cp) {
			return 1;
		}
	}
	return 0;
}

my @PPairs = (
	"<", ">",
	"<%", "%>",
	"{", "}",
	"[", "]",
	"(", ")",
	);
	
my @DolVars = ( "\$1", "\$2", "\$3",
	"\$&", "\$<", "\$>", "\$'", "\$*",
	"\$@", "\$`", "\$\\", "\$!", "\$[",
	"\$]", "\$^", "\$^A", "\$^F",
	"\$^H", "\$^I", "\$^L", "\$^M",
	"\$^O", "\$^P", "\$^T", "\$^W", "\$^X",
	"\$:", "\$,", "\$.", "\$=", "\$-",
	"\$(", "\$)", "\$%", "\$+", "\$?",
	"\$\"", "\$;", "\$/", "\$~",
	"\$_", "\$|"
	);

my @PBPunc = (
	"(?!)", "(?!...", "(?:)",
	"(?...)", "(?=)", "(?#)", "(?i)"
	);

sub showarrcnts {
	my $i = @PPunct;
	tolog ("PPunct array count = $i\n");
	$i = @PPairs;
	tolog ("PPairs array count = $i\n");
	$i = @DolVars;
	tolog ("DolVars array count = $i\n");
	$i = @PBPunc;
	tolog ("PBPunc array count = $i\n");
}



### EOF
