#!/perl -w
# NAME: c2h01.pl
# AIM: Convert a C/C++ file to HTML, adding color
# 09/11/2007 - geoff mclane - http://geoffair.net/mperl

use strict;
use warnings;
use File::Basename;	# to split path into ($name, $dir, $ext)
use File::stat; # to get the file date

require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
	my @tmpsp = split(/\\/,$pgmname);
	$pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );

#my $in_file = 'temp1.c';
my $in_file = 'c:\Projects\Tidy\tidydev\console\tidy2.c';
#my $in_file = 'c:\GTools\tools\testap3\testDib.cxx';
#my $in_file = 'c:\GTools\tools\testap3\testMag.cxx';
#my $in_file = 'c:\FG\FGCOM\xmlrpc-c\examples\auth_client.c';
#my $in_file = 'c:\FG\FGCOM\xmlrpc-c\examples\xmlrpc_sample_add_server_w32httpsys.c';
#my $in_file = 'c:\FG\FGCOM\xmlrpc-c\lib\abyss\src\server.c';
#my $in_file = 'temp1.c';
my $out_file = 'tempc2h.htm';
# USER variables
my $tab_space = '   '; # note tabs to 3 spaces - change if desired
my $out_html = 1;	# output HTML file
my $add_used = 0;	# add a table of USED reserved words
my $colrwinwds = 1;	# add color to known WIN32 words
my $addcolortable = 1;	# show color table (add_color_table)

my @delimiters = ( ' ', ',', '(', ')', '{', '}', '[', ']', '-', '+', '*', '%', '/', '=', '"', "'", '~',
'!', '&', '|', '<', '>', '?', ':', ';', '.', '#', "\t" );

my %usedreswords = ();
my @reswords = qw( __int64 auto bool break case catch char cerr cin class const continue
cout default delete do until double else enum explicit extern float for friend goto
if inline int long namespace new operator private protected public register return
short signed sizeof static struct switch template this throw true try typedef union unsigned
virtual void volatile while __asm __fastcall __based __cdecl __pascal __stdcall __inline
__multiple_inheritance __single_inheritance __virtual_inheritance
size_t warning disable message __DATE__ __TIME__ );

my @winwords_ORG = qw( RECT LOWORD SetMapMode DeleteObject RGN_DIFF WaitMessage
GetBitmap CDC HDC FALSE POINT ReleaseDC  
LPARAM HWND PostMessage HANDLE 
PeekMessage CreateSolidBrush 
DeleteDC ReleaseCapture PS_SOLID CreateCompatibleBitmap
DPtoLP GetObject CPen HRGN HIWORD SRCINVERT GetWindowRect 
PM_REMOVE SIZE SelectObject TRUE  
StretchBlt HBRUSH PSIZE CombineRgn FillRgn SRCCOPY ellipse 
SetBkColor BOOL CBitmap CreateBitmap SRCAND 
CBrush WM_MOUSEFIRST MSG WM_MOUSELAST BitBlt WM_LBUTTONUP 
CreateCompatibleDC COLORREF HBITMAP HPALETTE GetMapMode GetDC 
BITMAP CreateEllipticRgn LPSTR SetCapture NULL CreateRectRgn
RGB LONG INT BYTE DWORD WORD BITMAPINFOHEADER WM_SIZE RealizePalette
BI_JPEG BI_RLE4 BI_RLE8 BI_PNG BI_RGB BI_BITFIELDS 
RGBTRIPLE RGBQUAD LPSTR PTSTR HPALETTE BITMAPCOREHEADER BITMAPV5HEADER BITMAPV4HEADER 
HANDLE BITMAP LPBITMAPINFOHEADER LPBITMAPCOREHEADER LPBITMAPINFO MAKELONG LPDWORD 
UNICODE _UNICODE fopen fclose getenv stat malloc free strcpy strdup fread sscanf strlen 
ENOENT ENOMEM strchr strrchr strcmp strcat qsort stderr rename assert _getcwd exit 
printf fprintf strncpy main sprintf abort );

my @windefines = qw( RECT LOWORD RGN_DIFF CDC HDC FALSE POINT
LPARAM HWND HANDLE HRGN HIWORD SRCINVERT PM_REMOVE SIZE TRUE  
HBRUSH PSIZE SRCCOPY BOOL SRCAND WM_MOUSEFIRST MSG WM_MOUSELAST WM_LBUTTONUP 
COLORREF HBITMAP HPALETTE BITMAP LPSTR NULL RGB LONG INT BYTE DWORD WORD 
BITMAPINFOHEADER WM_SIZE BI_JPEG BI_RLE4 BI_RLE8 BI_PNG BI_RGB BI_BITFIELDS 
RGBTRIPLE RGBQUAD LPSTR PTSTR HPALETTE BITMAPCOREHEADER BITMAPV5HEADER BITMAPV4HEADER 
HANDLE BITMAP LPBITMAPINFOHEADER LPBITMAPCOREHEADER LPBITMAPINFO MAKELONG LPDWORD 
UNICODE _UNICODE ENOENT ENOMEM );

my @winfunctions = qw( SetMapMode DeleteObject WaitMessage
GetBitmap ReleaseDC PostMessage PeekMessage CreateSolidBrush 
DeleteDC ReleaseCapture PS_SOLID CreateCompatibleBitmap
DPtoLP GetObject GetWindowRect SelectObject StretchBlt 
CombineRgn FillRgn ellipse SetBkColor CreateBitmap
BitBlt CreateCompatibleDC GetMapMode GetDC CreateEllipticRgn LPSTR SetCapture NULL CreateRectRgn
RealizePalette );

my @stdlibitems = qw( fopen fclose getenv stat malloc free strcpy strdup fread sscanf strlen 
ENOENT ENOMEM strchr strrchr strcmp strcat qsort stderr rename assert _getcwd exit 
printf fprintf strncpy main sprintf abort );

# just a sort of forget em list
my @notreswords = qw( errout left db hdcDst old4 old3 dcTemp SecureZeroMemory rgn1 elapsed 
cx iret dcAnd MAGSTR centry cy old DrawColoredEllipse pms 
top Cleanup clrTransparency bitmapAnd rgn3 dcIn bitmapXor bitmapTemp 
tm size TmStamp dcXor sz sprtf stlx mtly TEST_Magnify 
centrx rc stly hbrclrTransparency tagMAGSTR DBG_HDC2BMPFILE bitmap2 hbr bottom 
bitmap PMAGSTR right mtlx dcImg MALLOC old2 MFREE rgn2 
old5 wBitCount  dwClrCnt  wClrCnt DIB_RGB_COLORS pv hMemDC  stBmpV5Hdr 
FindDIBBits comp bRet hMemDC WIDTHBYTES stBmpCoreHdr 
DibInfo_NOT_USED m_sDIBSize lpDIB OffsetToColor g_wm_size PaletteSize DVGlobalUnlock Process_DIB
IS_CORE_DIB lpBits bits DIBNumColors hOldPal  
DVGlobalLock hDIB DIBWidth biCompression GHND lpbi
hDIB Bitmap dwBitCount DIBNumColors_NOT_USED bmInfoHdr IS_WIN30_DIB *lpbi m_hDIB DVGlobalFree 
bcHeight OffsetToColor GetColorCnt dwClrUsed lpbmInfoHdr CalcDIBColors DrawBitmap DIBPaletteSize 
GetDIBits DIBCompression dwBC bmInfoHdr lpbmi stBmpInfoHdr 
lpdw pDIBHeader lpdw hPal IS_V4_DIB InitBitmapInfoHeader biClrUsed dwi 
BMPToDIB dwSize m_hBitmap DIBBitCount DVGlobalAlloc lpbmc hbi bcBitCount 
hdc DIBBitCount DIBHeight biWidth SelectPalette biBitCount bmBitsPixel wClrCount *lpbmInfoHdr 
BitmapFromDib OffsetToBits lpBits GetColorCnt biSizeImage biHeight DIBCompressionStg 
CalcDIBColors stBmpV4Hdr lpbc bcWidth dwClrCnt wClrCnt 
*lpdw OffsetToBits 0L hBitmap hWnd Out_Bmp_Hdr_Size Bitmap bmPlanes 
hOldPal DVBitmapToDIB lpbmInfoHdr hbm IS_V5_DIB biSize bmWidth bmHeight 
 pc3 homepath tmbchar name1 tidyGetNextOption printOption TidyWriteBack 
isAutoBool ro valfmt *pc3 is2 TidyAccessibilityCheckLevel 
eqconfig CMDLIST tidy_Set_Access *c2 TidyIndentSpaces imu CmdOptCatLAST stg 
unknownOption tidy_SetBool TidyInlineTags GetAllowedValuesFromPick tidy_Check_Number argc ul c1buf CMDSERVB
version GetAllowedValues pcmdlist val tidyReleaseDate TidyQuiet tidy_Get_Name3 OptionFunc OptionPrint 
CHKMEM pgm_exit *e2_ pcllast TidyOptionId outfil TidyString iargc 
remove PrintAllowedValuesFromPick TidyHtmlOut filename1 arg *s tidy_Set_Wrap no CMDSERV2 
*cutToWhiteSpace ctmbstr argv pcl id TidyEncoding contentWarnings TidyWrapLen 
tidyParseStdin TidyEmacs TIDY_USER_CONFIG_FILE *arg optionvalues tidyOptIsReadOnly TidyNewline TidyXmlTags *c2buf 
type c2buf tidyWarningCount cname2 homedrive print_xml_help_option_element tidyOptGetDeclTagList status 
fp tmbstr ForEachOption tidyOptGetNextDocLinks valueX cmdopt_defs sargv tidyOptResetToDefault TidyOption 
printXMLOption tempdefs TidyOutCharEncoding tidyOptSetBool yes name2 strcasecmp 
dncmd escpName cwd desc cmdtable out PLATFORM_NAME 
*CMDSERVB element arg2 PCMDLIST Process_Args num SUPPORT_ASIAN_ENCODINGS TidyMakeBare 
ulong save_commands l1 tidyGetOptionList html pos PrintAllowedValues *c1 
tidyOptGetValue sarg dupe pc2 optionX optTyp single_letters 
tidy_Conf_File tidySaveStdout cmdopt_catname TidyInteger TidyMakeClean accessWarnings *c3 bgnui 
cname3 cmd *OptionPrint PCMDTABLE1 defined optionhelp tidyOptGetDoc TIDY_CONFIG_FILE ui 
tidy_Check_Arg2 tidyRelease *p *sdef foo wraplen TidyEmptyTags tidySetCharEncoding larg2 
prog TIDY_MAX_ARGS TIDY_MAX_PATH tidyOptGetDocLinksList tidyOptGetEncName tidyOptGetPickList contentErrors TidyInCharEncoding 
AllOption_t TidyOutFile ex Tidy_Get_Cmd_Opt_Ptr TidyMarkup CmdOptDesc *CMDSERV2 config 
FILE printXMLCrossRef file tidy_Help tidy_Set_Err CmdOptCategory xml_help 
cmpOpt wrap get_pcl_count *OptionFunc print_help_option tidyLoadConfig tidyCleanAndRepair htmlfil CmdOptFileManip 
name tidyOptGetCategory tidyErrorCount get_end_ptr cname1 l3 haveVals pval c3buf 
mnemonic idef *d TidyIndentContent sargs larg tidy_Conf_Help TidyBoolean TidyConfigCategory 
tidy_Show_CWD tidyOptGetCurrPick TidyShowMarkup tidyOptGetNextDeclTag tidy_strdupe GetOption _CMDLIST 
TidyForceOutput COMP_AT COMP_ON tidy_NewIndent helpul post 
err TidyDuplicateAttrs name3 flag pc1 aux TidyHideEndTags TidyBlockTags 
TidyUpperCaseTags tidy_Get_Name1 doc errfil *e1 CmdOptCatFIRST cnt cutToWhiteSpace samefile 
serv2 st_size tidyOptSetInt tdoc optId *c3buf TidyDoctypeMode bak 
cargv getSortedOption TidyLanguage tidyOptGetId TidyPreTags tidy_Set_Lang printOptionValues 
servb tidyRunDiagnostics tidy_UnsetBool topt TidyOptionType e2_ ForEachSortedOption TidyPrettyPrint 
tidyOptSetValue *c printXMLDescription show_commands tidyFileExists tidy_Shw_Conf optLinked CmdOptMisc 
tidy_Set_Out OptionDesc *pc1 TidyXhtmlOut tidyRenameFile tidyAccessWarningCount tidySetErrorFile TidyNumEntities print2Columns 
uint print_xml_help_option N_TIDY_OPTIONS tidy_Get_Name2 *topt cfgfil tidyrc *c1buf 
cat tOption filename2 *sbuf tidy_Xml_Help tidyCreate COD tidyOptGetNextPick 
l2 tidy_Xml_Conf get_pcl_item TidyErrFile nfields tidy_Set_Encoding Bool get_escaped_name serv3 
tidy_SetIndent sbuf tidyErrorSummary helpfmt TidyIterator vals tidyOptGetName CmdOptProcDir *tOption 
Process_Input tidyOptGetInt get_option_names sdef TidyEmacsFile tidy_Fix_Error_File TidyCharEncoding TidyDoc 
acclvl len TidyDoctype *pc2 pcll TidyDiagnostics *arg2 ConfigCategoryName 
optid tidyOptGetBool help tidyOptParseValue ARG_UNUSED e1_ tidy_Show_Vers print3Columns TidyMiscellaneous 
fmt offset XMLoptionhelp link ret first CMDTABLE1 *e2 
tidyParseFile tidyOptGetType fbuf tidySaveFile TidyAutoState CmdOptCharEnc );


