******************************************************************** * Description.......: nnHTMLCode * Calling Samples...: on key label F9 _cliptext=nnHTMLCode(_cliptext) * Parameter List....: lcCode, lcPath, lcBeatify * Created by........: Mike Helland * Modified by.......: Nadya Nosonovsky 04/13/2000 11:02:34 AM ******************************************************************** lparameters lcCode, lcPath, lcBeatify if empty(lcCode) or vartype(lcCode)<>'C' && Check if first parameter exists return .f. endif lnSec=seconds() if vartype(lcBeatify)<>'C' release lcBeatify lcBeatify='M' && Mixed endif if vartype(lcBeatify)='C' and not inlist(left(upper(lcBeatify),1),'U','L') lcBeatify='M' endif #define SINGLEQUOTE ['] #define DOUBLEQUOTE ["] #define LEFTPAR "[" #define RIGHTPAR "]" #define FONTBLUE '<font color=blue>' #define FONTGREEN '<font color=green>' #define FONTEND '</font>' #define SYMBOLS ':;,./\<>+=-{}[]()#*' *Do some basic HTML intializing lcCode = strtran(lcCode, chr(9), space(5)) lcCode = strtran(lcCode, '&', '&amp;') lcCode = strtran(lcCode, '<', '&lt;') lcCode = strtran(lcCode, '>', '&gt;') lcCode = strtran(lcCode, chr(13), chr(13)+chr(13)) *Create an array ouf of our strings. local laLines[1], lcReturn, lnLines, lnI, lcLine, lnWA local lcFL, lcComment, lcBeforeComment, lnWords, lcResult dimension laWords[1] local lcDoubleAmp, lnStartComment, k, lcLeft, lcRight lnLines=alines(laLines, lcCode) lcReturn = '<pre>' lnWA=select() if !used('words') use (iif(empty(lcPath), '', lcPath) + '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 * lcFL = ' '+ upper(trim(chrtran(lcBeforeComment, ':;./\<>+=-}]()#', space(15)))) + ' ' *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 lcBeforeComment=substr(lcLine, 1,lnStartComment-1) endif *!* Devide string into words lnWords = aparser(@laWords, lcBeforeComment,SYMBOLS) 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) if lcLeft=LEFTPAR lcLeft=RIGHTPAR endif llStartString=.f. if inlist(lcLeft,DOUBLEQUOTE,SINGLEQUOTE,LEFTPAR) && String starts llStartString=.t. lcSymb=lcLeft endif do while llStartString if k<lnWords lcLeft=left(laWords[k+1],1) lcRight=right(alltrim(laWords[k+1]),1) 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 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(lcBeatify),1)='U' && Upper case laWords[k]=upper(laWords[k]) case left(upper(lcBeatify),1)='L' && Lower case laWords[k]=lower(laWords[k]) endcase laWords[k]=FONTBLUE+laWords[k]+FONTEND endif lcResult=lcResult+laWords[k] next 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)) 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