Around syntax Highlighting in visual foxpro

Published on January 23 2015 by Yousfi Benameur

*This is some ideas to build a vfp syntax highlighter.

*the ide vfp editor uses already a customizable syntax highlighter (tools/options).

*the vfp can also make line numeric index in each code line(see tools/options) but not beautiful.

*i present first the alanguage vfp function whose can retrieves all commands, functions,classes *and dbc events.this 4 lists are presented in cusor browse.

* ALANGUAGE( ) Function from foxHelp
*Return an array containing the names of all valid Visual FoxPro commands, functions, or base classes.
*ALANGUAGE(ArrayName, nType)
*1 Commands One-dimensional:    Command name
*2 Functions Two-dimensional:
*Function name   [M] nParamR [- nParamT]
*The matchFlag, M, specifies that you must use the full    function name in code.nParamR specifies the number of required parameters. nParamT specifies total number of possible parameters.
*3 Base classes One-dimensional:
*Base Class name
*4 DBC Events One-dimensional:
*DBC event name (The displayed name omits the "DBC_" prefix of the event name.)

*Begin Code

Set Safe Off
Close Data All
Local tot
tot=0
=Alanguage(Myarray,1) &&commands names
Create Cursor ycurs (yElement c(40))
For i=1 To Alen(Myarray)
Insert Into ycurs Values(Myarray(i))
Endfor
Sele ycurs
tot=tot+Reccount()
Locate

Browse Name ybrow   Title "VFP Commands: "+Trans(Reccount()) Nowait    &&window as oop object
With ybrow
   .DeleteMark=.F.
   .GridLines=0
   .RecordMark=.F.
   .Width=300
   .Left=100
   .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(190,235,200))", "Column")
   .FontBold=.T.
Endwith
Wait Window
*********
Zap
=Alanguage(Myarray,2)   &&functions names

For i=1 To Alen(Myarray) Step 2
Insert Into ycurs Values(Myarray(i))
Endfor
Sele ycurs
tot=tot+Reccount()
Locate

Browse Name ybrow   Title "VFP Functions: "+Trans(Reccount()) Nowait    &&window as oop object
With ybrow
   .DeleteMark=.F.
   .GridLines=0
   .RecordMark=.F.
   .Width=300
   .Left=100
   .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(110,200,140))", "Column")
   .FontBold=.T.
Endwith
Wait Window

Zap
=Alanguage(Myarray,3)   &&base classes names
For i=1 To Alen(Myarray)
   Insert Into ycurs Values(Myarray(i))
Endfor
Sele ycurs
tot=tot+Reccount()
Locate
Browse Name ybrow   Title "VFP Base classes : "+Trans(Reccount()) Nowait    &&window as oop object
With ybrow
   .DeleteMark=.F.
   .GridLines=0
   .RecordMark=.F.
   .Width=300
   .Left=100
   .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(170,205,220))", "Column")
   .FontBold=.T.
Endwith
Wait Window
*******
Zap
=Alanguage(Myarray,4)   &&dbc events
For i=1 To Alen(Myarray)
   Insert Into ycurs Values(Myarray(i))
Endfor
Sele ycurs
tot=tot+Reccount()
Locate
Browse Name ybrow   Title "VFP DBC Events: "+Trans(Reccount()) Nowait    &&window as oop object
With ybrow
   .DeleteMark=.F.
   .GridLines=0
   .RecordMark=.F.
   .Width=300
   .Left=100
   .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(140,215,240))", "Column")
   .FontBold=.T.
Endwith
Wait Window

Use In ycurs
Set Safe On

Messagebox("can highlight with vfp all theses commands, functions,base classes,dbc events ("+Trans(tot)+" elements)",0+32+4096,"vfp syntax highlighter")

set safe off

retu

*End Code*

this is one of 4 browse views of the code above.

*!*This a try to show how use vfp to highlight syntaxe in all based text files (prg,mpr,txt,h...)
*!*the result is shown in html file with iexplore.
*!*Can use Alanguage to gather all vfp elements and choice standard highliting.
*!*This template is made with a web page for internet explorer.
*!*can customize many parameters
*!*

*Begin Code