# each preceeded by '^\s*#\s*\w+' ...
my %useddirectives = ();
my @directives = qw( define error include elif if line else ifdef pragma endif ifndef undef );

my %wordlist = ();

# debug
my $dbg1 = 1;	# load output LOG file
my $dbg2 = 0;
my $dbg3 = 0;
my $dbg4 = 0;
my $dbg5 = 0;	# show directive processing ...
my $dbg6 = 0;	# show each character
my $dbg7 = 0;	# show when delimiter, and length $done ...
my $dbg8 = 0;	# show adding to ...
my $dbg9 = 0;	# show setting done to ...
my $dbg10 = 0;	# show Got done length ...
my $dbg11 = 0;	# show sorting
my $dbg12 = 0;	# show each line

# coloring
my $a_class = 'a'; # RED
my $b_class = 'b'; # comments (#006666)
my $c_class = 'c'; # reserved words (blue)
my $e_class = 'e';# known WIN32 words
my $t_class = 't'; # quoted - single and double (#006600)

my $red_count = 0;
my $comm_count = 0;
my $blue_count = 0;
my $win_count = 0;
my $quot_count = 0;
###set_all_debug();

parse_args(@ARGV);

my ($nm, $dir, $ext) = fileparse( $in_file, qr/\.[^.]*/ );
my $in_title = $nm . $ext; # build TITLE
my $sb = stat($in_file);
my @hlns = process_file($in_file);
my $nlc = scalar @hlns;
$out_file = 'temp.'.$nm.'.htm';
prt( "Writing $nlc lines to $out_file ...\n" );
my $tit = "$in_title to HTML";
my $cur_tm = localtime(time());
my $msg = "Generated: On $cur_tm,\n<br>From: $in_file, dated ".scalar localtime($sb->mtime).", with size ".$sb->size." bytes.";
my $tmsg = "GA: Generated by $pgmname, on $cur_tm, from $in_title";
if ($out_html) {
	# output a full HTML file
	write_head( $out_file, $tit, $msg );
	open_pre( $out_file );
	append2file(join("\n",@hlns), $out_file);
	close_pre( $out_file );
	if ($add_used) {
		my @tblitems = ();
		my $key = '';
		my $kct = 0;
		my $totct = 0;
		my $conct = 0;
		foreach $key (keys %usedreswords) {
			$kct = $usedreswords{$key};
			push(@tblitems, [ $kct, $key ]);
			$totct += $kct;
			if ($key eq 'const') {
				$conct = $kct;
			}
		}
		my @sresults = sort mycmp_decend @tblitems;
		my $wrap = 9;
		my $ccnt = 0;
		my $tcnt = scalar @sresults;
		$key = $sresults[0][1];
		$kct = $sresults[0][0];
		$msg = "<p>Table of $tcnt used reserve words. The MOST used is '".add_blue($key)."', at $kct times ...</p>\n";
		$msg .= "<table align=\"center\" border=\"2\" summary=\"table of $tcnt reserved word usage\">\n";
		$msg .= "<tr>\n";
		for (my $j = 0; $j < $wrap; $j++) {
			$msg .= "<th>Word</th>\n";
			$msg .= "<th>Count</th>\n";
		}
		$msg .= "</tr>\n";
		for (my $i = 0; $i < $tcnt; $i++) {
			$key = $sresults[$i][1];
			$kct = $sresults[$i][0];
			$msg .= "<tr>\n" if ($ccnt == 0);
			if ($i == 0) {
				$msg .= "<td><b>".add_red($key)."<b></td>\n";
				$msg .= "<td align=\"right\"><b>$kct</b></td>\n";
			} else {
				$msg .= "<td>".add_blue($key)."</td>\n";
				$msg .= "<td align=\"right\">$kct</td>\n";
			}
			$ccnt++;
			if ($ccnt >= $wrap) {
				$msg .= "</tr>\n";
				$ccnt = 0;
			}
		}
		if ($ccnt) {
			while ($ccnt < $wrap) {
				$ccnt++;
				$msg .= "<td>&nbsp;</td>\n";
				$msg .= "<td>&nbsp;</td>\n";
			}
			$msg .= "</tr>\n";
		}
		$msg .= "</table>\n";

		$key = $sresults[0][1];
		$kct = $sresults[0][0];
		if ($kct) {
			my $pc = ($kct / $totct) * 10000;
			my $pct = (int($pc) / 100);
			$msg .= "<p>The word '".add_blue($key)."' accounts for $pct\% of the total, $totct reserved word uses...</p>\n";
		}

		append2file( $msg, $out_file );
	}
	add_color_table( $out_file ) if ($addcolortable);
	append_tail( $out_file, $tmsg );
	system($out_file);

} else {
	prt( "\nHTML stream ...\n\n" );
	prt( "<pre class=\"code\">" );
	foreach my $ln (@hlns) {
		prt( "$ln\n" );
	}
	prt( "</pre>\n\n" );
}

