Around syntax Highlighting in visual foxpro

Published on 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 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+"<span style='color: Teal; background-color: ' >"+Trans(i)+"</span>&nbsp;&nbsp;&nbsp;"+Mline(m.ystr,i)+"<br>"+cr
Endfor

Local oo1,oo2
oo1="<span style='color:"
oo2="; background-color: '>"

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)+"</span>"
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 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+"<span style='color: Teal; background-color: ' >"+Trans(i)+"</span>&nbsp;&nbsp;&nbsp;"+Mline(m.ystr,i)+"<br>"+cr
Endfor

Local oo1,oo2
oo1="<span style='color:"
oo2="; background-color: '>"

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)+"</span>"
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.

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.

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.

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

To be informed of the latest articles, subscribe:
Comment on this post