Local lcfilename
lcfilename=Getfile('prg|txt|mpr|h|log')
If ! Inlist(Lower(Justext(m.lcfilename)),"prg","txt","mpr","h","log")
Return .F.
Endi
Set Memowidth To 8192
Local bgcolor
bgcolor= Rgb(239,239,220) &&rgb(200,200,200) &&rgb(128,128,128 -Rgb(239,239,220)-rgb(87,75,233) rgb &&background color
Local ystr,r
ystr=Allt(Filetostr(m.lcfilename))
Local m.myvar
cr=Chr(13)+Chr(10)
m.myvar=""
For i=1 To Memlines(m.ystr)
m.myvar=m.myvar+""+Trans(i)+"   "+Mline(m.ystr,i)+" "+cr
Endfor

Local oo1,oo2
oo1=""

Create Cursor ycurs ( Word c(20),Color c(10),replacement c(80))
For i=0 To 9
Insert Into ycurs Values (Trans(i),"Teal","")
Endfor
Insert Into ycurs Values ("do case","TEAL","")
Insert Into ycurs Values ("endcase","BLUE","")
Insert Into ycurs Values ("do","PURPLE","")
Insert Into ycurs Values ("enddo","CYAN","")
Insert Into ycurs Values ("endfor","RED","")
Insert Into ycurs Values ("next","RED","")
Insert Into ycurs Values ("if","MAROON","")
Insert Into ycurs Values ("endif","MAROON","")
Insert Into ycurs Values ("text","darkViolet","")
Insert Into ycurs Values ("endtext","darkviolet","")
Insert Into ycurs Values ("with","RED","")
Insert Into ycurs Values ("endwith","RED","")
Insert Into ycurs Values ("Declare integer","NAVY","")
Insert Into ycurs Values ("integer","NAVY","")
Insert Into ycurs Values ("# define","darkred","")
Insert Into ycurs Values ("#define","darkred","")
Insert Into ycurs Values ("local","GREEN","")
Insert Into ycurs Values ("*","green","")
Insert Into ycurs Values ("(","red","")
Insert Into ycurs Values (")","RED","")
Insert Into ycurs Values ("[","red","")
Insert Into ycurs Values (".","black","")
Insert Into ycurs Values ("Try","blue","")
Insert Into ycurs Values ("Catch","blue","")
Insert Into ycurs Values ("Endtry","blue","")
Insert Into ycurs Values ("CREATEOBJECT","brown","")
Insert Into ycurs Values ("NEWOBJECT","GREENblue","")
Insert Into ycurs Values ("CLASS","Rdarkblue","")

Repl All Word With Upper(Word)
Repl All replacement With m.oo1+Color+m.oo2+Allt(Word)+""
Appe Blan
Repl Color With "midnightblue"

*Brow

Sele ycurs
Scan
m.myvar=Strtran(m.myvar,Allt(Word),Allt(replacement),1,100000,1) &&insensitive
Endscan

Local lcDest
lcDest=Addbs(Justpath(Sys(2023)))+"ysyntaxHighlighter.html"
Set Safe Off
Strtofile( m.myvar,m.lcDest)
Set Safe On

Publi apie
apie=Newobject("internetexplorer.application")
With apie
   .Navigate(lcDest)
   .menubar=0
   .Toolbar=0
   .StatusBar=0
   .Width=800
   .Height=600
   .Top=50
   .Resizable=0
   .Left=(Sysmetric(1)-.Width)/2
   Do While .busy Or .readystate#4 && transitionnings
       Inke(0.1)
   Enddo
   .Document.body.bgcolor= m.bgcolor
   Declare Integer BringWindowToTop In Win32API Integer lnWnd
   = SetWindowText (.HWnd , "Visual Foxpro Syntax Highlighter: "+Justfname(m.lcfilename) +'    ('+Trans(Memlines(m.ystr))+" lines)")
   Declare Integer GetWindowToTop In user32 intger
   =BringWindowToTop(.HWnd)
   .Visible=.T.
Endwith

Retu

*End Code

this is an internet explorer a view of syntax highlighting.

*!*This uses an HTA file who is derived from Internet explorer(same but without all security

*!* luguages.it seems as a vfp form
*!*the result is shown in HTA file with shellexecute (associated app=mshtml.exe).
*!*

*Begin code

Set Safe Off
Local lcfilename
lcfilename=Getfile('prg|txt|mpr|h|log')
If ! Inlist(Lower(Justext(m.lcfilename)),"prg","txt","mpr","h","log")
Return .F.
Endi
Set Memowidth To 8192
Local bgcolor
bgcolor= Rgb(239,239,220) &&rgb(200,200,200) &&rgb(128,128,128 -Rgb(239,239,220)-rgb(87,75,233) rgb &&background color
Local ystr,r
ystr=Allt(Filetostr(m.lcfilename))
Local m.myvar
cr=Chr(13)+Chr(10)
m.myvar=""
For i=1 To Memlines(m.ystr)
m.myvar=m.myvar+""+Trans(i)+"   "+Mline(m.ystr,i)+" "+cr
Endfor

Local oo1,oo2
oo1=""

Create Cursor ycurs ( Word c(20),Color c(10),replacement c(80))
For i=0 To 9
Insert Into ycurs Values (Trans(i),"Teal","")
Endfor
Insert Into ycurs Values ("do case","TEAL","")
Insert Into ycurs Values ("endcase","BLUE","")
Insert Into ycurs Values ("do","PURPLE","")
Insert Into ycurs Values ("enddo","CYAN","")
Insert Into ycurs Values ("endfor","RED","")
Insert Into ycurs Values ("next","RED","")
Insert Into ycurs Values ("if","MAROON","")
Insert Into ycurs Values ("endif","MAROON","")
Insert Into ycurs Values ("text","YELLOW","")
Insert Into ycurs Values ("endtext","YELLOW","")
Insert Into ycurs Values ("with","RED","")
Insert Into ycurs Values ("endwith","RED","")
Insert Into ycurs Values ("Declare integer","NAVY","")
Insert Into ycurs Values ("integer","NAVY","")
Insert Into ycurs Values ("# define","darkred","")
Insert Into ycurs Values ("#define","darkred","")
Insert Into ycurs Values ("local","GREEN","")
Insert Into ycurs Values ("*","green","")
Insert Into ycurs Values ("(","red","")
Insert Into ycurs Values (")","RED","")
Insert Into ycurs Values ("[","red","")
Insert Into ycurs Values (".","black","")
Insert Into ycurs Values ("Try","blue","")
Insert Into ycurs Values ("Catch","blue","")
Insert Into ycurs Values ("Endtry","blue","")
Insert Into ycurs Values ("CREATEOBJECT","brown","")
Insert Into ycurs Values ("NEWOBJECT","GREENblue","")
Insert Into ycurs Values ("CLASS","Rdarkblue","")
Insert Into ycurs Values ("DEFIENDDEFINECLASS","Rdarkblue","")
Insert Into ycurs Values ("RETU","RED","")

Repl All Word With Upper(Word)
Repl All replacement With m.oo1+Color+m.oo2+Allt(Word)+""
Appe Blan
Repl Color With "midnightblue"

*Brow

Sele ycurs
Scan
m.myvar=Strtran(m.myvar,Allt(Word),Allt(replacement),1,100000,1) &&insensitive
Endscan

TEXT to m.myvar textmerge noshow
<html>
<head>
<title>vfp syntax highlighter : <<sys(16)>> (<< memlines(m.ystr) >>)</title>
<HTA:APPLICATION ID="highlighter"
 APPLICATIONNAME="syntax highlighter"
 ICON="SUN.ICO"
 SCROLL="auto"
 BORDER="thin"
 BORDERSTYLE="normal"
 MAXIMIZEBUTTON="no"
 MINIMIZEBUTTON="yes"
 SHOWINTASKBAR="yes"
 SINGLEINSTANCE="yes"
 SYSMENU="yes"
 CAPTION="yes"
 WINDOWSTATE="normal" />
</head>
<body bgcolor=LightGoldenRodYellow >
<<m.myvar>>
</body></html>
ENDTEXT
Local lcDest
Copy File (Home(1)+"graphics\icons\elements\sun.ico") To Sys(2023)
lcDest=Addbs(Sys(2023))+"ysyntaxHighlighter.hta"

Strtofile( m.myvar,m.lcDest)
Set Safe On
&&shellexecute :mshta.exe is the windows associated application to run hta files
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
   STRING cOperation,;
   STRING cFileName,;
   STRING cParameters,;
   STRING cDirectory,;
   INTEGER nShowWindow

result = ShellExecute(0, "open", m.lcDest,"","",1)

Retu

*End Code

this is a hta view of syntax highlighting.

*vfp can edit any code (text format) as prg,mpr,h,xml,html,txt....with numeric filed index and line *by line code in traditional browse window.can add some cosmetics to that.

*Begin code

Close Data All
Publi afile
Local cr,ystr
afile=Getfile('prg|txt|mpr|log')
If ! Inlist(Lower(Justext(m.afile)),"prg","txt","mpr","log") &&can add others
Return .F.
Endi

Set Memowidth To 8192
Create Cursor ycurs (num i,xline c(254))
cr=Chr(13)+Chr(10)
ystr=Filetostr(m.afile)
For i=1 To Memlines(ystr)
   Insert Into ycurs Values (i,Mline(ystr,i))
Endfor
Sele ycurs
Locate
Brow Name yb Title (afile)+"   lines="+Trans(Memlines(ystr)) Font 'courier', 10 Nolgrid Norgrid noedit Nodelete Nowait &&to adapt
With yb
   .DeleteMark=.F.
   .RecordMark=.F.
   .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(220,255,190))", "Column")
   .column1.Width=30
   .column1.DynamicBackColor = "rgb(128,128,128)"
   .column1.DynamicForeColor = "rgb(0,255,0)"   && green

.column2.DynamicForeColor = "rgb(0,0,255)" && blue

Endwith

Retu

*End code

this is a browse window with code of any edited file.can make it also on vfp grid with more capabilities.

Click on code to select [then copy] -click outside to deselect

  added on Friday 22 janvier 2016; 17:15:53
*TYPE  vfp command can be directed to a file to retrieve the code prg with numbers of each code line.
*syntax command
*TYPE FileName1   [AUTO]   [WRAP]   [TO PRINTER [PROMPT] | TO FILE FileName2]   [NUMBER]

local m.lcfile
m.lcfile=getfile('prg')
if !lower(justext(m.lcfile))=="prg" or empty(m.lcfile)
return .f.
endi
local m.lcfile1
m.lcfile1=juststem(m.lcfile)+"_num."+justext(m.lcfile) &&can even export to txt...
set heading off
type (m.lcfile) to file (m.lcfile1) number
modi comm (m.lcfile1)

its a simple and cached way to make num lines for any code.