out_used_words();

close_log($outfile,$dbg1);

exit(0);

###############################################################################
### subs

sub is_handled {
	my ($a, $b) = @_;
	if( ($a eq '/') && ($b eq '/') ) {
		return 1;	# start of line comment
	} elsif ( ($a eq '*') && ($b eq '/') ) {
		return 1;	# start of block comment
	}
	return 0;
}

sub out_used_words {
	my $wpl = 0;
	my $wcnt = scalar keys(%wordlist);
	my $cnt = 0;
	my $tcnt = 0;
	prt( "\nDisplay of $wcnt words used not in reserved, windows, or ignore word list ...\n" );
	foreach my $wd (keys %wordlist) {
		$cnt = $wordlist{$wd};
		$tcnt += $cnt;
		###prt( "[$wd] " );
		prt( "$wd " );
		$wpl++;
		if ($wpl > 8) {
			prt("\n");
			$wpl = 0;
		}
	}
	prt("\n") if ($wpl);
	prt( "Total of $tcnt NEW words in document ...\n\n" );
}

sub is_hex_numb {
	my ($txt) = shift;
	if ($txt =~ /^0X/i) {
		$txt = substr($txt,2);
	}
	my $tl = length($txt);
	my ($t, $c);
	for ($t = 0; $t < $tl; $t++) {
		$c = substr($txt,$t,1);
		if ( !(($c =~ /\d/)||($c =~ /[A-F]/i)) ) {
			return 0;
		}
	}
	return 1;
}

