HTML Colorize Winbatch Script for Web Posting
Keywords: WBT2HTML HTML Colorize Winbatch Scripts
Question:
Hey! How do you guys make your script-examples look like WinBatch Studio does? In the source I notice something that sez "wbt2html" by Detlev (that guy is *so* kewl)...I want me some of that, too...
Answer:
Detlev's website has a wbt2html.wbt program that will colour code turned into HTML for you.http://home.t-online.de/home/detlev.dalitz/htm/dd390000.htm
Here is a copy of it...
;========================================================================================================================================== ; WBT2HTML v1.25,1 20020825 (c) Detlev Dalitz 2001:07:29:00:00:00 ;========================================================================================================================================== ; User information is placed at end of file. ;------------------------------------------------------------------------------------------------------------------------------------------ IntControl(73,1,0,0,0) ; Install the errorhandler. iParamError = 0 If Param0 GoSub GetParams Else Goto AskParams EndIf If !iParamError GoSub DefineUDFs GoSub UserConfigurableInit GoSub ProgInit GoSub CollectColors GoSub CollectKeywords GoSub OpenReadSourceFile If UseAutoDelimiter Then GoSub CalculateDelimiters GoSub TagQuote GoSub TagComment GoSub TagOperatorMod GoSub TagOperator GoSub TagBracket GoSub TagSpecial GoSub TagWordNumber GoSub EncodeNamedEntities GoSub ColorizeWord GoSub ColorizeNumber GoSub ColorizeSpecial GoSub ColorizeOperator GoSub ColorizeOperatorMod GoSub ColorizeBracket GoSub ColorizeComment GoSub ColorizeQuote GoSub WriteCloseTargetFile EndIf If IntControl(77,80,0,0,0) Then Return (iParamError) :CANCEL Exit ;========================================================================================================================================== :DefineUDFs ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfbytetohex",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfbytetohex #DefineFunction udfByteToHex (Byte) Return (StrCat(Num2Char(48+(Byte>>4)+(39*((Byte>>4)>9))),Num2Char(48+(Byte&15)+(39*((Byte&15)>9))))) ; lowercase ; Return (StrCat(Num2Char(48+(Byte>>4)+(7*((Byte>>4)>9))),Num2Char(48+(Byte&15)+(7*((Byte&15)>9))))) ; uppercase #EndFunction :skip_udfbytetohex ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udffilechecksum",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilechecksum #DefineFunction udfFileChecksum (sFilename, iRequest) If (VersionDLL()<"3.8hch") Then Return ("") iBBSize = FileSizeEx(sFilename) If !iBBSize Then Return ("") iRequest = Min(2,Max(0,iRequest)) hBB = BinaryAlloc(iBBSize) BinaryRead(hBB,sFilename) sChecksum = BinaryChecksum(hBB,iRequest) BinaryFree(hBB) Return (sChecksum) ;.......................................................................................................................................... ; "iRequest" specifies the type of digest or CRC to generate, ; and can be one of the following values: ; ; Request Meaning Return string format (x = hex character) ; ------- ---------- ---------------------------------------- ; 0 MD5 digest "xxxxxxxx-xxxxxxxx-xxxxxxxx-xxxxxxxx" ; 1 16-bit CRC "xxxx" ; 2 32-bit CRC "xxxxxxxx" ; ; Requires WinBatch version 2002h, 3.8hch. ;.......................................................................................................................................... #EndFunction :skip_udffilechecksum ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udffilecrc32",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilecrc32 #DefineFunction udfFileCrc32 (sFilename) iBBSize = FileSize(sFilename) If !iBBSize Then Return (0) AddExtender("wwser34i.dll") hBB = BinaryAlloc(iBBSize) BinaryRead(hBB,sFilename) iChecksum = pCheckBinary(IntControl(42,hBB,0,0,0),BinaryEodGet(hBB)-1,32) BinaryFree(hBB) Return (iChecksum) #EndFunction :skip_udffilecrc32 ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfgettemppath",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgettemppath #DefineFunction udfGetTempPath () ftemp = FileCreateTemp("TMP") FileDelete(ftemp) TempPath = FilePath(ftemp) Terminate(!DirMake(TempPath),"udfGetTempPath",StrCat("Cannot access temporary folder:",@LF,TempPath)) Return (TempPath) #EndFunction :skip_udfgettemppath ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfdirgetlong",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfdirgetlong #DefineFunction udfDirGetLong () Return (StrCat(FileNameLong(StrCat(DirGet(),".")),"\")) #EndFunction :skip_udfdirgetlong ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udsdisplaymsg",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udsdisplaymsg #DefineSubRoutine udsDisplayMsg (sMsgText) If (RtStatus()==10) Then wStatusMsg(StrCat(sProgLogo,sMsgText)) Else BoxText(StrCat(sProgLogo,sMsgText)) sMsgText = "" #EndSubRoutine :skip_udsdisplaymsg ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfitemlisttofile",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfitemlisttofile #DefineFunction udfItemListToFile (list, delimiter, filename) If (list=="") Then Return (0) list = StrReplace(list,delimiter,@CRLF) hBB = BinaryAlloc(StrLen(list)) BinaryPokeStr(hBB,0,list) num = BinaryWrite(hBB,filename) BinaryFree(hBB) Return (num) #EndFunction :skip_udfitemlisttofile ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfisprimenumber",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisprimenumber #DefineFunction udfIsPrimeNumber (iNumber) iLimit = Int(Sqrt(iNumber)) iIsPrime = 1 For i=2 To iLimit iIsPrime = iNumber mod i If !iIsPrime Then Break Next Return (iIsPrime) #EndFunction :skip_udfisprimenumber ;------------------------------------------------------------------------------------------------------------------------------------------ If ItemLocate("udfgetprimethisornext",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgetprimethisornext #DefineFunction udfGetPrimeThisOrNext (iNumber) While !udfIsPrimeNumber (iNumber) iNumber = iNumber+1 EndWhile Return (iNumber) #EndFunction :skip_udfgetprimethisornext ;------------------------------------------------------------------------------------------------------------------------------------------ Return ; from DefineUDFs ;========================================================================================================================================== ;========================================================================================================================================== ;Procedures ;========================================================================================================================================== :wbErrorHandler wbError = LastError() wbErrorMsg = "" wbErrorMsg = StrCat(wbErrorMsg,"LastError Value" ,@LF,' = ',wbError,@LF) If !wbError Then wbError = -1 wbErrorMsg = StrCat(wbErrorMsg,"LastError String" ,@LF,' = "',IntControl(34,wbError,0,0,0),'"',@LF) ; line in script that caused Error) wbErrorMsg = StrCat(wbErrorMsg,"wbErrorHandlerLine" ,@LF,' = "',wbErrorHandlerLine,'"',@LF) ; offset into script of error line, in bytes wbErrorMsg = StrCat(wbErrorMsg,"wbErrorHandlerOffset" ,@LF,' = ',wbErrorHandlerOffset,@LF) ; variable being assigned on error line, or "" If none wbErrorMsg = StrCat(wbErrorMsg,"wbErrorHandlerAssignment",@LF,' = ',wbErrorHandlerAssignment,@LF) If (wbErrorhandlerassignment>"") Then %wbErrorhandlerassignment% = "eeek" Message("wbErrorHandler",wbErrorMsg) Exit ;========================================================================================================================================== ;========================================================================================================================================== :CollectColors ; collect names and rgb color values sMsg = "Collecting colors ..." udsDisplayMsg(sMsg) ; We use the default rgb color values as defined in WSINIT.DLL and try to update them from the Current User Registry. sColorNameList = StrCat("Keyword",@TAB,"Quote",@TAB,"Comment",@TAB,"Default Text",@TAB,"Background") sColorValueList = StrCat("0,0,255",@TAB,"255,0,0",@TAB,"0,128,0",@TAB,"0,0,0",@TAB,"255,255,255") ;--- Read colors for WIL files from WinBatch Studio Registry. ----------------------------------------------------------------------------- sRegKeySub = "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files" If RegExistKey(@REGCURRENT,sRegKeySub) hRegKey = RegOpenKeyEx(@REGCURRENT,sRegKeySub,1,"","") ; Mode=1=KEY_QUERY_VALUE=Permission to query subkey data ; We only need read access. iColorCount = ItemCount(sColorNameList,@TAB) For iColor=1 To iColorCount sColorNameItem = ItemExtract(iColor,sColorNameList,@TAB) sRegKeySub = StrCat("[",sColorNameItem,"]") If RegExistValue(hRegKey,sRegKeySub) sColorValueItem = RegQueryValue(hRegKey,sRegKeySub) sColorValueList = ItemReplace(sColorValueItem,iColor,sColorValueList,@TAB) EndIf Next RegCloseKey(hRegKey) Drop(hRegKey,iColor,iColorCount,sColorNameItem,sColorValueItem) EndIf Drop(sRegKeySub) ;--- Additional colors from my own inspiration. ------------------------------------------------------------------------------------------- ; Note: Force creating new HashTable if colors have changed. sColorNameList = ItemInsert("Operator",-1,sColorNameList,@TAB) sColorValueList = ItemInsert("000,048,128",-1,sColorValueList,@TAB) sColorNameList = ItemInsert("Bracket",-1,sColorNameList,@TAB) sColorValueList = ItemInsert("032,032,032",-1,sColorValueList,@TAB) sColorNameList = ItemInsert("Number",-1,sColorNameList,@TAB) sColorValueList = ItemInsert("096,000,000",-1,sColorValueList,@TAB) sColorNameList = ItemInsert("Special",-1,sColorNameList,@TAB) sColorValueList = ItemInsert("000,032,128",-1,sColorValueList,@TAB) ;--- Additional colors from WIL.CLR inifile. ---------------------------------------------------------------------------------------------- ; for example: CON=128,0,128; EXT=255,0,255; CONSTANT=0,128,255; WED=0,128,0; UDF=128,096,048; OPERATOR=0,48,128 sFilenameWilClr = StrCat(DirHome(),"WIL.CLR") sColorList = IniItemizePvt ("COLORS",sFilenameWilClr) iColorCount = ItemCount(sColorList,@TAB) For iColor=1 To iColorCount sColorNameItem = ItemExtract(iColor,sColorList,@TAB) sColorValueItem = IniReadPvt("COLORS",sColorNameItem,"000,000,000",sFilenameWilClr) sColorValueList = ItemInsert(sColorValueItem,-1,sColorValueList,@TAB) sColorNameList = ItemInsert(sColorNameItem,-1,sColorNameList,@TAB) Next Drop(iColorCount,sFilenameWilClr,sColorList,sColorNameItem,sColorValueItem,iColor) ;------------------------------------------------------------------------------------------------------------------------------------------ ; Set all items to lower case. ; This is used later when comparing with lowercase keywords in hashbuffer. sColorNameList = StrLower(sColorNameList) ; Delete duplicate names. sNameTrimList = "" sValueTrimList = "" iCount = ItemCount(sColorNameList,@TAB) For iColor=1 To iCount sNameItem = ItemExtract(iColor,sColorNameList,@TAB) If (sNameItem>"") If !ItemLocate(sNameItem,sNameTrimList,@TAB) sNameTrimList = ItemInsert(sNameItem,-1,sNameTrimList,@TAB) sValueItem = ItemExtract(iColor,sColorValueList,@TAB) sValueTrimList = ItemInsert(sValueItem,-1,sValueTrimList,@TAB) EndIf EndIf Next sColorNameList = sNameTrimList sColorValueList = sValueTrimList Drop(iColor,iCount,sNameItem,sNameTrimList,sValueItem,sValueTrimList) ;------------------------------------------------------------------------------------------------------------------------------------------ If UseRGB ; delete all leading zeroes sColorValueList = ItemInsert("",0,sColorValueList,@TAB) sColorValueList = StrReplace(sColorValueList,@TAB,StrCat(",",@TAB,",")) sColorValueList = StrReplace(sColorValueList,",0",",") sColorValueList = StrReplace(sColorValueList,",0",",") sColorValueList = StrReplace(sColorValueList,",,",",0,") sColorValueList = StrReplace(sColorValueList,",,",",0,") sColorValueList = StrReplace(sColorValueList,StrCat(",",@TAB,","),@TAB) sColorValueList = ItemRemove(1,sColorValueList,@TAB) Else ; convert rgb to hex iColorCount = ItemCount(sColorValueList,@TAB) For iColor=1 To iColorCount sRgbItem = ItemExtract(iColor,sColorValueList,@TAB) sColorValueItem = StrCat("#",udfByteToHex(ItemExtract(1,sRgbItem,","))) sColorValueItem = StrCat(sColorValueItem,udfByteToHex(ItemExtract(2,sRgbItem,","))) sColorValueItem = StrCat(sColorValueItem,udfByteToHex(ItemExtract(3,sRgbItem,","))) sColorValueList = ItemReplace(sColorValueItem,iColor,sColorValueList,@TAB) Next EndIf Drop(iColorCount,sColorValueItem,iColor,sRgbItem) Return ;========================================================================================================================================== :CollectKeywords sMsg = "Collecting Keywords ..." udsDisplayMsg(sMsg) ; Read my inifile in WinBatch system folder. sFilenameW2HIni = StrCat(DirHome(),"wbt2html.ini") If !FileExist(sFilenameW2HIni) Then Goto LabelCreateHashTable If (IniReadPvt("WBT2HTML","FileVersion","",sFilenameW2HIni)<>sProgVersion) Then Goto LabelCreateHashTable sFilenameWilClr = IniReadPvt("WIL","ColorName","",sFilenameW2HIni) If (sFilenameWilClr=="") Then Goto LabelCreateHashTable If !FileExist(sFilenameWilClr) Then Goto LabelCreateHashTable If (VersionDLL()<"3.8hch") ; "2002h"="3.8hch" If (IniReadPvt("WIL","ColorCRC","",sFilenameW2HIni)<>udfFileCrc32(sFilenameWilClr)) Then Goto LabelCreateHashTable Else If (IniReadPvt("WIL","ColorMD5","",sFilenameW2HIni)<>udfFileChecksum(sFilenameWilClr,0)) Then Goto LabelCreateHashTable EndIf If !FileExist(IniReadPvt("WIL","HashName","",sFilenameW2HIni)) Then Goto LabelCreateHashTable ; Get the HashBuffer filename and other definition values. sMsg = "Reading Keyword HashTable ..." udsDisplayMsg(sMsg) GoSub GetHashBufferDefinition ; Read the HashBuffer. iBBHashSize = FileSizeEx(sFilenameBBHash) If !iBBHashSize Then Goto LabelCreateHashTable hBBHash = BinaryAlloc(iBBHashSize) BinaryRead(hBBHash,sFilenameBBHash) Drop(sFilenameWilClr,iBBHashSize,sFilenameW2HIni) Return ; ......................................................................................................................................... ; Create the Binary Buffer HashTable. :LabelCreateHashTable sMsg = "Creating Keyword HashTable ... be patient ..." udsDisplayMsg(sMsg) CurrentDir = DirGet() DirChange(udfGetTempPath()) sFilenameBBHash = StrCat(udfDirGetLong(),"wil.hsh") DirChange(DirHome()) sFilenameWilClr = StrCat(udfDirGetLong(),"wil.clr") DirChange(CurrentDir) Drop(CurrentDir) Terminate(!FileExist(sFilenameWilClr),"Error","WBT2HTML.WBT needs a good WIL.CLR file with some Keywords in it ...") GoSub InitIni GoSub GetHashBufferDefinition ; Read keywords from WIL.CLR inifile and create HashTable. sKeywordList = IniItemizePvt ("KEYWORDS",sFilenameWilClr) iKeywordCount = ItemCount(sKeywordList,@TAB) ; Calculation rule: HashBufferSize = HashLoadFactor*KeyCount*(Length of Key + Length of Data) with HashLoadFactor=140..200Pct. iBBHashSize = udfGetPrimeThisOrNext(Int(@GOLDENRATIO*iKeywordCount))*iBBHashRecSize ; Try to make the hash more perfect. ; Test.20020823 hBBHash = BinaryAlloc(iBBHashSize) For i=1 To iKeywordCount sKeywordItem = ItemExtract(i,sKeywordList,@TAB) sColorNameItem = StrTrim(IniReadPvt("KEYWORDS",sKeywordItem,"",sFilenameWilClr)) If (sColorNameItem=="1") Then sColorNameItem="Keyword" ; Set standard WIL color=1 to "Keyword" as set in Registry. iBBHashOffset = BinaryHashRec(hBBHash,iBBHashRecSize,iBBHashKeyOffset,iBBHashKeySize,StrLower(sKeywordItem)) BinaryPokeStr(hBBHash,iBBHashOffset+iBBHashColorNameOffset,StrLower(sColorNameItem)) BinaryPokeStr(hBBHash,iBBHashOffset+iBBHashMixCaseOffset,sKeywordItem) Next BinaryWrite(hBBHash,sFilenameBBHash) GoSub WriteIni Drop(sFilenameWilClr,sColorNameItem,iBBHashSize,sFilenameBBHash,iBBHashOffset,i) Drop(iKeywordCount,sKeywordItem,sKeywordList,CurrentDir,sFilenameW2HIni) Return ;------------------------------------------------------------------------------------------------------------------------------------------ :InitIni IniWritePvt("WBT2HTML","InternalName" ,"wbt2html.wbt" ,sFilenameW2HIni) IniWritePvt("WBT2HTML","FileVersion" ,sProgVersion ,sFilenameW2HIni) IniWritePvt("WBT2HTML","FileVersionDate" ,sProgVersionDate ,sFilenameW2HIni) IniWritePvt("WBT2HTML","FileDescription" ,"WBT to coloured HTML Script Converter",sFilenameW2HIni) IniWritePvt("WBT2HTML","OriginalFilename" ,"WBT2HTML.WBT" ,sFilenameW2HIni) IniWritePvt("WBT2HTML","ProductName" ,sProgProduct ,sFilenameW2HIni) IniWritePvt("WBT2HTML","ProductVersion" ,"1" ,sFilenameW2HIni) IniWritePvt("WBT2HTML","CompanyName" ,"Detlev Dalitz" ,sFilenameW2HIni) IniWritePvt("WBT2HTML","LegalCopyright" ,sProgCopyright ,sFilenameW2HIni) IniWritePvt("WBT2HTML","Comments" ,"emailto:dd@dalitz-im-netz.de",sFilenameW2HIni) IniWritePvt("WBT2HTML","IniYmdHms" ,TimeYmdHms() ,sFilenameW2HIni) IniWritePvt("WIL","ColorName" ,sFilenameWilClr ,sFilenameW2HIni) IniWritePvt("WIL","ColorYmdHms" ,"" ,sFilenameW2HIni) IniWritePvt("WIL","HashName" ,sFilenameBBHash ,sFilenameW2HIni) IniWritePvt("WIL","HashYmdHms" ,"" ,sFilenameW2HIni) If (VersionDLL()<"3.8hch") ; "2002h"="3.8hch" IniWritePvt("WIL","ColorCRC" ,"" ,sFilenameW2HIni) IniWritePvt("WIL","HashCRC" ,"" ,sFilenameW2HIni) Else IniWritePvt("WIL","ColorMD5" ,"" ,sFilenameW2HIni) IniWritePvt("WIL","HashMD5" ,"" ,sFilenameW2HIni) EndIf IniWritePvt("","","",sFilenameW2HIni) ; Flush the buffer to disk. Return ;------------------------------------------------------------------------------------------------------------------------------------------ :WriteIni IniWritePvt("WIL","ColorName" ,sFilenameWilClr ,sFilenameW2HIni) IniWritePvt("WIL","ColorYmdHms" ,FileTimeGetEx(sFilenameWilClr,2) ,sFilenameW2HIni) IniWritePvt("WIL","HashName" ,sFilenameBBHash ,sFilenameW2HIni) IniWritePvt("WIL","HashYmdHms" ,FileTimeGetEx(sFilenameBBHash,2) ,sFilenameW2HIni) If (VersionDLL()<"3.8hch") ; "2002h"="3.8hch" IniWritePvt("WIL","ColorCRC" ,udfFileCrc32(sFilenameWilClr) ,sFilenameW2HIni) IniWritePvt("WIL","HashCRC" ,udfFileCrc32(sFilenameBBHash) ,sFilenameW2HIni) Else IniWritePvt("WIL","ColorMD5" ,udfFileChecksum(sFilenameWilClr,0) ,sFilenameW2HIni) IniWritePvt("WIL","HashMD5" ,udfFileChecksum(sFilenameBBHash,0) ,sFilenameW2HIni) EndIf IniWritePvt("","","",sFilenameW2HIni) ; Flush the buffer to disk. Return ;------------------------------------------------------------------------------------------------------------------------------------------ :GetHashBufferDefinition sFilenameBBHash = IniReadPvt("WIL","HashName","",sFilenameW2HIni) iBBHashKeyOffset = 0 ; Key lowercase. iBBHashKeySize = 60 ; Key lowercase. iBBHashColorNameOffset = 60 ; Color name. iBBHashColorNameSize = 30 ; Color name. iBBHashMixCaseOffset = 90 ; Key content in mixed case as stored in WIL.CLR. iBBHashMixCaseSize = 30 ; Key content in mixed case as stored in WIL.CLR. iBBHashRecSize = iBBHashKeySize + iBBHashColorNameSize + iBBHashMixCaseSize iBBHashRecSize = (1+(iBBHashRecSize/16))*16 ; Align RecordSize to 16 Byte boundary. ; Test.20020823 Return ; The iBBHashKeySize is sized to 60 chars, regardless of WinBatch's limited var size of 30 chars. ; This is done for runtime security reasons and because of OLE-object names, which are 'oversized' sometimes. ;========================================================================================================================================== :TagQuote sMsg = "Tagging Quotes ..." udsDisplayMsg(sMsg) qlist = """|'|`" ; Three items: doublequote, singlequote, backquote. sCommentChar = ";" sQuoteChars = StrReplace(qlist,"|","") sScanChars = StrCat(sQuoteChars,sCommentChar) sTagIdent = "q" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. ; Allocate a separate work line buffer, 4 KB should be enough, otherwise enlarge it to your needs. iBBLineSize = 4096 hBBLine = BinaryAlloc(iBBLineSize) sBBTag = BinaryTagInit(hBB,@LF,@CR) While 1 sBBTag = BinaryTagFind(sBBTag) If (sBBTag=="") Then Break sLine = BinaryTagExtr(sBBTag,1) If (sLine=="") Then Continue sScanLine = StrClean(sLine,sScanChars,"",@TRUE,2) If (StrLen(sScanLine)<2) Then Continue ; Skip line, no complete quoted literal to replace. If (StrSub(sScanLine,1,1)==sCommentChar) Then Continue ; Skip line, contains comment only. sScanLineQuoteChars = StrClean(sQuoteChars,sScanLine,"",@TRUE,2) iQuoteCount = StrLen(sScanLineQuoteChars) For iQuote=1 To iQuoteCount sQuote = StrSub(sScanLineQuoteChars,iQuote,1) sBBLineTag%iQuote% = BinaryTagInit(hBBLine,sQuote,sQuote) Next sScanLineQuoteChars = StrCat(sScanLineQuoteChars,sCommentChar) ; Find literals. BinaryEodSet(hBBLine,0) BinaryPokeStr(hBBLine,0,sLine) iScan = 1 While 1 sScanLine = BinaryPeekStr(hBBLine,0,BinaryEodGet(hBBLine)) iScan = StrScan(sScanLine,sScanLineQuoteChars,iScan,@FWDSCAN) If !iScan Then Break sChar = StrSub(sScanLine,iScan,1) If (sChar==sCommentChar) Then Break iQuote = StrIndex(sScanLineQuoteChars,sChar,1,@FWDSCAN) sBBLineTag = sBBLineTag%iQuote% sBBLineTag = BinaryTagFind(sBBLineTag) If (sBBLineTag=="") Then Break ; If we break here, then there must be a syntax error in input file. sLiteral = BinaryTagExtr(sBBLineTag,1) ; Exclude current Quote Char from colorizing. ;;; sLiteral = StrCat(sChar,sLiteral,sChar) ; do not (!) include quote chars for later colorizing !!! iItemLocate = ItemLocate(sLiteral,sTagList%sTagIdent%,@TAB) If !iItemLocate sTagList%sTagIdent% = ItemInsert(sLiteral,-1,sTagList%sTagIdent%,@TAB) sTag = StrCat(sTagOn,sTagIdent,ItemCount(sTagList%sTagIdent%,@TAB),sTagOff) Else sTag = StrCat(sTagOn,sTagIdent,iItemLocate,sTagOff) EndIf sTag = StrCat(sChar,sTag,sChar) ; Exclude current Quote Char from colorizing. sBBLineTag = BinaryTagRepl(sBBLineTag,sTag) sBBLineTag%iQuote% = sBBLineTag iScan = iScan + StrLen(sTag) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage BB ",100*BinaryEodGet(hBB)/iBBSize,"%%") sMsgUse = StrCat(sMsgUse,@LF,"BufferUsage BBLine ",100*BinaryEodGet(hBBLine)/iBBLineSize,"%%") sMsgUse = StrCat(sMsgUse,@LF,sLiteral) udsDisplayMsg(sMsgUse) EndIf EndWhile ; Replace the line. sLine = BinaryPeekStr(hBBLine,0,BinaryEodGet(hBBLine)) sTag = StrCat(@LF,sLine,@CR) sBBTag = BinaryTagRepl(sBBTag,sTag) EndWhile BinaryFree(hBBLine) Drop(hBBLine) ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) DropWild("sBBLineTag*") Drop(iBBLineSize,iItemLocate,iQuote,iQuoteCount,iScan,qlist) Drop(sBBTag,sChar,sCommentChar,sLine,sLiteral,sMsg,sMsgUse) Drop(sQuote,sQuoteChars,sScanChars,sScanLine,sScanLineQuoteChars,sTag,sTagIdent) Return ;========================================================================================================================================== :TagComment sMsg = "Tagging Comments ..." udsDisplayMsg(sMsg) clist = ";" sTagIdent = "c" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. ccount = ItemCount(clist,".") For c=1 To ccount citem = ItemExtract(c,clist,".") sBBTag = BinaryTagInit(hBB,citem,@CR) While 1 sBBTag = BinaryTagFind(sBBTag) If (sBBTag=="") Then Break cstr = BinaryTagExtr(sBBTag,1) cstr = StrCat(citem,cstr) ; Include leading comment char for later colorizing. iItemLocate = ItemLocate(cstr,sTagList%sTagIdent%,@TAB) If !iItemLocate sTagList%sTagIdent% = ItemInsert(cstr,-1,sTagList%sTagIdent%,@TAB) sTag = StrCat(sTagOn,sTagIdent,ItemCount(sTagList%sTagIdent%,@TAB),sTagOff) Else sTag = StrCat(sTagOn,sTagIdent,iItemLocate,sTagOff) EndIf sTag = StrCat(sTag,@CR) ; Exclude trailing 'comment char' (@CR) from colorizing. sBBTag = BinaryTagRepl(sBBTag,sTag) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,cstr) udsDisplayMsg(sMsgUse) EndIf EndWhile Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop(c,ccount,citem,clist,cstr,iItemLocate,sBBTag,sMsg,sMsgUse,sTag,sTagIdent) Return ;========================================================================================================================================== :TagOperatorMod ; This routine needs the round brackets untouched. sMsg = "Tagging Operator mod ..." udsDisplayMsg(sMsg) sTagIdent = "m" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. If (BinaryIndexEx(hBB,0,"mod",@FWDSCAN,@FALSE)<0) Then Return ; Nothing to do. No "mod" text fragment found. ; Workaround for the Regular Expression '[ 0-9\)](mod)[ 0-9\(\+\-]' ; KEDIT: change r '[ 0-9\)](mod)[ 0-9\(\+\-]'<font color="#rrggbb">&1</font>' * * ; Build a list of all combinations. sModList = "" sListL = " 0123456789)" sListR = " 0123456789(+-" iMaxL = StrLen(sListL) iMaxR = StrLen(sListR) For iL=1 To iMaxL For iR=1 To iMaxR sModList = ItemInsert(StrCat(StrSub(sListL,iL,1),StrSub(sListR,iR,1)),-1,sModList,@TAB) Next Next Drop(iL,iR,iMaxL,iMaxR,sListL,sListR) iModReplaced = 0 iModCount = ItemCount(sModList,@TAB) For iMod=1 To iModCount mstr = ItemExtract(iMod,sModList,@TAB) sBBTag = BinaryTagInit(hBB,StrCat(StrSub(mstr,1,1),"mod"),StrSub(mstr,2,1)) While 1 sBBTag = BinaryTagFind(sBBTag) If (sBBTag=="") Then Break If BinaryTagLen(sBBTag,0) Then Continue ; not a pure "mod", e.g. " (mod)ified " mstr = BinaryPeekStr(hBB,BinaryTagIndex(sBBTag,1),BinaryTagLen(sBBTag,1)) sTag = StrCat(sTagOn,sTagIdent,2,sTagOff) sTag = StrReplace(StrLower(mstr),"mod",sTag) sBBTag = BinaryTagRepl(sBBTag,sTag) iModReplaced = 1 EndWhile If UseVerbose mstr = StrCat(StrSub(mstr,1,1),"mod",StrSub(mstr,2,1)) sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,mstr) udsDisplayMsg(sMsgUse) EndIf Next If iModReplaced Then sTagList%sTagIdent% = ItemInsert("mod",-1,sTagList%sTagIdent%,@TAB) ; The one and only keyword in this list. ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) ; num = BinaryWrite(hBB,StrCat(udfGetTempPath(),"wbt2html.hBB.",sTagIdent,".bin")) Drop(iMod,iModCount,iModReplaced,mstr,sBBTag,sModList,sMsg,sMsgUse,sTag,sTagIdent) Return ;========================================================================================================================================== :TagOperator sMsg = "Tagging Operators ..." udsDisplayMsg(sMsg) olist = "==.<=.>=.<>.!=.<.>.**.*./.+.-.&&.||.<<.>>.&.|.^.~.!.+.-.=" ; plus ".mod" ; binary(relational,arithmetic,logical),unary(integer logical,integer & float),assignment sTagIdent = "o" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. ocount = ItemCount(olist,".") For o=1 To ocount ostr = ItemExtract(o,olist,".") sTag = StrCat(sTagOn,sTagIdent,1+ItemCount(sTagList%sTagIdent%,@TAB),sTagOff) If BinaryReplace(hBB,ostr,sTag,@TRUE) Then sTagList%sTagIdent% = ItemInsert(ostr,-1,sTagList%sTagIdent%,@TAB) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,ostr) udsDisplayMsg(sMsgUse) EndIf Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop(o,ocount,olist,ostr,sMsg,sMsgUse,sTag,sTagIdent) Return ;========================================================================================================================================== :TagBracket sMsg = "Tagging Brackets ..." udsDisplayMsg(sMsg) blist = "(.).[.].{.}" ; brackets sTagIdent = "b" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. bcount = ItemCount(blist,".") For b=1 To bcount bstr = ItemExtract(b,blist,".") sTag = StrCat(sTagOn,sTagIdent,1+ItemCount(sTagList%sTagIdent%,@TAB),sTagOff) If BinaryReplace(hBB,bstr,sTag,@TRUE) Then sTagList%sTagIdent% = ItemInsert(bstr,-1,sTagList%sTagIdent%,@TAB) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,bstr) udsDisplayMsg(sMsgUse) EndIf Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop(b,bcount,blist,bstr,sTag,sMsg,sMsgUse,sTagIdent) Return ;========================================================================================================================================== :TagSpecial sMsg = "Tagging Special Chars ..." udsDisplayMsg(sMsg) slist = " |,|@|#|::|:" ; Blank,Comma,ASCII-64,ASCII-35,DoubleColon,Colon. (Percent sign too?) sTagIdent = "s" sTagList%sTagIdent% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list.. scount = ItemCount(slist,"|") For s=1 To scount sstr = ItemExtract(s,slist,"|") sTag = StrCat(sTagOn,sTagIdent,1+ItemCount(sTagList%sTagIdent%,@TAB),sTagOff) If BinaryReplace(hBB,sstr,sTag,@TRUE) Then sTagList%sTagIdent% = ItemInsert(sstr,-1,sTagList%sTagIdent%,@TAB) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,sstr) udsDisplayMsg(sMsgUse) EndIf Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop(sMsg,sMsgUse,s,scount,slist,sstr,sTag,sTagIdent) Return ;========================================================================================================================================== :TagWordNumber sMsg = "Tagging Words and Numbers ..." udsDisplayMsg(sMsg) sTagIdentWord = "w" sTagList%sTagIdentWord% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list. sTagIdentNumber = "n" sTagList%sTagIdentNumber% = sTagOn ; Start list with tag 'sTagOn' to have at least one item in the list. ; "Hide" all @CRLF. BinaryReplace(hBB,@CRLF,StrCat(sTagOn,@CRLF,sTagOff),@FALSE) sBBTag = BinaryTagInit(hBB,sTagOff,sTagOn) While 1 sBBTag = BinaryTagFind(sBBTag) If (sBBTag=="") Then Break sWordNumber = BinaryTagExtr(sBBTag,1) If (sWordNumber=="") Then Continue If IsNumber(sWordNumber) iItemLocate = ItemLocate(sWordNumber,sTagList%sTagIdentNumber%,@TAB) If !iItemLocate sTagList%sTagIdentNumber% = ItemInsert(sWordNumber,-1,sTagList%sTagIdentNumber%,@TAB) iItemLocate= ItemCount(sTagList%sTagIdentNumber%,@TAB) EndIf sTag = StrCat(sTagOff,sTagOn,sTagIdentNumber,iItemLocate,sTagOff,sTagOn) Else iItemLocate = ItemLocate(sWordNumber,sTagList%sTagIdentWord%,@TAB) If !iItemLocate sTagList%sTagIdentWord% = ItemInsert(sWordNumber,-1,sTagList%sTagIdentWord%,@TAB) iItemLocate = ItemCount(sTagList%sTagIdentWord%,@TAB) EndIf sTag = StrCat(sTagOff,sTagOn,sTagIdentWord,iItemLocate,sTagOff,sTagOn) EndIf sBBTag = BinaryTagRepl(sBBTag,sTag) If UseVerbose sMsgUse = StrCat(sMsg,@LF,"BufferUsage ",100*BinaryEodGet(hBB)/iBBSize,"%%",@LF,sWordNumber) udsDisplayMsg(sMsgUse) EndIf EndWhile ; "Unhide" all @CRLF. BinaryReplace(hBB,StrCat(sTagOn,@CRLF,sTagOff),@CRLF,@FALSE) ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdentNumber%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdentNumber,".txt")) ; num = udfItemListToFile (sTagList%sTagIdentWord%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdentWord,".txt")) ; num = BinaryWrite(hBB,StrCat(udfGetTempPath(),"wbt2html.hBB.",sTagIdentWord,".bin")) Drop(iItemLocate,sMsg,sMsgUse,sBBTag,sTagIdentNumber,sTagIdentWord,sWordNumber,sTag) Return ;========================================================================================================================================== :EncodeNamedEntities sMsg = "Encoding HTML Named Entities ..." udsDisplayMsg(sMsg) sTagListo = StrReplace(sTagListo,"&","&") sTagListo = StrReplace(sTagListo,"<","<") sTagListo = StrReplace(sTagListo,">",">") sTagListc = StrReplace(sTagListc,"&","&") sTagListc = StrReplace(sTagListc,"<","<") sTagListc = StrReplace(sTagListc,">",">") sTagListq = StrReplace(sTagListq,"&","&") sTagListq = StrReplace(sTagListq,'"',""") sTagListq = StrReplace(sTagListq,"