mwfoxprosyn.msg

来自「著名的Handle」· MSG 代码 · 共 650 行

{Grammar for a Foxpro HighLighter .prg}
{Copyright 2000 riceball.  All right reserved}
{mailto:[e-mail]}{No syntax check takes Place}
{ DISCLAIMER:  This is provided as is, expressly without a warranty of any kind.}
{ You use it at your own risc. }
{
    FRoundCount: Integer;
    FSquareCount: Integer;
}
TFoxproSyn {first Identifier is considered to be the Class Name }
tk        {second Identifier is considered to be the Identifier Prefix }
{Sensitive : Optional}
IdentStart '_', 'a'..'z', 'A'..'Z':: '_', '0'..'9', 'a'..'z', 'A'..'Z'::

KEYS  { all between KEYS and |><| is considered to be a keyword }
{Symbol}
and
not
or

{Keywords}
_msysmenu
_screen
abs
accept
acti
activate
again
alias
all
alltrim
alternate
ansi
ansitooem
aplabout
appe
append
array
asc
at
atan
atline
autosave
backcolor
bar
barcount
barprompt
begin
bell
between
blan
blank
blink
blocksize
bof
border
bott
bottom
box
brow
browse
brstatus
build
call
cancel
capslock
caption
carry
case
century
chr
class
classlib
clear
clock
clos
close
collate
color
comm
command
commands
compatible
confirm
console
copy
create
curdir
currency
cursor
database
databases
date
debug
decimals
default
define
dele
delete
deleted
delimite
delimiters
development
device
dim
dimension
display
do
dohistory
echo
edit
else
empty
endcase
enddo
endfor
endif
endproc
endscan
eof
escape
exact
exclusive
event
events
fclose
fcount
fcreate
field
fields
file
files
fill
filter
fixed
fopen
for
format
fputs
from
fullpath
func
functi
function
fwrite
gath
gather
get
go
headings
help
helpfilter
hours
if
index
insert
intensity
into
key
keycomp
library
local
locate
lock
logerrors
macdesktop
machelp
mackey
margin
mark
memo
memowidth
memvar
menu
message
modal
modi
modify
mouse
multilocks
near
next
nocptrans
notify
nowait
odometer
of
off
on
optimize
order
otherwise
palette
para
parameter
parameters
path
pdsetup
point
printer
private
proc
proced
procedure
prompt
public
push
quit
read
readborder
recno
refresh
region
regional
rela
relati
relation
release
repl
repla
replace
reprocess
resource
retu
return
rgb
safety
say
scan
scat
scatt
scatter
scheme
schemes
scoreboard
screen
seek
sele
select
separator
set
shadows
skip
space
status
step
sticky
store
str
sysmenu
table
tag
talk
text
textmerge
this
thisform
to
top
topic
trbetween
typeahead
udfparms
unique
use
val
view
volume
wait
while
window
with
xcmdfile
year

|><| { token names }
Comment
Identifier
Key
Null
Number
Space
String
Symbol
Unknown
|><|

CHARS

#0:: Null
BeginProc
  fTokenID := tkNull;
EndProc

#10:: LF
BeginProc
  fTokenID := tkSpace;
  inc(Run);
EndProc

#13:: CR
BeginProc
  fTokenID := tkSpace;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;//case
EndProc

#1..#9, #11, #12, #14..#32:: Space
BeginProc
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
EndProc

#34::  String
BeginProc
  fTokenID := tkString;
  if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        if FLine[Run + 1] = #10 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = #34;
  if FLine[Run] <> #0 then inc(Run);
EndProc

#39::  AsciiChar
BeginProc
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #39;
  if FLine[Run] <> #0 then inc(Run);
EndProc

