Generated: Sun Aug 21 11:10:39 2011 from c2h01.pl 2010/09/22 36.7 KB.
#!/usr/bin/perl -w # NAME: c2h01.pl # AIM: Convert a C/C++ file to HTML, adding color # 22/09/2010 - review, and improve # 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 my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); #require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); my $load_log = 0; # load LOG at end my $in_file = ''; my $out_file = $perl_dir."\\tempc2h.htm"; my $debug_on = 0; # run without commands my $def_file = 'C:\GTools\ConApps\OpenGL\ogl02\ogl01.cxx'; #my $def_file = 'temp1.c'; #my $def_file = 'c:\Projects\Tidy\tidydev\console\tidy2.c'; #my $def_file = 'c:\GTools\tools\testap3\testDib.cxx'; #my $def_file = 'c:\GTools\tools\testap3\testMag.cxx'; #my $def_file = 'c:\FG\FGCOM\xmlrpc-c\examples\auth_client.c'; #my $def_file = 'c:\FG\FGCOM\xmlrpc-c\examples\xmlrpc_sample_add_server_w32httpsys.c'; #my $def_file = 'c:\FG\FGCOM\xmlrpc-c\lib\abyss\src\server.c'; #my $def_file = 'temp1.c'; # 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 = $perl_dir."\\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> </td>\n"; $msg .= "<td> </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,$load_log); 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 ' ' # 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 ... 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/ / /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 '&' to avoid interpreting as replacement # 2. Convert '<' to '<' and '>' to '>', to avoid interpreting as HTML # 3. Convert '"' to '"' # 4. Convert '\t' to SPACES # 5. Finally, if there are double or more SPACES, convert to ' ' ########################################################################### sub html_line { my $t = shift; my $ot = $t; $t =~ s/&/&/g; # all '&' become '&' $t =~ s/</</g; # make sure all '<' is/are swapped out $t =~ s/>/>/g; # make sure all '>' is/are swapped out $t =~ s/\"/"/g; # and all quotes become " $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> $titlee </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> $titlee </h1> <p class="top"><a href="index.htm">index</a></p> <p>$msgg </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> <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 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 ); } # =============================================== sub give_help { prt("$pgmname [Options] input_file\n"); prt("Version: 0.1.1 22/09/2010\n"); prt("Options:\n" ); prt(" --help (-h or -?) = This brief HELP.\n" ); prt(" --out <file> (-o) = Set the OUTPUT file. This file will be overwritten if exists!\n" ); prt(" --load-log (-l) = Set to load log at end.\n"); prt("Purpose:\n"); prt(" Load the input file, and process as a C/C++ file, and output color coded HTML\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) = @_; my ($arg,$rarg,$ch); while (@av) { $arg = $av[0]; $ch = substr($arg,0,1); if (($ch eq '-')||($ch eq '/')) { $rarg = substr($arg,1); $rarg = substr($rarg,1) while ($rarg =~ /^-/); if (($rarg eq '?')||($rarg =~ /^h/i)||($rarg =~ /^version$/)) { give_help(); } elsif ($rarg =~ /^o/i) { need_arg(@av); shift @av; $rarg = $av[0]; $out_file = $rarg; prt( "Setting output file to [$out_file] ...\n" ); } elsif ($rarg =~ /^l/i) { $load_log = 1; } else { prt( "ERROR: Invalid argument [$arg] ...\n" ); give_help(); } } else { $in_file = $arg; prt( "Setting input file to [$in_file] ...\n" ); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; prt( "Setting input file to [$in_file] ...\n" ); } if (length($in_file) == 0) { prt( "ERROR: No input file in command!\n" ); exit(1); } if (! -f $in_file) { mydie( "ERROR: Can NOT locate file [$in_file]. Check name, location ...\n" ); } } # eof - c2h01.pl