Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
VFP code syntax coloring in HTML
Message
From
20/04/2000 10:18:01
 
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00355687
Message ID:
00361777
Views:
17
Hi Nadya,

Well, after a week of getting your messages, I decided to give version 2 a crack last night, and after 3 Mountain Dews, this is where I ended up. It runs in about 1/3 - 1/2 the timeyour does, plus, I don't mutate any of the Tabs, partial words are colored (modi comm) and I won't reformatt the upper( word ) thing like yours does. I did leave out the "in a string" business, though, you could write somehting tricky with an Occurs() and SubStr() if you wanted it. Also, this formats lines correctly, unlike yours which gives double blank lines inconsitantly (try passing it a FileToStr()).

Note, there is supposed to be an @ between the ! and # in that symbols string way down there, but I took it out because the UT parser was treating it like a giant email address.
#define ccRW		'<font color=blue>'
#define ccCOMMENT	'<font color=green>'
#define ccCLOSE		'</font>'
#define cnRWLEN		17
#define cnCLOSELEN	7

*Collect out parameters and check 'em
lparameters tcCode, tcPath
local lcCode
lcCode = tcCode
if empty(lcCode)
	return ''
endif

wait wind nowai &&This is to test partial words

*The words table holds all of the words that will turn color
local llCloseWords
if not used('words')
	llCloseWords = .T.
	use (iif(empty(tcPath), '', tcPath) + 'words') in 0
endif

*Start the clock
lnSec = Seconds()

*Setup two simple variables for speed
local leCR, leLF
leCR	= chr(13)
leLF 	= chr(10)
leTab	= chr(9)

*Do some basic HTML intializing
lcCode = strtran(lcCode, '&', '&')
lcCode = strtran(lcCode, '<', '<')
lcCode = strtran(lcCode, '>', '>')
lcCode = strtran(chrtran(lcCode, leLF, ''), leCR, leCR + leLF)

*Create an array element for each line and start to proccess
local laLines[1], lcReturn, lnI, lcLine
lnLines = alines(laLines, lcCode)
lcReturn = '<pre>'

*Proccess each line
for lnI = 1 to lnLines
	lcLine = laLines[lnI]

	*Don't even bother the blank ones
	if empty(alltrim(lcLine))
		lcReturn = lcReturn + leCR + leLF
		loop
	endif

	*Full Line Comments, first
	local lcNoTabLine
	lcNoTabLine = upper(ltrim(chrtran(lcLine, leTab, '')))
	if lcNoTabLine = '*' or ;
		lcNoTabLine = 'NOTE'
		lcLine = ccCOMMENT + lcLine + ccCLOSE

		*And move on
		lcReturn = lcReturn + leCR + leLF + lcLine
		loop
	endif

	*Now end of the line comments
	local lnStartComment, lcComment
	lnStartComment = at('&&', lcLine)
	if lnStartComment > 0
		lcComment = ccCOMMENT + substr(lcLine, lnStartComment) + ccCLOSE
		lcLine = substr(lcLine, 1, lnStartComment - 1)
	else
		lcComment = ''
	endif

	*Lets loop through every word in our line
	local laWords[1], ;
		lcTempLine, ;
		lnOffSet, ;
		lnWords, ;
		lnWord, ;
		lnWordLen
	lcTempLine = ' ' + ltrim(chrtran(upper(lcLine), ;
		'~! #$%^&*()-+=|\{}[]:;,./\<>' + leTab, space(29))) + ' '
	lnOffset = len(lcLine) - len(lcTempLine) + 1
	lnWords = occurs(' ', lcTempLine) - 1
	lnRWs = 0
	dime laWords[lnWords, 2]
	for lnWord = 1 to lnWords
		lnWordStart = at(' ', lcTempLine, lnWord) + 1 + lnOffset
		lcWord = substr(lcTempLine, ;
			lnWordStart - lnOffSet, ;
			at(' ', lcTempLine, lnWord + 1) - lnWordStart + lnOffSet)
		lnWordLen = len(lcWord)

		*Now, see if our word is a color changer
		if not empty(lcWord) and seek(iif(lnWordLen < 4, ;
			padr(lcWord, 4), lcWord), 'words', 'revword')

			*It is, insert the tags and bump the counter
			lcLine = stuff(lcLine, lnWordStart + ;
				((cnRWLEN + cnCLOSELEN) * lnRWs), 0, ccRW)
			lcLine = stuff(lcLine, lnWordStart + ;
				((cnRWLEN + cnCLOSELEN) * lnRWs) + cnRWLEN + lnWordLen, 0, ccCLOSE)
			lnRWs = lnRWs + 1
		endif
	endfor	


	lcReturn = lcReturn + leCR + leLF + lcLine + lcComment

endfor

*Return the orginal value so we can pass by ref if we want
tcCode = lcReturn  + '</pre>'

lcSec = alltrim(str(seconds() - lnSec, 10, 6))
wait window nowait alltrim(str(lnLines)) + ;
	' lines in ' + lcSec + ' seconds'

*Finish out
if llCloseWords
	use in words
endif
return tcCode
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform