******************************************************************** * Description.......: nnHTMLCode * Calling Samples...: on key label F9 _cliptext=nnHTMLCode(_cliptext) * Parameter List....: tcCode, tcPath, lcBeatify * Created by........: Mike Helland * Modified by.......: Nadya Nosonovsky 04/18/2000 04:45:16 PM ******************************************************************** lparameters tcCode, tcPath, lcBeatify if empty(tcCode) or vartype(tcCode)<>'C' && Check if first parameter exists return .f. endif lnSec=seconds() if vartype(tcBeautify)<>'C' release tcBeautify tcBeautify='M' && Mixed endif if vartype(tcBeautify)='C' and not inlist(left(upper(tcBeautify),1),'U','L') tcBeautify='M' && Mixed endif #define SINGLEQUOTE chr(39) #define DOUBLEQUOTE chr(34) #define LEFTPAR chr(91) #define RIGHTPAR chr(93) #define FONTBLUE '<font color=blue>' #define FONTGREEN '<font color=green>' #define FONTEND '</font>' #define SYMBOLS ':;,./\<>+=-{}[]()#*' *Do some basic HTML intializing tcCode = strtran(tcCode, chr(9), space(5)) tcCode = strtran(tcCode, '&', '&amp;') tcCode = strtran(tcCode, '<', '&lt;') tcCode = strtran(tcCode, '>', '&gt;') tcCode = strtran(tcCode, chr(13), chr(13)+chr(13)) && To proper handle blank lines *Create an array ouf of our strings. local laLines[1], lcReturn, lnLines, lnI, lcLine, lnWA local lcComment, lcBeforeComment, lnWords, lcResult local lcDoubleAmp, lnStartComment, k, lcLeft, lcRight, lcSymb, llStartString lnLines=alines(laLines, tcCode) lcReturn = '<pre>' lnWA=select() if !used('words') use (iif(empty(tcPath), '', tcPath) + 'words') in 0 order tag revword endif *Proccess each line for lnI = 1 to lnLines lcLine = laLines[lnI] *Don't even bother the blank ones if empty(alltrim(lcLine)) lcReturn = lcReturn +chr(13) + chr(10) loop endif *Full Line Comments, first if left(alltrim(lcLine),1) = '*' lcLine = FONTGREEN + lcLine + FONTEND *Print line here lcReturn = lcReturn + chr(13) + chr(10) + lcLine loop endif lcComment='' lcBeforeComment=lcLine *Now end of the line comments lcDoubleAmp = '&amp;&amp;' && This is to test our function lnStartComment = at(lcDoubleAmp, lcLine) if lnStartComment > 0 lcComment = FONTGREEN+substr(lcLine, lnStartComment) + FONTEND && Insert comment tag lcBeforeComment=substr(lcLine, 1,lnStartComment-1) endif *!* Devide string into words dimension laWords[1] lnWords = aparser(@laWords, lcBeforeComment,SYMBOLS) * suspend lcResult='' for k=1 to lnWords * First check if we're in a string laWords[k]=chrtran(laWords[k],chr(254),space(1)) lcLeft=left(laWords[k],1) lcRight=right(laWords[k],1) llStartString=.f. if inlist(lcLeft,DOUBLEQUOTE,SINGLEQUOTE,LEFTPAR) && String starts if lcLeft=lcRight and len(laWords[k])>1 llStartString=.f. else llStartString=.t. endif if lcLeft=LEFTPAR lcLeft=RIGHTPAR endif lcSymb=lcLeft endif do while llStartString && Check if we're still in string if k<lnWords lcLeft=left(laWords[k+1],1) if len(laWords[k+1])>1 lcRight=right(alltrim(laWords[k+1]),1) else lcRight=left(laWords[k+1],1) endif laWords[k]=chrtran(laWords[k],chr(254),space(1)) if lcSymb==lcLeft or lcSymb==lcRight lcSymb='' lcResult=lcResult+laWords[k] k=k+1 llStartString=.f. && String ends exit endif lcResult=lcResult+laWords[k] k=k+1 && Increment count else && k=LnWords laWords[k]=chrtran(laWords[k],chr(254),space(1)) lcSymb='' llStartString=.f. && String ends exit endif enddo laWords[k]=chrtran(laWords[k],chr(254),space(1)) if not empty(laWords[k]) and seek(upper(padr(alltrim(laWords[k]),22)),'words','revword') && Word found do case case left(upper(tcBeautify),1)='U' && Upper case laWords[k]=upper(laWords[k]) case left(upper(tcBeautify),1)='L' && Lower case laWords[k]=lower(laWords[k]) endcase laWords[k]=FONTBLUE+laWords[k]+FONTEND endif lcResult=lcResult+laWords[k] next pcTest1='This is to test [strings ] Local private empty seek' if not empty(lcBeforeComment) and not empty(lcResult) lcBeforeComment=lcResult endif *Submit the process line lcReturn = lcReturn + chr(13) + chr(10) + lcBeforeComment+lcComment && Another In Line Test to use endfor lcReturn = lcReturn + '</pre>' use in words select (lnWA) wait window nowait 'Transformed '+alltrim(str(lnLines))+' lines in '+alltrim(str(seconds()-lnSec,10,6))+' sec' return lcReturn ********************************************************************** function aparser * Description.......: Function parses a text string into an array. * : Each element of the array contains one word... * Calling Samples...: dimension laWords[1] * : lcWordString = "Some text string" * : lnWords = aparser(@laWords, lcWordString) * Parameter List....: paWords, pcWordString, pcDelimiter ******************************************************************** lparameter paWords, pcWordString, pcDelimiter local lnWords, i, lcSymbol external array paWords if vartype(pcDelimiter)<>'C' pcDelimiter=space(1) endif pcWordString=strtran(pcWordString,space(1), space(1)+chr(254)) && Replace space(1) with rare symbol chr(254) pcTest=[This is a local variable space test] && To Test for i=1 to len(pcDelimiter) lcSymbol=substr(pcDelimiter,i,1) pcWordString=strtran(pcWordString,lcSymbol,space(1)+lcSymbol+space(1)) && Larry Miller suggested next *!* Replace the delimiter with CHR(13) using STRTRAN. pcWordString = strtran(pcWordString, space(1), chr(13)) *!* Now put each element in an array. lnWords=alines(paWords, pcWordString) return lnWords