'0'..'9':: Number
BeginProc
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in
      ['0'..'9', '.', 'x', 'X', 'e', 'E', 'f', 'F'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
    end;
    inc(Run);
  end;
EndProc

'A'..'Z', 'a'..'z', '_':: Ident
BeginProc
  if (FLine[Run] = 'C') and (Run = 0) then
  begin   //Fortran comments
    inc(Run, 1);
    fTokenID := tkComment;
    while FLine[Run] <> #0 do
    begin
      case FLine[Run] of
        #10, #13: break;
      end; //case
      inc(Run);
    end; //while
  end
  else begin
    fTokenID := IdentKind((fLine + Run));
    inc(Run, fStringLen);
    while Identifiers[fLine[Run]] do inc(Run);
  end;
EndProc

'!':: NotSymbol
BeginProc
  {not}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'{':: BraceOpen
BeginProc
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        if FLine[Run + 1] = #10 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = '}';
  if FLine[Run] <> #0 then inc(Run);
EndProc

'~':: Tilde
BeginProc
  inc(Run);
  fTokenId := tkSymbol;
EndProc

'|':: OrSymbol
BeginProc
  {or}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'%':: ModSymbol
BeginProc
  {mod}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'&':: AndSymbol
BeginProc
  case FLine[Run + 1] of
    '&':                               {Comments}
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end; //case
          inc(Run);
        end;
      end;
  else                                 {and}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
EndProc

'(':: RoundOpen
BeginProc
  inc(Run);
  FTokenID := tkSymbol;
  inc(FRoundCount);
EndProc

')':: RoundClose
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
  dec(FRoundCount);
EndProc

'*':: Star
BeginProc
  if Run = 0 then
  begin                        {Foxpro Comments}
    inc(Run);
    fTokenID := tkComment;
    while FLine[Run] <> #0 do
    begin
      case FLine[Run] of
        #10, #13: break;
      end;
      inc(Run);
    end;
  end else begin
    {star}
    inc(Run);
    fTokenID := tkSymbol;
  end;
EndProc

'+':: Plus
BeginProc
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

',':: Comma
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'-':: Minus
BeginProc
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'.':: Point
BeginProc
  if ((UpCase(FLine[Run + 1]) = 'T')           {.t.}
       or (UpCase(FLine[Run + 1]) = 'F'))      {.f.}
     and (FLine[Run + 2] = '.') then
  begin
      inc(Run, 3);
      fTokenID := tkSymbol;
  end
  else if (((UpCase(FLine[Run + 1]) = 'A')
              and (UpCase(FLine[Run + 2]) = 'N')
              and (UpCase(FLine[Run + 3]) = 'D'))    {.and.}
           or ((UpCase(FLine[Run + 1]) = 'N')
              and (UpCase(FLine[Run + 2]) = 'O')
              and (UpCase(FLine[Run + 3]) = 'T')))    {.not.}
          and (FLine[Run + 4] = '.') then
  begin
      inc(Run, 5);
      fTokenID := tkSymbol;
  end
  else if (UpCase(FLine[Run + 1]) = 'O') 
          and (UpCase(FLine[Run + 2]) = 'R')
          and (FLine[Run + 3] = '.') then  {.or.}
  begin
      inc(Run, 4);
      fTokenID := tkSymbol;
  end
  else                                 {point}
  begin
    inc(Run);
    fTokenID := tkSymbol;
  end;
EndProc

'/':: Slash
BeginProc
  {division}
   inc(Run);
   fTokenID := tkSymbol;
EndProc

':':: Colon
BeginProc
  {colon}
  inc(Run);
  fTokenID := tkSymbol;
EndProc

';':: SemiColon
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'<':: Lower
BeginProc
  case FLine[Run + 1] of
    '=':                               {less than or equal to}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '<':
      begin
        if FLine[Run + 2] = '=' then   {shift left assign}
          inc(Run, 3)
        else                           {shift left}
          inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {less than}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
EndProc

'=':: Equal
BeginProc
  case FLine[Run + 1] of
    '=':                               {logical equal}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {assign}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
EndProc

'>':: Greater
BeginProc
  Case FLine[Run + 1] of
    '=':                               {greater than or equal to}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '>':
      begin
        if FLine[Run + 2] = '=' then   {shift right assign}
          inc(Run, 3)
        else                           {shift right}
          inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {greater than}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
EndProc

'?':: Question
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
EndProc

'@':: AtSymbol
BeginProc
  fTokenID := tkKey;
  inc(Run);
EndProc

'[':: SquareOpen
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
  inc(FSquareCount);
EndProc

']':: SquareClose
BeginProc
  inc(Run);
  fTokenID := tkSymbol;
  dec(FSquareCount);
EndProc

'^':: XOrSymbol
BeginProc
  {xor}
  inc(Run);
  fTokenID := tkSymbol;
EndProc
|><|