# isallnums
sub is_all_nums {
	my ($txt) = shift;
	my $tl = length($txt);
	my ($t, $c);
	for ($t = 0; $t < $tl; $t++) {
		$c = substr($txt,$t,1);
		if ( !($c =~ /\d/) ) {
			return 0;
		}
	}
	return 1;
}

sub add_word {
	my ($word) = shift;
	$word = trim_all($word);
	if ( (length($word) > 1) &&
		!is_resword($word) &&
		!is_win_word($word) &&
		!is_all_nums($word) &&
		!is_hex_numb($word) &&
		!is_not_res_word($word) ) {
		if (defined $wordlist{$word}) {
			$wordlist{$word}++;
		} else {
			$wordlist{$word} = 1;
		}
	}
}

sub process_line {
	my ($ln) = shift;
	my $ll = length($ln);
	if($ll) {
		my $word = '';
		for (my $i = 0; $i < $ll; $i++) {
			my $ch = substr($ln,$i,1);
			if ($ch =~ /\w/) {
				$word .= $ch;
			} else {
				add_word($word) if (length($word));
				$word = '';
			}
		}
	}
}

sub process_file { 
	my ($fil) = shift;
	my ($lc, $nline, $line, $ll, $i, $ch, $pch, $done, $isd, $isdr, $incomm, $ind, $word);
	my ($lnnum);
	my @hlines = ();
	$incomm = 0;
	if (open INF, "<$fil") {
		my @lines = <INF>;
		close INF;
		$lc = scalar @lines;
		prt( "Processing $lc line from [$fil]...\n" );
		$lnnum = 0;
		foreach $line (@lines) {
			$lnnum++;
			chomp $line;
			prt( "LINE: $lnnum: [$line]\n" ) if ($dbg12);
			###process_line( trim_all($line) );
			$ll = length($line);
			$i = 0;
			$isdr = ($line =~ /^\s*#\s*(\w+)/);
			$nline = '';
			if ($isdr && !$incomm) {
				$done = $1;
				$ind = index($line, $done);
				$pch = '?';
				if ($ind > 0) {
					$pch = substr($line,0,$ind);
				}
				$isd = is_directive($done);
				prt( "$lnnum: Directive: $line [$pch][$done]\n" ) if ($dbg5);
				$ch = $pch . $done;
				$nline = add_blue(html_line($ch));
				$i = length($ch);
			}

			# clear all for line (or balance of line) processing
			$isd = 0;
			$pch = '';
			$done = '';
			$ch = '';
			$ch = substr($line, $i, 1);
			while ($ch =~ /\s/) {
				$done .= $ch;
				$i++;
				$ch = substr($line, $i, 1);
			}
			$nline .= html_line($done) if length($done);
			$done = '';	# and clear it
			for ( ; $i < $ll; $i++) {
				$ch = substr($line, $i, 1);
				prt( "$lnnum:$i: Got char [$ch] ... pch=[$pch] done=[$done]\n" ) if ($dbg6);
				if ($incomm) {
					if (($pch eq '*') && ($ch eq '/')) {
						$done .= $pch . $ch;
						$incomm = 0;
						$nline .= add_comm(html_line($done));
						$ch = '';
						$pch = '';
						$done = '';
						next;
					}
				} else {
					# NOT in comment
					#######################################################
					##$isd = is_delimiter($ch);
					$isd = !($ch =~ /\w/);
					if ($isd) {	# reached a DELIMITER character - really NOT \w type
						$done .= $pch if (!is_handled($ch, $pch));	# time to add in previous
						##prt( "$lnnum:$i: ch [$ch] is delimiter...  [$done]\n" ) if ($dbg7);
						prt( "$lnnum:$i: ch [$ch] is delimiter...  [$done]\n" ) if ($dbg7 && length($done));
						if (length($done)) {
							prt( "$lnnum:$i: Got done length [$done] ...\n" ) if ($dbg10);
							if (is_resword($done)) {
								###prt( "Adding BLUE[$done] to new [$nline]\n" );
								$nline .= add_blue(html_line($done));
							} elsif ( $colrwinwds && is_win_word($done) ) {
								$nline .= add_winword(html_line($done));
							} else {
								###prt( "Adding [$done] to new [$nline]\n" );
								$nline .= html_line($done);
								add_word($done) if (length($done));
							}
							$done = '';
						}
						# $done HAS BEEN CLEARED
						if ($ch eq '/') {
							if ($pch eq '/') {
								# start of line COMMENT
								$nline .= add_comm( html_line(substr($line,($i - 1))) );
								$ch = '';
								$pch = '';
								$i = $ll;
								last;
							}
						} elsif ($ch eq '*') {
							if ($pch eq '/') {
								# start of block comment
								$incomm = 1;
								$done = $pch . $ch; # start block comment
								$i++;
								$pch = '';
								for (; $i < $ll; $i++) {
									$ch = substr($line, $i, 1);
									$done .= $ch;
									if (($pch eq '*') && ($ch eq '/')) {
										$incomm = 0;
										last;
									}
									$pch = $ch;
								}
								$nline .= add_comm(html_line($done));
								$ch = '';
								$pch = '';
								$done = '';
							}
						} elsif ($ch eq '"') {
							$done = $ch;
							$i++;
							$pch = $ch;
							for (; $i < $ll; $i++) {
								$ch = substr($line, $i, 1);
								$done .= $ch;
								if (($ch eq '"')&&($pch ne "\\")) {
									last;
								}
								$pch = $ch;
								$ch = '';
							}
							$nline .= add_quot(html_line($done));
							$ch = '';
							$pch = '';
							$done = '';
						} elsif ($isdr && ($ch eq '<')) {
							prt( "$lnnum:$i: Setting done[$done] to $ch\n" ) if ($dbg9);
							$done = $ch;
							$i++;
							for (; $i < $ll; $i++) {
								$ch = substr($line, $i, 1);
								$done .= $ch;
								if ($ch eq '>') {
									last;
								}
							}
							$nline .= add_quot(html_line($done));
							$ch = '';
							$pch = '';
							$done = '';
						} else {
							$nline .= html_line($ch);
							$ch = '';
						}
						$pch = ''; # has already been included
					}
					#######################################################
					### else NOT a DELIMITER char ###
				}
				prt( "$lnnum: NOTDELIM: Adding [$pch] to done [$done], and set pch = [$ch]\n") if ($dbg8 && (length($pch)||length($done)));
				$done .= $pch;	# add in previous, if any
				if (!$incomm && ($ch =~ /\w/) && length($pch) && !($pch =~ /\w/)) {
					# transition from DELIMITER type to CHAR type
					# get rid of $done, if any
					prt( "$lnnum: TRANSITION - Add done [$done], and clear\n") if ($dbg8);
					$nline .= html_line($done);
					$done = '';
				}
				$pch = $ch;		# and current to previous, if any
			}
			# done this LINE OF CODE
			$done .= $ch;
			if (length($done)) {
				prt( "$lnnum:$i: Got done length [$done] ...\n" ) if ($dbg10);
				if ($incomm) {
					$nline .= add_comm(html_line($done));
				} elsif (is_resword($done)) {
					###prt( "Adding BLUE[$done] to new [$nline]\n" );
					$nline .= add_blue(html_line($done));
				} else {
					$nline .= html_line($done);
				}
			}
			push(@hlines, $nline);
		}
	} else {
		prt( "ERROR: Unable to open [$fil] ... $! ...\n" );
	}
	return @hlines;
}

sub is_resword {
	my ($wd) = shift;
	foreach my $wt (@reswords) {
		if ($wd eq $wt) {
			my $cnt = 1;
			if (defined $usedreswords{$wd}) {
				$cnt = $usedreswords{$wd};
				$cnt++;
			}
			$usedreswords{$wd} = $cnt;
			return 1;
		}
	}
	return 0;
}

sub is_directive {
	my ($wd) = shift;
	foreach my $wt (@directives) {
		if ($wd eq $wt) {
			my $cnt = 1;
			if (defined $useddirectives{$wd}) {
				$cnt = $useddirectives{$wd};
				$cnt++;
			}
			$useddirectives{$wd} = $cnt;
			return 1;
		}
	}
	return 0;
}


sub is_delimiter_not_used {
	my ($ci) = shift;
	foreach my $ct (@delimiters) {
		if ($ci eq $ct) {
			return 1;
		}
	}
	return 0;
}

sub add_red {
   my ($t) = shift;
   $red_count++;
   return ('<span class="'.$a_class.'">'.$t.'</span>');
}
# reserved words
sub add_blue {
   my ($t) = shift;
   $blue_count++;
   return ('<span class="'.$c_class.'">'.$t.'</span>');
}
sub add_comm {
   my ($t) = shift;
   $comm_count++;
   return ('<span class="'.$b_class.'">'.$t.'</span>');
}
sub add_quot {
   my ($t) = shift;
   $quot_count++;
   return ('<span class="'.$t_class.'">'.$t.'</span>');
}

sub add_winword {
	my ($t) = shift;
   $win_count++;
   return ('<span class="'.$e_class.'">'.$t.'</span>');
}

######################################################
# Converting SPACES to '&nbsp;'
# Of course this could be done just using perl's
# powerful search and replace, but this handles
# any number of spaces, only converting the number
# minus 1 to &nbsp; ... not sure how to have
# this level of control with regex replacement
######################################################
sub conv_spaces {
   my $t = shift;
   my ($c, $i, $nt, $ln, $sc, $sp);
   $nt = ''; # accumulate new line here
   $ln = length($t);
   for ($i = 0; $i < $ln; $i++) {
      $c = substr($t,$i,1);
      if ($c eq ' ') {
         $i++; # bump to next 
         $sc = 0;
         $sp = '';
         for ( ; $i < $ln; $i++) {
            $c = substr($t,$i,1);
            if ($c ne ' ') {
               last; # exit
            }
            $sc++;
            $sp .= $c;
         }
         if ($sc) {
            $sp =~ s/ /&nbsp;/g;
            $nt .= $sp;
         }
         $i--; # back up one
         $c = ' '; # add back the 1 space
      }
      $nt .= $c;
   }
   prt( "conv_space: from [$t] to [$nt] ...\n" ) if $dbg4;
   return $nt;
}

###########################################################################
# VERY IMPORTANT SERVICE
# This converts the 'text' into HTML text, but only does a partial job!
# 1. Convert '&' to '&amp;' to avoid interpreting as replacement
# 2. Convert '<' to '&lt;' and '>' to '&gt;', to avoid interpreting as HTML
# 3. Convert '"' to '&quot;'
# 4. Convert '\t' to SPACES
# 5. Finally, if there are double or more SPACES, convert to '&nbsp;'
###########################################################################
sub html_line {
   my $t = shift;
   my $ot = $t;
   $t =~ s/&/&amp;/g; # all '&' become '&amp;'
   $t =~ s/</&lt;/g; # make sure all '<' is/are swapped out
   $t =~ s/>/&gt;/g; # make sure all '>' is/are swapped out
   $t =~ s/\"/&quot;/g; # and all quotes become &quot;
   $t =~ s/\t/$tab_space/g; # tabs to spaces
   if ($t =~ /\s\s/) { # if any two consecutive white space
      return conv_spaces($t);
   }
   prt( "html_line: from [$ot] to [$t] ...\n" ) if $dbg3;
   return $t;
}


sub write_head {
	my ($fil, $title, $msg) = @_;
	my $head = <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
 <head>
  <title>
   $title
  </title>
  <meta http-equiv="Content-Language"
        content="en-us">
  <meta http-equiv="Content-Type"
        content="text/html; charset=us-ascii">
  <link rel="stylesheet"
        href="cxx.css"
        type="text/css">
 </head>
 <body>
  <a name="top"
        id="top"></a>
  <h1>
   $title
  </h1>
  <p class="top"><a href="index.htm">index</a></p>
  <p>$msg
  </p>
EOF

	write2file($head,$fil);	# create and write to file
}

sub open_pre {
	my ($fil) = shift;
	append2file("\n<pre class=\"cd\">",$fil); # append to file
}

sub close_pre {
	my ($fil) = shift;
	append2file("\n</pre>\n",$fil); # append to file
}

sub append_tail {
	my ($fil, $msg) = @_;
	my $tail = <<EOF;
  <hr class="mini">

  <p class="top">
   <a target="_self"
      href="#top">top</a>
  </p>

  <p>
   <a name="end"
      id="end"></a> <a target="_blank"
      href="http://tidy.sourceforge.net/"><img border="0"
        src="images/checked_by_tidy.gif"
        alt="checked by tidy"
        width="32"
        height="32"></a>&nbsp; <a href="http://validator.w3.org/check?uri=referer"
      target="_blank"><img src="images/valid-html401.gif"
        alt="Valid HTML 4.01 Transitional"
        width="88"
        height="31"></a>
  </p>
  <!-- $msg -->
 </body>
</html>
EOF

	append2file($tail,$fil); # append to file
}

sub mycmp_decend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $dbg11;
      return 1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $dbg11;
      return -1;
   }
   prt( "=[".${$a}[0]."] = [".${$b}[0]."]\n" ) if $dbg11;
   return 0;
}

