pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

chelper: initial check in

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1270 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2010-08-07 21:53:59 +00:00
parent cf243fb88b
commit bf781d24bc
15 changed files with 4753 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

89
components/chelper/cconvconfig.pas Normal file
View File

@ -0,0 +1,89 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit cconvconfig;
{$mode delphi}
interface
uses
Classes, SysUtils, ctopasconvert, IniFiles;
procedure LoadFromFile(const FileName: AnsiString; cfg: TConvertSettings);
procedure SaveToFile(const FileName: AnsiString; cfg: TConvertSettings);
implementation
procedure LoadFromFile(const FileName: AnsiString; cfg: TConvertSettings);
var
ini : TIniFile;
begin
if not Assigned(cfg) then Exit;
try
ini:=TIniFile.Create(FileName);
try
// C to Pas Types
ini.ReadSectionValues('Types', cfg.CtoPasTypes);
cfg.RecordsArePacked:=ini.ReadBool('Main','RecordsArePacked', cfg.RecordsArePacked);
cfg.FuncsAreExternal:=ini.ReadBool('Main','FuncsAreExternal', cfg.FuncsAreExternal);
cfg.EnumsAsConst:=ini.ReadBool('Main','EnumAsConst', cfg.EnumsAsConst);
cfg.TypeNamePrefix:=ini.ReadString('Main','TypeNamePrefix',cfg.TypeNamePrefix);
cfg.RefTypeNamePrefix:=ini.ReadString('Main','RefTypeNamePrefix',cfg.RefTypeNamePrefix);
cfg.FuncConv:=ini.ReadString('Main','FuncConv',cfg.FuncConv);
cfg.FuncDeclPostfix:=ini.ReadString('Main','FuncDeclPostfix',cfg.FuncDeclPostfix);
cfg.ParamPrefix:=ini.ReadString('Main','ParamPrefix',cfg.ParamPrefix);
finally
ini.Free;
end;
except
end;
end;
procedure SaveToFile(const FileName: AnsiString; cfg: TConvertSettings);
var
ini : TIniFile;
i : Integer;
begin
if not Assigned(cfg) then Exit;
try
ini:=TIniFile.Create(FileName);
try
// C to Pas Types
for i:=0 to cfg.CtoPasTypes.Count-1 do
ini.WriteString('Types', cfg.CtoPasTypes.Names[i], cfg.CtoPasTypes.ValueFromIndex[i]);
ini.WriteBool('Main','RecordsArePacked', cfg.RecordsArePacked);
ini.WriteBool('Main','FuncsAreExternal', cfg.FuncsAreExternal);
ini.WriteBool('Main','EnumAsConst', cfg.EnumsAsConst);
ini.WriteString('Main','TypeNamePrefix',cfg.TypeNamePrefix);
ini.WriteString('Main','RefTypeNamePrefix',cfg.RefTypeNamePrefix);
ini.WriteString('Main','FuncConv',cfg.FuncConv);
ini.WriteString('Main','FuncDeclPostfix',cfg.FuncDeclPostfix);
ini.WriteString('Main','ParamPrefix',cfg.ParamPrefix);
finally
ini.Free;
end;
except
end;
end;
end.

92
components/chelper/cconvert.lpi Normal file
View File

@ -0,0 +1,92 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<Language Value=""/>
<CharSet Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="cconvert.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cconvert"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="cconvert"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
<CStyleOperator Value="False"/>
<IncludeAssertionCode Value="True"/>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
</Debugging>
<Options>
<LinkerOptions Value="-macosx_version_min 10.4 "/>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx3018="True" idx3031="True" idx3189="True" idx4035="True" idx4036="True" idx4055="True" idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5057="True" idx5058="True" idx5060="True"/>
<UseMsgFile Value="True"/>
<MsgFileName Value="/Users/dmitry/FPC_Laz/fpc/compiler/msg/errore.msg"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

113
components/chelper/cconvert.lpr Normal file
View File

