******************************************************************** * 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/18/2000 04:45:16 PM ******************************************************************** 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' && 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 ':;,./\<>+=-{}[]()#*' #define CRL chr(13) #define CLRL chr(13)+chr(10) *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, CRL, CRL+CRL) && 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 private chr254, space1 && in order to be seen in aparser chr254=chr(254) space1=space(1) 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 +CLRL loop endif *Full Line Comments, first if left(alltrim(lcLine),1) = '*' lcLine = FONTGREEN + lcLine + FONTEND *Print line here lcReturn = lcReturn + CLRL + 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) lcResult='' for k=1 to lnWords * First check if we're in a string laWords[k]=chrtran(laWords[k],chr254,space1) lcLeft=left(laWords[k],1) llStartString=.f. if inlist(lcLeft,DOUBLEQUOTE,SINGLEQUOTE,LEFTPAR) && String starts llStartString=.t. 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) lcRight=right(alltrim(laWords[k+1]),1) laWords[k]=chrtran(laWords[k],chr254,space1) 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],chr254,space1) lcSymb='' llStartString=.f. && String ends exit endif enddo laWords[k]=chrtran(laWords[k],chr254,space1) 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 + CLRL + 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, chr13 chr13=chr(13) external array paWords if vartype(pcDelimiter)<>'C' pcDelimiter=space1 endif pcWordString=strtran(pcWordString, space1, space1+chr254) && Replace space(1) with rare symbol chr(254) for i=1 to len(pcDelimiter) lcSymbol=substr(pcDelimiter,i,1) pcWordString=strtran(pcWordString,lcSymbol,space1+lcSymbol+space1) && Larry Miller suggested next *!* Replace the delimiter with CHR(13) using STRTRAN. pcWordString = strtran(pcWordString, space1, chr13) *!* Now put each element in an array. lnWords=alines(paWords, pcWordString) return lnWords>You also might want to look at the Foxtools functions Words() and WordNum() for parsing the strings.