Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
VFP code syntax coloring in HTML
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Divers
Thread ID:
00355687
Message ID:
00361276
Vues:
39
>Nadya (and Mike),
>
>From what I gather from the code (and from other threads on this subject) one of the things you're trying to accomplish here is to speed up the routine. One thing that catches my eye is the calling (unnecessarily) of some functions. For example, a number times the CHR(13) + CHR(10) is called. Assign the characters to a variable, and reference the variable instead. The same applies to CHR(13), SPACE(1), CHR(254). Each time you reference the function you incur additional processing overhead. When you assign them to variables, you incur this only once.
>

Hi George,

I made some changes, as you suggested. 213 lines runs in 0.3 sec. Don't see the difference in speed comparing the previous version, but may be the difference would be significant for 10000 lines of code. Thanks much.
********************************************************************
*  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, '&', '&')
lcCode = strtran(lcCode, '<', '<')
lcCode = strtran(lcCode, '>', '>')

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 = '&&' && 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.
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform