cparser1.pas

C,C++ To Delphi转换器 C,C++ To Delphi转换器

unit CParser1;
// Free for any project that try to translate C to Pascal
// (c)2002 by Paul TOTH <[e-mail]>
{$i-}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Project1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Quit1: TMenuItem;
    Compile1: TMenuItem;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    Addfile1: TMenuItem;
    Removefile1: TMenuItem;
    Label1: TLabel;
    RichEdit1: TRichEdit;
    procedure Open1Click(Sender: TObject);
    procedure Addfile1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure Removefile1Click(Sender: TObject);
    procedure Compile1Click(Sender: TObject);
  private
    { D閏larations priv閑s }
    procedure SaveDesktop;
  public
    { D閏larations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
 CSource;

Type
 TSection=(
  scDefault,
  scComment,
  scDefine,
  scInclude,
  scKeyword,
  scError
 );
 TAttributes=record
  SectionColor:TColor;
  SectionStyle:TFontStyles;
 end;
Const
 Attributes:array[TSection] of TAttributes=(
  (SectionColor:clBlack; SectionStyle:[]),
  (SectionColor:clBlue;  SectionStyle:[fsItalic]),
  (SectionColor:clGreen; SectionStyle:[]),
  (SectionColor:clBlue;  SectionStyle:[fsBold]),
  (SectionColor:clBlack; SectionStyle:[fsBold]),
  (SectionColor:clRed;   SectionStyle:[fsBold])
 );

Type
 TType=(
  tCHAR,
  tUCHAR,
  tINT,
  tUINT
 );

 TReader=class

  FileName:string;
  Name:string;
  Lines:TStringList;

  Index:integer;
  LineIndex:integer;
  Line:string;
  LinePos:integer;
  TokenStart:integer;
  Token:string;
  Start:integer;

  Defines:TStringList;
  Includes:TStringList;
  Externs:TStringList;

  Constructor Create(AFileName:string);
  Destructor Destroy; override;

  Procedure Error(Msg:string);

  Procedure SetAttributes(Section:TSection);

  Procedure Prepare;
  procedure Cleanup;

  procedure Blanks;

  procedure NewLine;
  function EndOfLine:string;

  function NextChar:char;

  function DropChar:char;
  function SkipChar(c:char):boolean;
  procedure NeedChar(c:char);

  procedure GetFileName;
  procedure GetIdent;
  function SkipIdent(s:string):boolean;
  function IdentIndex(idents:array of string):integer;

  procedure parse;
  procedure define;
  procedure include;
  procedure extern;
  procedure uglobal(extern:boolean);
  procedure global(extern:boolean; ctype:TType);
 end;

Function LastChar(s:string):integer;
 begin
  Result:=Length(s);
  while (Result>0)and(s[Result]=' ') do dec(Result);
 end;

Constructor TReader.Create(AFileName:string);
 begin
  FileName:=AFileName;
  Name:=ExtractFileName(FileName);
  Lines:=TStringList.Create;
  Lines.LoadFromFile(FileName);
  Defines:=TStringList.Create;
  Includes:=TStringList.Create;
  Externs:=TStringList.Create;
 end;

Destructor TReader.Destroy;
 begin
  Lines.Free;
  Defines.Free;
  Includes.Free;
  Externs.Free;
  inherited;
 end;

Procedure TReader.Error(Msg:string);
 begin
  SetAttributes(scError);
  Form1.Label1.Caption:=' '+Msg;
  Form1.Label1.Show;
  Form1.RichEdit1.SetFocus;
  Abort;
 end;

Procedure TReader.SetAttributes(Section:TSection);
 begin
  with Form1.RichEdit1 do begin
   SelStart:=Start;
   SelLength:=Index-Start+1;
   with SelAttributes,Attributes[Section] do begin
    Color:=SectionColor;
    Style:=SectionStyle;
   end;
   Start:=Index+1;
  end;
 end;

Procedure TReader.Prepare;
 begin
  try
   Screen.Cursor:=crHourglass;
   Form1.Label1.Hide;
   with Form1.RichEdit1 do begin
    Lines.BeginUpdate;
    Clear;
    with DefAttributes,Attributes[scDefault] do begin
     Color:=SectionColor;
     Style:=SectionStyle;
    end;
   end;
   if Lines.Count=0 then exit;
   Form1.RichEdit1.Lines.Assign(Lines);
   Cleanup;
   parse;
   with Form1.RichEdit1 do begin
    SelStart:=0;
    SelLength:=0;
   end;
  finally
   Form1.RichEdit1.Lines.EndUpdate;
   Screen.Cursor:=crDefault;
  end;
 end;

Procedure TReader.Cleanup;
 begin
  LineIndex:=0;
  Line:=Lines[LineIndex];
  LinePos:=1;
  TokenStart:=0;
  Token:='';
  Index:=-1;
  Defines.Clear;
  Includes.Clear;
  Externs.Clear;
  blanks;
 end;

Procedure TReader.Blanks;
 begin
  while SkipChar(' ') do ;
  while SkipChar('/') do begin // there's no reason to have a "/" if it's not a comment !
   Start:=Index;
   if SkipChar('/') then begin
    Inc(Index,Length(Line)-LinePos);
    LinePos:=Length(Line)+1
   end else begin
    NeedChar('*');
    repeat
     repeat until DropChar='*';
    until SkipChar('/');
   end;
   SetAttributes(scComment);
   while SkipChar(' ') do ;
  end;
 end;

procedure TReader.NewLine;
 begin
  if LineIndex=Lines.Count-1 then Line:=#27 else begin
   inc(LineIndex);
   Line:=lines[LineIndex];
   inc(Index,2);
  end;
  LinePos:=1;
 end;

function TReader.EndOfLine:string;
 var
  i:integer;
 begin
  Blanks;
  Result:=Copy(Line,LinePos,Length(Line));
  inc(Index,Length(Result));
  NewLine;
  i:=LastChar(Result);
  while (i>0)and(Result[i]='\') do begin
   inc(Index,Length(Line));
   Result:=Copy(Result,1,i-1)+Line;
   NewLine;
   i:=LastChar(Result);
  end;
  SetLength(Result,i);
 end;

function TReader.NextChar:char;
 begin
  while LinePos>Length(Line) do NewLine;
  Result:=Line[LinePos];
 end;

function TReader.DropChar:char;
 begin
  Result:=NextChar;
  Inc(LinePos);
  Inc(Index);
 end;

function TReader.SkipChar(c:char):boolean;
 begin
  Result:=(NextChar=c);
  if Result then DropChar;
 end;

procedure TReader.NeedChar(c:char);
 begin
  if not SkipChar(c) then Error('Expected '+c);
 end;

procedure TReader.Parse;
 begin
  while SkipChar('#') do begin
   Start:=Index;
   case IdentIndex(['define','include']) of
    0 : define;
    1 : include;
    else error('Unknow directive '+Token);
   end;
   blanks;
  end;
  while NextChar<>#27 do begin
   Start:=Index+1;
   case IdentIndex(['extern','usigned','int','char']) of
    0: extern;
    1: uglobal(false);
    2: global(false,tINT);
    3: global(false,tCHAR);
    else error('unknow ident');
   end;
  end;
 end;

procedure TReader.GetFileName;
 begin
  GetIdent;
  if SkipChar('.') then begin
   Token:=Token+'.';
   while NextChar in ['A'..'Z','a'..'z','_','0'..'9'] do Token:=Token+DropChar;
  end;
 end;

procedure TReader.GetIdent;
 begin
  if NextChar in ['A'..'Z','a'..'z','_'] then begin
   TokenStart:=Index;
   Token:=DropChar;
   while NextChar in ['A'..'Z','a'..'z','_','0'..'9'] do Token:=Token+DropChar;
  end else begin
   error('Invalid ident');
  end;
 end;

Function TReader.SkipIdent(s:string):boolean;
 begin
  Result:=false;
  blanks;
  if NextChar in ['A'..'Z','a'..'z','_'] then begin
   GetIdent;
   if Token=s then begin
    Result:=True;
    blanks;
   end else begin
    Index:=TokenStart;
   end;
  end;
 end;

function TReader.IdentIndex(idents:array of string):integer;
 begin
  Blanks;
  GetIdent;
  Result:=High(idents);
  while (Result>=0) and (idents[Result]<>Token) do dec(Result);
 end;

procedure TReader.Define;
 var
  name:string;
  parm:string;
 begin
  Blanks;
  GetIdent;
  name:=Token;
  if NextChar='(' then begin
   Parm:=DropChar;
   while NextChar<>')' do begin
    Parm:=Parm+DropChar;
   end;
   Parm:=DropChar;
  end else begin
   Parm:=' ';
  end;
  SetAttributes(scDefine);
  Token:=EndOfLine;//GetMacro;
  Defines.Add(Name+'='+Parm+Token);
  CSource.Define(Name,Parm,Token);
 end;

procedure TReader.Include;
 begin
  SetAttributes(scDefine);
  Blanks;
  if SkipChar('<') then begin
   GetFileName;
   NeedChar('>');
   Includes.add('<'+Token+'>');
  end else begin
   NeedChar('"');
   GetFileName;
   NeedChar('"');
   Includes.add('"'+Token+'"');
  end;
  SetAttributes(scInclude);
 end;

procedure TReader.uglobal(extern:boolean);
 begin
  SetAttributes(scKeyword);
  case IdentIndex(['int','char']) of
   0    : global(extern,tUINT);
   1    : global(extern,tUCHAR);
   else   error('unknow type '+token);
  end;
 end;

procedure TReader.extern;
 begin
  SetAttributes(scKeyword);
  case IdentIndex(['unsigned','int','char']) of
   0 : uglobal(true);
   1 : global(true,tINT);
   2 : global(true,tCHAR);
   else global(true,tINT);
  end;
 end;

procedure TReader.global(extern:boolean; ctype:TType);
 begin
  SetAttributes(scKeyword);
  error('todo');
 end;

procedure TForm1.Open1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Addfile1Click(Sender: TObject);
var
 s:string;
 i:integer;
 r:TReader;
begin
 if OpenDialog1.Execute then begin
  s:=OpenDialog1.FileName;
  i:=ListBox1.Items.IndexOf(s);
  if i<0 then begin
   r:=TReader.Create(s);
   ListBox1.Items.AddObject(r.Name,r);
  end;
 end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
 i:integer;
begin
 i:=ListBox1.ItemIndex;
 if i>=0 then TReader(ListBox1.Items.Objects[i]).Prepare;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 CanClose:=True;
 case Application.MessageBox('Save desktop ?','C Parser',MB_YESNOCANCEL) of
  idYes: SaveDesktop;
  idCancel:CanClose:=False;
 end;
end;

procedure TForm1.SaveDesktop;
 var
  s:string;
  f:TextFile;
  i:integer;
 begin
  s:=ChangeFileExt(Application.ExeName,'.CPD');
  AssignFile(f,s);
  Rewrite(f);
  for i:=0 to ListBox1.Items.Count-1 do begin
   WriteLn(f,TReader(ListBox1.Items.Objects[i]).FileName);
  end;
  CloseFile(f);
 end;

procedure TForm1.FormActivate(Sender: TObject);
 var
  s:string;
  f:TextFile;
  r:TReader;
begin
  s:=ChangeFileExt(Application.ExeName,'.CPD');
  AssignFile(f,s);
  Reset(f);
  if IoResult<>0 then exit;
  while not eof(f) do begin
   ReadLn(f,s);
   r:=TReader.Create(s);
   ListBox1.Items.AddObject(r.Name,r);
  end;
  CloseFile(f);
end;

procedure TForm1.Removefile1Click(Sender: TObject);
var
 i:integer;
begin
 i:=ListBox1.ItemIndex;
 if i>=0 then begin
  RichEdit1.Clear;
  TReader(ListBox1.Items.Objects[i]).Free;
  ListBox1.Items.Delete(i);
 end;
end;

procedure TForm1.Compile1Click(Sender: TObject);
var
 i:integer;
begin
 for i:=0 to 1+0*ListBox1.Items.Count-1 do begin
  TReader(ListBox1.Items.Objects[i]).Prepare;
 end;
end;

end.