@ -0,0 +1,113 @@
{ C-to-Pas converter command-line utility part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
program cconvert;
{$mode objfpc}{$H+}
uses
SysUtils,Classes,
ctopasconvert,cparserutils,cconvconfig;
var
ConfigFile : AnsiString = '';
OutputFile : AnsiString = '';
ConfigFileRO : Boolean = false;
function StringFromFile(const FileName: AnsiString): AnsiString;
var
fs : TFileStream;
begin
Result:='';
if not FileExists(FileName) then Exit;
try
fs:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
try
SetLength(Result, fs.Size);
fs.Read(Result[1], fs.Size);
finally
fs.Free;
end;
except
end;
end;
procedure InitSettings(cfg: TConvertSettings);
var
i : Integer;
p : AnsiString;
fn : AnsiString;
begin
i:=1;
while i<=Paramcount do begin
p:=AnsiLowerCase(ParamStr(i));
if p='-cfg' then begin
inc(i);
fn:=Trim(Paramstr(i));
ConfigFile:=fn;
if FileExists(fn) then cconvconfig.LoadFromFile(fn, cfg);
end else if p='-ro' then
ConfigFileRO:=True
else if p='-defines' then begin
inc(i);
cfg.CustomDefines:=cfg.CustomDefines+' ' + StringFromFile(ParamStr(i));
end else if p='-o' then begin
inc(i);
OutputFile:=ParamStr(i);
end;
inc(i);
end;
end;
var
inps, outs : TStringList;
i : Integer;
p : TPoint;
cfg : TConvertSettings;
begin
inps := TStringList.Create;
outs := TStringList.Create;
cfg:=TConvertSettings.Create;
try
InitSettings(cfg);
inps.LoadFromFile(ParamStr(ParamCount));
outs.Text:=ConvertCode(inps.Text, p, cfg);
if OutputFile<>'' then begin
outs.Insert(0, Format('%d %d', [p.Y,p.X]));
outs.SaveToFile(OutputFile)
end else begin
writeln(p.Y,' ',p.X);
for i:=0 to outs.Count-1 do
writeln(outs[i]);
end;
finally
if not ConfigFileRO and (ConfigFile<>'') then begin
ForceDirectories(ExtractFilePath(ConfigFile));
try
cconvconfig.SaveToFile(ConfigFile, cfg);
except
end;
end;
cfg.Free;
inps.Free;
outs.Free;
end;
end.

66
components/chelper/chelper.lpk Normal file
View File

@ -0,0 +1,66 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Name Value="chelper"/>
<Author Value="Dmitry 'skalogrz' Boyarintsev"/>
<CompilerOptions>
<Version Value="9"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="The IDE extension usefull for C headers convertion"/>
<License Value="LGPL"/>
<Version Minor="8"/>
<Files Count="6">
<Item1>
<Filename Value="tosourceeditor.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="toSourceEditor"/>
</Item1>
<Item2>
<Filename Value="ctopasconvert.pas"/>
<UnitName Value="ctopasconvert"/>
</Item2>
<Item3>
<Filename Value="extconvdialog.pas"/>
<UnitName Value="extconvdialog"/>
</Item3>
<Item4>
<Filename Value="cconvconfig.pas"/>
<UnitName Value="cconvconfig"/>
</Item4>
<Item5>
<Filename Value="converteridesettings.pas"/>
<UnitName Value="converteridesettings"/>
</Item5>
<Item6>
<Filename Value="extconvdialog.lfm"/>
<Type Value="LFM"/>
</Item6>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/chelper/chelper.pas Normal file
View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit chelper;
interface
uses
toSourceEditor, ctopasconvert, extconvdialog, cconvconfig,
converteridesettings, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('toSourceEditor',@toSourceEditor.Register);
end;
initialization
RegisterPackage('chelper',@Register);
end.

108
components/chelper/codewriter.pas Normal file
View File

@ -0,0 +1,108 @@
unit codewriter;
{$mode delphi}
interface
uses
Classes, SysUtils;
type
{ TCodeWriter }
TCodeWriter = class(TObject)
private
fnewline:Boolean;
fText : AnsiString;
fIdent : AnsiString;
fIdDelta : AnsiString;
newline : Boolean;
fCurLine : AnsiString;
fSection : AnsiString;
fMaxLen : Integer;
fCheckLineLen : Boolean;
public
constructor Create;
procedure IncIdent;
procedure DecIdent;
procedure W(const s: AnsiString='');
procedure Wln(const s: AnsiString='');
procedure StartNewLine;
property Section: AnsiString read fSection write fSection;
property Text: AnsiString read fText write fText;
property LineStarts: Boolean read fnewline;
property MaxLineLen: Integer read fMaxLen write fMaxLen;
property CheckLineLen: Boolean read fCheckLineLen write fCheckLineLen;
end;
procedure SetPasSection(wr: TCodeWriter; const SectionName: AnsiString; DoIdent: Boolean=true);
implementation
procedure SetPasSection(wr: TCodeWriter; const SectionName: AnsiString; DoIdent: Boolean);
begin
if wr.Section=SectionName then Exit;
if (wr.Section<>'') and DoIdent then wr.DecIdent;
if SectionName<>'' then wr.Wln(SectionName);
wr.Section:=SectionName;
if (wr.Section<>'') and DoIdent then wr.IncIdent;
end;
{ TCodeWriter }
constructor TCodeWriter.Create;
begin
fIdDelta:=' ';
newline:=True;
fMaxLen:=80;
end;
procedure TCodeWriter.IncIdent;
begin
fIdent:=fIdent+fIdDelta;
end;
procedure TCodeWriter.DecIdent;
begin
fIdent:=Copy(fIdent, 1, length(fIdent)-length(fIdDelta));
end;
procedure TCodeWriter.W(const s:String);
var
AutoBreak: Boolean;
begin
//todo: check eoln symbols in s
if s ='' then Exit;
AutoBreak:=CheckLineLen and (fCurLine<>'') and ( length(fCurLine+fIdent)+length(s) > fMaxLen);
if AutoBreak then begin
fText:=fText+LineEnding;
fCurLine:='';
fText:=fText+fIdent+fIdDelta;
end;
if newline then fText:=fText+fIdent;
fText:=fText+s;
fCurLine:=fCurLine+s;
newline:=False;
end;
procedure TCodeWriter.Wln(const s:String);
begin
W(s+LineEnding);
newline:=True;
fCurLine:='';
end;
procedure TCodeWriter.StartNewLine;
begin
if not newline then Wln;
end;
end.

110
components/chelper/converteridesettings.pas Normal file
View File

@ -0,0 +1,110 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit converteridesettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, ctopasconvert, IniFiles;
var
ConvSettings : TConvertSettings=nil;
ExtTool : AnsiString='';
UseExtTool : Boolean=True;
ExtTimeOut : LongWord = 5000;
ConvFile : AnsiString='';
DefineFile : AnsiString='';
procedure StringToFile(const Str, DstFileName: AnsiString);
function StringFromFile(const SrcFileName: AnsiString): AnsiString;
procedure WriteIDESettings(const FileName: AnsiString);
procedure ReadIDESettings(const FileName: AnsiString);
implementation
procedure StringToFile(const Str, DstFileName: AnsiString);
var
fs: TFileStream;
begin
fs:=TFileStream.Create(DstFileName, fmCreate);
if Str<>'' then fs.Write(Str[1], length(Str));
fs.Free;
end;
function StringFromFile(const SrcFileName: AnsiString): AnsiString;
var
fs : TFileStream;
begin
Result:='';
try
if not FileExists(SrcFileName) then Exit;
fs:=TFileStream.Create(SrcFileName, fmOpenRead or fmShareDenyNone);
try
SetLength(Result, fs.Size);
if fs.Size>0 then fs.Read(Result[1], fs.Size);
finally
fs.Free;
end;
except
end;
end;
procedure WriteIDESettings(const FileName:AnsiString);
var
ini : TIniFile;
begin
try
ini:=TIniFile.Create(FileName);
try
ini.WriteString('Tool', 'Exe', ExtTool);
ini.WriteString('Tool', 'DefineFile', DefineFile);
finally
ini.Free;
end;
except
end;
end;
procedure ReadIDESettings(const FileName:AnsiString);
var
ini : TIniFile;
begin
try
ini:=TIniFile.Create(FileName);
try
ExtTool:=ini.ReadString('Tool', 'Exe', ExtTool);
DefineFile:=ini.ReadString('Tool', 'DefineFile',DefineFile);
finally
ini.Free;
end;
except
end;
end;
initialization
ConvSettings := TConvertSettings.Create;
finalization
ConvSettings.Free;
end.

1944
components/chelper/cparsertypes.pas Executable file
View File

File diff suppressed because it is too large Load Diff

240
components/chelper/cparserutils.pas Normal file
View File

@ -0,0 +1,240 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit cparserutils;
interface
uses
cparsertypes;
// is function declared, i.e. int f()
function isFunc(name: TNamePart): Boolean;
// probably an untyped function: fn ().
// the name of the function has been consumed by TYPE parsing, so ommited!
// so TNamepart doesn't contain any children
function isUnnamedFunc(name: TNamepart): Boolean;
// is pointer to a function declared, i.e. int (*f)()
function isPtrToFunc(name: TNamePart): Boolean;
// is function declared, returning a pointer to a function, i.e. int (* (f)(int i) )()
// pascal variant of this case:
// type
// TRetFunc = function : Integer;
// function f(i: Integer): TRetFunc; // body or extern modifier must be present!!!
function isFuncRetFuncPtr(name: TNamePart): Boolean;
// is pointer to a function declared, returning a pointer to a function, i.e.: int (*(*f)(int i))()
// pascal variant of this case:
// type
// TRetFunc = function : Integer;
// var
// f : function (i: Integer): TRetFunc;
function isPtrToFuncRetFuncPtr(name: TNamePart): Boolean;
function GetFuncParam(name: TNamePart): TNamePart;
// is array variable:
// int a[10], *a[10] (array of 10 integers, or array of 10 pointers to integer)
function isArray(name: TNamePart): Boolean;
function GetArrayPart(name: TNamePart): TNamePart;
// returns the variable/function name from the struct
function GetIdFromPart(name: TNamePart): AnsiString;
function GetIdPart(name: TNamePart): TNamePart;
function isNamePartPtrToFunc(part: TNamePart): Boolean; inline;
type
{ TLineBreaker }
TLineInfo = record
linestart : Integer;
lineend : Integer;
end;
TLineBreaker = class(TObject)
private
fLines : array of TLineInfo;
flineCount : Integer;
procedure AddLine(const linestart, lineend: Integer);
public
procedure SetText(const AText: AnsiString);
function LineNumber(Offset: Integer): Integer;
end;
implementation
function isNamePartPtrToFunc(part: TNamePart): Boolean; inline;
begin
Result:=Assigned(part) and (part.Kind=nk_Ref) and Assigned(part.owner) and (part.owner.kind=nk_Func);
end;
function isPtrToFunc(name: TNamePart): Boolean;
begin
Result := Assigned(name) and (name.Kind=nk_Func) and Assigned(name.child) and
(name.child.Kind=nk_Ref) and Assigned(name.child.child) and
(name.child.child.Kind=nk_Ident);
end;
function SkipRefPart(name: TNamePart): TNamePart;
begin
if Assigned(name) then begin
if name.Kind=nk_Ref then Result:=name.child
else Result:=name;
end else
Result:=nil;
end;
function isFunc(name: TNamePart): Boolean;
begin
name:=SkipRefPart(name);
Result:=Assigned(name) and (name.Kind=nk_Func) and Assigned(name.child) and (name.child.Kind=nk_Ident)
end;
function isUnnamedFunc(name: TNamepart): Boolean;
begin
Result:=Assigned(name) and not Assigned(name.child) and (name.Kind=nk_Func);
end;
function isRetFuncPtr(name: TNamePart): Boolean;
begin
Result:=Assigned(name) and Assigned(name.child) and
(name.Kind=nk_Func) and (name.child.Kind=nk_Ref);
end;
function GetFuncParam(name:TNamePart):TNamePart;
begin
while Assigned(name) and (name.Kind<>nk_Func) do name:=name.child;
Result:=name;
end;
function isArray(name: TNamePart): Boolean;
begin
Result:=(name.Kind=nk_Array)
or (Assigned(name.child)
and (name.child.Kind=nk_Array)
and (name.Kind=nk_Ref));
end;
function isFuncRetFuncPtr(name: TNamePart): Boolean;
var
p : TNamePart;
begin
Result:=isRetFuncPtr(name);
if Result then begin
p:=name.child.child;
Result:=Assigned(p) and Assigned(p.child)
and (p.Kind=nk_Func)
and (p.child.Kind=nk_Ident)
end;
end;
function isPtrToFuncRetFuncPtr(name: TNamePart): Boolean;
var
p : TNamePart;
begin
Result:=isRetFuncPtr(name);
if Result then begin
p:=name.child.child;
Result:=Assigned(p) and Assigned(p.child) and Assigned(p.child.child)
and (p.Kind=nk_Func) and (p.child.Kind=nk_Ref)
and (p.child.child.Kind=nk_Ident);
end;
end;
function GetArrayPart(name:TNamePart):TNamePart;
begin
if name.Kind=nk_Array then
Result:=name
else if (name.Kind=nk_Ref) and (Assigned(name.child)) and (name.child.Kind=nk_array) then
Result:=name.child
else
Result:=nil;
end;
function GetIdFromPart(name: TNamePart): AnsiString;
begin
while Assigned(name) and (name.Kind<>nk_Ident) do
name:=name.child;
if Assigned(name) then Result:=name.Id
else Result:='';
end;
function GetIdPart(name: TNamePart): TNamePart;
begin
Result:=nil;
while Assigned(name) and (name.Kind<>nk_Ident) do
name:=name.child;
Result:=name;
end;
{ TLineBreaker }
procedure TLineBreaker.AddLine(const linestart,lineend:Integer);
begin
if flineCount=length(fLines) then begin
if fLineCount=0 then SetLength(fLines, 4)
else SetLength(fLines, fLineCount*2)
end;
fLines[fLineCount].linestart:=linestart;
fLines[fLineCount].lineend:=lineend;
inc(fLineCount);
end;
procedure TLineBreaker.SetText(const AText: AnsiString);
var
i : Integer;
j : Integer;
begin
flineCount:=0;
i:=1;
j:=1;
while i<=length(AText) do begin
if (AText[i] in [#10, #13]) then begin
inc(i);
if (i<=length(AText)) and (AText[i] in [#10, #13]) and (AText[i-1]<>Atext[i]) then
inc(i);
AddLine(j, i-1);
j:=i;
end else
inc(i);
end;
if j<>i-1 then AddLine(j, i-1);
end;
function TLineBreaker.LineNumber(Offset:Integer):Integer;
var
i : Integer;
begin
for i:=0 to flineCount-1 do
if (Offset>=fLines[i].linestart) and (Offset<=flines[i].lineend) then begin
Result:=i;
Exit;
end;
Result:=-1;
end;
end.

1213
components/chelper/ctopasconvert.pas Normal file
View File

File diff suppressed because it is too large Load Diff

20
components/chelper/ctopasexp.pas Normal file
View File

@ -0,0 +1,20 @@
unit CToPasExp;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, prsExpression;
function PascalizeCExp(CExp: TExpEntity; PascalExps : TList): Boolean;
implementation
function PascalizeCExp(CExp: TExpEntity; PascalExps : TList): Boolean;
begin
Result:=False;
end;
end.

217
components/chelper/extconvdialog.lfm Normal file
View File

@ -0,0 +1,217 @@
object CtoPasConfig: TCtoPasConfig
Left = 336
Height = 446
Top = 231
Width = 655
Caption = 'C to Pascal settings'
ClientHeight = 446
ClientWidth = 655
OnClose = FormClose
OnResize = FormResize
LCLVersion = '0.9.29'
object Notebook1: TNotebook
Left = 16
Height = 421
Top = 8
Width = 622
Anchors = [akTop, akLeft, akRight, akBottom]
PageIndex = 0
TabOrder = 0
object pageMain: TPage
Caption = 'Main'
ClientWidth = 616
ClientHeight = 382
object Panel1: TPanel
Left = 0
Height = 172
Top = 0
Width = 616
Align = alTop
BevelOuter = bvNone
ClientHeight = 172
ClientWidth = 616
TabOrder = 0
object Label1: TLabel
Left = 6
Height = 18
Top = 5
Width = 150
Caption = 'Pascal code generation:'
ParentColor = False
end
object chkRecordsPacked: TCheckBox
Left = 6
Height = 18
Top = 36
Width = 144
Caption = 'Records are packed'
TabOrder = 0
end
object chkFuncAreExt: TCheckBox
Left = 6
Height = 18
Top = 70
Width = 161
Caption = 'Functions are external'
TabOrder = 1
end
object chkEnums: TCheckBox
Left = 6
Height = 18
Top = 107
Width = 244
Caption = 'Enumerations are Integer constants'
TabOrder = 2
end
object Label3: TLabel
Left = 197
Height = 18
Top = 70
Width = 115
Caption = 'Calling convention'
ParentColor = False
end
object cmbCallConv: TComboBox
Left = 325
Height = 21
Top = 67
Width = 160
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'cdecl'
'stdcall'
'mwpascal'
'fastcall'
)
TabOrder = 3
Text = 'cdecl'
end
object lblDefines: TLabel
Left = 11
Height = 18
Top = 136
Width = 51
Caption = 'Defines:'
ParentColor = False
end
object edtDefines: TEdit
AnchorSideLeft.Control = lblDefines
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = btnSelect
Left = 68
Height = 22
Top = 136
Width = 376
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
TabOrder = 4
end
object btnSelect: TButton
AnchorSideRight.Control = btnEdit
Left = 450
Height = 20
Top = 136
Width = 70
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 20
Caption = 'Select'
OnClick = btnSelectClick
TabOrder = 5
end
object btnEdit: TButton
Left = 540
Height = 20
Top = 136
Width = 70
Anchors = [akTop, akRight]
Caption = 'Edit'
OnClick = btnEditClick
TabOrder = 6
end
end
object Panel2: TPanel
Left = 0
Height = 210
Top = 172
Width = 616
Align = alClient
Alignment = taLeftJustify
BevelOuter = bvNone
ClientHeight = 210
ClientWidth = 616
TabOrder = 1
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 0
Width = 616
Align = alTop
ResizeAnchor = akTop
end
object Label2: TLabel
Left = 6
Height = 18
Top = 14
Width = 181
Caption = 'C to Pascal types convertion'
ParentColor = False
end
object Memo1: TMemo
Left = 6
Height = 160
Top = 44
Width = 604
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
ScrollBars = ssVertical
TabOrder = 1
end
object Button2: TButton
Left = 476
Height = 20
Top = 14
Width = 134
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Reset to defaults'
OnClick = Button2Click
TabOrder = 2
end
end
end
object pageConverter: TPage
Caption = 'Converter'
ClientWidth = 616
ClientHeight = 382
object edtExtTool: TEdit
Left = 13
Height = 22
Top = 6
Width = 511
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object Button1: TButton
Left = 538
Height = 20
Top = 6
Width = 70
Anchors = [akTop, akRight]
Caption = 'Select'
OnClick = Button1Click
TabOrder = 1
end
end
end
object OpenDialog1: TOpenDialog
left = 304
top = 168
end
end

151
components/chelper/extconvdialog.pas Normal file
View File

@ -0,0 +1,151 @@
unit extconvdialog;
{$mode objfpc}{$H+}
interface
uses
Classes,SysUtils,FileUtil,Forms,Controls,Graphics,Dialogs,StdCtrls,ExtCtrls,
converteridesettings, ctopasconvert, LazIDEIntf;
type
{ TCtoPasConfig }
TCtoPasConfig = class(TForm)
Button1: TButton;
btnSelect:TButton;
btnEdit:TButton;
Button2:TButton;
chkRecordsPacked:TCheckBox;
chkFuncAreExt:TCheckBox;
chkEnums:TCheckBox;
cmbCallConv:TComboBox;
edtDefines:TEdit;
edtExtTool: TEdit;
Label1:TLabel;
Label2:TLabel;
Label3:TLabel;
lblDefines:TLabel;
Memo1:TMemo;
Notebook1:TNotebook;
OpenDialog1: TOpenDialog;
pageMain:TPage;
pageConverter:TPage;
Panel1:TPanel;
Panel2:TPanel;
Splitter1:TSplitter;
procedure btnEditClick(Sender:TObject);
procedure btnSelectClick(Sender:TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender:TObject);
procedure FormClose(Sender:TObject;var CloseAction:TCloseAction);
procedure FormResize(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure SettingsToUI;
procedure UIToSettings;
end;
var
CtoPasConfig: TCtoPasConfig;
function ShowConfigDialog: TCtoPasConfig;
implementation
{$R *.lfm}
function ShowConfigDialog: TCtoPasConfig;
begin
if not Assigned(CtoPasConfig) then begin
CtoPasConfig := TCtoPasConfig.Create(nil);
CtoPasConfig.SettingsToUI;
end;
CtoPasConfig.Show;
CtoPasConfig.BringToFront;
Result:=CtoPasConfig;
end;
{ TCtoPasConfig }
procedure TCtoPasConfig.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edtExtTool.Text := OpenDialog1.FileName;
end;
procedure TCtoPasConfig.Button2Click(Sender:TObject);
var
cfg : TConvertSettings;
begin
if MessageDlg('Reset types',
'Reset c-to-pascal types converting to defaults?',
mtConfirmation, mbYesNo, 0)<>mrYes then Exit;
cfg := TConvertSettings.Create;
try
Memo1.Lines.Assign(cfg.CtoPasTypes);
finally
cfg.Free;
end;
end;
procedure TCtoPasConfig.btnSelectClick(Sender:TObject);
begin
if OpenDialog1.Execute then
edtDefines.Text:=OpenDialog1.FileName;
end;
procedure TCtoPasConfig.btnEditClick(Sender:TObject);
var
fs : TFileStream;
begin
if edtDefines.Text='' then Exit;
if not FileExistsUTF8(edtDefines.Text) then begin
ForceDirectoriesUTF8( ExtractFileDir(edtDefines.Text));
try
fs:=TFileStream.Create(edtDefines.Text, fmCreate);
fs.Free;
except
end;
end;
LazarusIDE.DoOpenEditorFile(edtDefines.Text, 0, 0, [ofQuiet, ofRegularFile, ofDoNotLoadResource, ofDoLoadResource]);
end;
procedure TCtoPasConfig.FormClose(Sender:TObject;var CloseAction:TCloseAction);
begin
// don't free the form on close.
UIToSettings;
CloseAction:=caHide;
end;
procedure TCtoPasConfig.FormResize(Sender: TObject);
begin
end;
procedure TCtoPasConfig.SettingsToUI;
begin
chkRecordsPacked.Checked:=ConvSettings.RecordsArePacked;
chkFuncAreExt.Checked:=ConvSettings.FuncsAreExternal;
chkEnums.Checked:=ConvSettings.EnumsAsConst;
cmbCallConv.Text:=ConvSettings.FuncConv;
Memo1.Lines.Assign(ConvSettings.CtoPasTypes);
edtDefines.Text:=DefineFile;
edtExtTool.Text:=ExtTool;
end;
procedure TCtoPasConfig.UIToSettings;
begin
ConvSettings.RecordsArePacked:=chkRecordsPacked.Checked;
ConvSettings.FuncsAreExternal:=chkFuncAreExt.Checked;
ConvSettings.EnumsAsConst:=chkEnums.Checked;
ConvSettings.FuncConv:=cmbCallConv.Text;
ConvSettings.CtoPasTypes.Assign(Memo1.Lines);
DefineFile:=edtDefines.Text;
ExtTool:=edtExtTool.Text;
end;
end.

151
components/chelper/textparsingutils.pas Normal file
View File

@ -0,0 +1,151 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit TextParsingUtils;
{$ifdef fpc}{$mode delphi}{$h+}{$endif}
interface
type
TCharSet = set of Char;
const
EoLnChars = [#10,#13];
SpaceChars = [#32,#9];
InvsChars = SpaceChars;
WhiteSpaceChars = SpaceChars;
SpaceEolnChars = EoLnChars+SpaceChars;
NumericChars = ['0'..'9'];
AlphabetChars = ['a'..'z','A'..'Z'];
AlphaNumChars = AlphabetChars+NumericChars;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function SkipToEoln(const s: AnsiString; var index: Integer): AnsiString;
// returns #10, #13, #10#13 or #13#10, if s[index] is end-of-line sequence
// otherwise returns empty string
function EolnStr(const s: AnsiString; index: Integer): String;
function IsSubStr(const sbs, s: AnsiString; index: Integer): Boolean;
// todo: not used?
function SkipCommentBlock(const s: AnsiString; var index: Integer; const closecmt: AnsiString): AnsiString;
function SkipLine(const s: AnsiString; var index: Integer): AnsiString;
implementation
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
i : Integer;
begin
Result := '';
if (index <= 0) or (index > length(s)) then Exit;
for i := index to length(s) do
if not (s[i] in ch) then begin
if i = index then Result := ''
else Result := Copy(s, index, i - index);
index := i;
Exit;
end;
Result := Copy(s, index, length(s) - index + 1);
index := length(s) + 1;
end;
function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
i : Integer;
begin
Result := '';
if (index <= 0) or (index > length(s)) then Exit;
for i := index to length(s) do
if (s[i] in ch) then begin
if i = index then Result := ''
else Result := Copy(s, index, i - index);
index := i;
Exit;
end;
Result := Copy(s, index, length(s) - index + 1);
index := length(s) + 1;
end;
function EolnStr(const s: AnsiString; index: Integer): String;
begin
if (index<=0) or (index>length(s)) or (not (s[index] in EoLnChars)) then
Result:=''
else begin
if (index<length(s)) and (s[index+1] in EolnChars) and (s[index]<>s[index+1]) then
Result:=Copy(s, index, 2)
else
Result:=s[index];
end;
end;
function SkipToEoln(const s: AnsiString; var index: Integer): AnsiString;
begin
Result := ScanTo(s, index, EoLnChars);
end;
function IsSubStr(const sbs, s: AnsiString; index: Integer): Boolean;
var
i : Integer;
j : Integer;
begin
Result := false;
if (sbs = '') or (length(sbs) > length(s) - index) then Exit;
j := index;
for i := 1 to length(sbs) do begin
if sbs[i] <> s[j] then Exit;
inc(j);
end;
Result := true;
end;
function SkipCommentBlock(const s: AnsiString; var index: Integer; const closecmt: AnsiString): AnsiString;
begin
Result := '';
if closecmt = '' then begin
index := length(s) + 1;
Exit;
end;
while index <= length(s) do begin
Result := Result + ScanTo(s, index, [closecmt[1]]+EoLnChars);
//if (index<=length(s)) and (s in EoLnChars(
if IsSubStr(closecmt, s, index) then begin
inc(index, length(closecmt));
Exit;
end else begin
Result := Result + s[index];
inc(index);
end;
end;
end;
function SkipLine(const s: AnsiString; var index: Integer): AnsiString;
begin
Result:=ScanTo(s, index, EoLnChars);
if (index<length(s)) and (s[index+1] in EoLnChars) and (s[index]<>s[index+1]) then
inc(index);
inc(index);
end;
end.

217
components/chelper/tosourceeditor.pas Normal file
View File

@ -0,0 +1,217 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit toSourceEditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Dialogs, LCLType, LCLIntf, Forms,
Menus, MenuIntf, SrcEditorIntf, process, LazIDEIntf,
extconvdialog, converteridesettings, cconvconfig;
procedure Register;
implementation
function DoExtConvert(const t: AnsiString; var EndPos: TPoint): AnsiString;
var
p : TProcess;
d : AnsiString;
inp : AnsiString;
outp : AnsiString;
i, err : Integer;
fs : TFileStream;
st : TStringList;
cmd : AnsiString;
tm : LongWord;
begin
if t='' then begin
Result:='';
EndPos.X:=0;
EndPos.Y:=0;
Exit;
end;
EndPos.X:=-1;
EndPos.Y:=-1;
try
d:=GetTempDir;
ForceDirectories(d);
inp:=IncludeTrailingPathDelimiter(d)+'input.txt';
outp:=IncludeTrailingPathDelimiter(d)+'output.txt';
try
fs:=TFileStream.Create(inp, fmCreate or fmShareDenyNone);
try
fs.Write(t[1], length(t));
finally
fs.Free;
end;
except
Result:='can''t write input';
end;
p:=TProcess.Create(nil);
try
cmd:=ExtTool+' ';
cconvconfig.SaveToFile(ConvFile, converteridesettings.ConvSettings);
cmd:=cmd+' -cfg "'+ ConvFile +'"';
if (DefineFile<>'') and FileExists(DefineFile) then
cmd:=cmd+' -defines "'+DefineFile+'" ';
cmd:=cmd+' -o "'+outp+'" ';
cmd:=cmd+'"'+inp+'"';
p.CommandLine:=cmd;
d:=p.CommandLine;
p.Execute;
tm:=GetTickCount;
while p.Active and (GetTickCount-tm<ExtTimeOut) do begin
Application.ProcessMessages;
end;
if p.Active then begin
p.Terminate(1);
Result:='timeout';
Exit;
end;
finally
p.Free;
end;
try
st:=TStringList.Create;
try
st.LoadFromFile(outp);
if st.Count=0 then Exit;
d:=st[0];
if d='' then Exit;
i:=Pos(' ', d);
if i>=1 then begin
Val( copy(d, 1, i-1), EndPos.Y, err);
Val( copy(d, i+1, length(d)), EndPos.X, err);
end;
st.Delete(0);
Result:=st.Text;
finally
st.Free;
end;
except
Result:='can''t read output file';
end;
except
on E:Exception do
Result:=e.Message;
end;
end;
function DoConvertCode(const t: AnsiString; var EndPoint: TPoint; var txt: AnsiString): Boolean;
begin
Result:=False;
if UseExtTool then begin
if not FileExists(ExtTool) then begin
ShowMessage('No convertor binary specified');
Exit;
end;
cconvconfig.SaveToFile(ConvFile, ConvSettings);
txt:=DoExtConvert(t, EndPoint);
Result:=(EndPoint.X>=0) and (EndPoint.Y>=0);
if Result then cconvconfig.LoadFromFile(ConvFile, ConvSettings)
else ShowMessage('Error: '+ txt);
end else
txt:='';
end;
procedure TryParse;
var
editor : TSourceEditorInterface;
i : Integer;
txt : AnsiString;
s : AnsiString;
p : TPoint;
st : TPoint;
begin
if not Assigned(SourceEditorManagerIntf) or not Assigned(SourceEditorManagerIntf.ActiveEditor) then Exit;
editor:=SourceEditorManagerIntf.ActiveEditor;
if Assigned(CtoPasConfig) then CtoPasConfig.UIToSettings;
i:=editor.CursorTextXY.Y;
dec(i);
if i<0 then i:=0;
txt:='';
for i:=i to editor.Lines.Count-1 do
txt:=txt+editor.Lines[i]+#10;
if DoConvertCode(txt, p, s) then
begin
inc(p.Y, editor.CursorTextXY.Y-1);
st:=editor.CursorTextXY;
st.X:=1;
editor.ReplaceText(st, p, s);
if Assigned(CtoPasConfig) then
CtoPasConfig.SettingsToUI;
end;
end;
procedure OnCtoPasClick(Sender: TObject);
begin
TryParse;
end;
procedure OnCtoPasOptionsClick(Sender: TObject);
begin
ShowConfigDialog;
end;
procedure InitPackage;
var
cmd : TIDEMenuCommand;
begin
cmd:=RegisterIDEMenuCommand(itmSecondaryTools, 'CtoPas', 'C to Pascal', nil, @OnCtoPasClick);
RegisterIDEMenuCommand(itmSecondaryTools, 'CtoPas', 'C to Pascal Options', nil, @OnCtoPasOptionsClick);
if Assigned(cmd) and Assigned(cmd.MenuItem) then cmd.MenuItem.ShortCut:=ShortCut(VK_B, [ssCtrl]);
end;
procedure Register;
var
pth : AnsiString;
begin
InitPackage;
pth:=IncludeTrailingPathDelimiter(LazIDEIntf.LazarusIDE.GetPrimaryConfigPath);
ConvFile := pth+'cconv.ini';
LoadFromFile(ConvFile, ConvSettings);
ReadIDESettings(ConvFile);
if DefineFile='' then DefineFile:=pth+'cconvdefines.h';
end;
initialization
finalization
SaveToFile(ConvFile, ConvSettings);
WriteIDESettings(ConvFile);
end.