sub is_win_word {
	my ($wd) = shift;
	###foreach my $itm (@winwords) {
	# @windefines @winfunctions @stdlibitems
	my ($itm);
	foreach $itm (@windefines) {
		if ($itm eq $wd) {
			return 1;
		}
	}
	foreach $itm (@winfunctions) {
		if ($itm eq $wd) {
			return 2;
		}
	}
	foreach $itm (@stdlibitems) {
		if ($itm eq $wd) {
			return 3;
		}
	}

	return 0;
}

sub is_not_res_word {
	my ($wd) = shift;
	foreach my $itm (@notreswords) {
		if ($itm eq $wd) {
			return 1;
		}
	}
	return 0;
}

sub give_help {
	prt( "$pgmname [OPTIONS] input_file\n");
	prt( "OPTIONS:\n" );
	prt( " -?               = This brief HELP.\n" );
	prt( " -out output_file = Set the OUTPUT file. This file will be overwritten if exists!\n" );
	mydie( "                                    Happy conversion of C/C++ to HTML ...\n" );
}

sub need_arg {
	my ($a, @b) = @_;
	if (@b) {
		# ok
	} else {
		prt( "Error: $a argument requires additional item!\n" );
		give_help();
	}
}

sub parse_args {
	my (@av) = @_;
	while (@av) {
		my $arg = $av[0];
		my $ch = substr($arg,0,1);
		if (($ch eq '-')||($ch eq '/')) {
			my $rarg = substr($arg,1);
			if (($rarg eq '?')||($rarg eq 'h')||($rarg eq 'H')) {
				give_help();
			} elsif ($rarg =~ /^out$/i) {
				need_arg(@av);
				shift @av;
				$rarg = $av[0];
				$out_file = $rarg;
				prt( "Setting output file to [$out_file] ...\n" );
			} else {
				prt( "ERROR: Invalid argument [$arg] ...\n" );
				give_help();
			}
		} else {
			$in_file = $arg;
			prt( "Setting input file to [$in_file] ...\n" );
			if (! -f $in_file) {
				mydie( "ERROR: Can NOT locate file. Check name, location ...\n" );
			}
		}
		shift @av;
	}
}

sub set_all_debug {
	$dbg2 = 1;
	$dbg3 = 1;
	$dbg4 = 1;
	$dbg5 = 1;	# show directive processing ...
	$dbg6 = 1;	# show each character
	$dbg7 = 1;	# show when delimiter, and length $done ...
	$dbg8 = 1;	# show adding to ...
	$dbg9 = 1;	# show setting done to ...
	$dbg10 = 1;	# show Got done length ...
	$dbg11 = 1;	# show sorting
	$dbg12 = 1;	# show each line
}


sub add_span {
   my ($t, $c) = @_;
   return ('<span class="'.$c.'">'.$t.'</span>');
}

# 	add_color_table( $out_file ) if ($addcolortable);
sub add_color_table {
	my ( $out ) = shift;
	my $msg = "<table width=\"100%\" summary=\"Color table\">\n";

	# .a { color:red; }
	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_red("add_red ($red_count) .a { color:red; }")."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#ff0000\">\n";
	$msg .= "add_red ($red_count) .a { color:red; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	# .c { color:#0000ff; }	/* reserved words */
	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_blue("add_blue ($blue_count) .c { color:#0000ff; }")."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#0000ff\">\n";
	$msg .= "add_blue ($blue_count) .c { color:#0000ff; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	# .b { color:#008000; }	/* green comments */
	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_comm("add_comm ($comm_count) .b { color:#008000; }")."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#008000\">\n";
	$msg .= "add_comm ($comm_count) .b { color:#008000; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	# .t { color:#A02020; }	/* quoted text - brown */
	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_quot("add_quot ($quot_count) .t { color:#A02020; }")."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#A02020\">\n";
	$msg .= "add_quot ($quot_count) .t { color:#A02020; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	# .e { color:#a000c0; }
	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_winword("add_winword ($win_count) .e { color:#a000c0; }")."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#a000c0\">\n";
	$msg .= "add_winword ($win_count) .e { color:#a000c0; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_span(".d { color:#ff8000; }", 'd')."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#ff8000\">\n";
	$msg .= ".d { color:#ff8000; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_span(".f { color:#666666; }", 'f')."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#666666\">\n";
	$msg .= ".f { color:#666666; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_span(".o { color:#008080; }", 'o')."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#008080\">\n";
	$msg .= ".o { color:#008080; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	$msg .= "<tr>\n";
	$msg .= "<td>\n";
	$msg .= add_span(".v { color:#40c000; }", 'v')."\n";
	$msg .= "</td>\n";
	$msg .= "<td bgcolor=\"#40c000\">\n";
	$msg .= ".v { color:#40c000; }\n";
	$msg .= "</td>\n";
	$msg .= "</tr>\n";

	$msg .= "</table>\n";

	append2file( $msg, $out );
}

# eof - c2h01.pl
