paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

Converter: added replacement function categories to configuration.

Browse Source 
git-svn-id: trunk@26666 -
This commit is contained in:
juha 2010-07-15 19:34:14 +00:00
parent 3dc1fa1a34
commit 7e2a349cb2
4 changed files with 212 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
converter/convcodetool.pas
View File

@ -44,7 +44,7 @@ type
fUnitsToComment: TStringList;
// Delphi Function names to replace with FCL/LCL functions.
fDefinedProcNames: TStringList;
fReplaceFuncs: TStringList;
fReplaceFuncs: TFuncsAndCategories;
fFuncsToReplace: TObjectList; // List of TFuncReplacement.
function AddDelphiAndLCLSections: boolean;
function AddModeDelphiDirective: boolean;
@ -72,7 +72,7 @@ type
property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove;
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
property ReplaceFuncs: TStringList read fReplaceFuncs write fReplaceFuncs;
property ReplaceFuncs: TFuncsAndCategories read fReplaceFuncs write fReplaceFuncs;
end;
@ -703,14 +703,14 @@ var
with fCodeTool do begin
while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
inc(IdentEndPos);
for i:=0 to fReplaceFuncs.Count-1 do begin
FuncName:=fReplaceFuncs[i];
for i:=0 to fReplaceFuncs.Funcs.Count-1 do begin
FuncName:=fReplaceFuncs.Funcs[i];
if (IdentEndPos-xStart=length(FuncName))
and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[xStart])=0)
and not fDefinedProcNames.Find(FuncName, x)
then begin
// Create a new replacement object for params, position and other info.
FuncInfo:=TFuncReplacement.Create(TFuncReplacement(fReplaceFuncs.Objects[i]));
FuncInfo:=TFuncReplacement.Create(fReplaceFuncs.FuncAtInd(i));
ReadParams(FuncInfo);
IdentEndPos:=FuncInfo.EndPos; // Skip the params, too, for next search.
fFuncsToReplace.Add(FuncInfo);

115
converter/convertsettings.pas
View File

@ -60,7 +60,7 @@ type
// Delphi types mapped to Lazarus types, will be replaced.
fReplaceTypes: TStringToStringTree;
// Delphi global function names mapped to FCL/LCL functions.
fReplaceFuncs: TStringList; // Objects property is used for data items.
fReplaceFuncs: TFuncsAndCategories;
// Getter / setter:
function GetBackupPath: String;
procedure SetMainFilename(const AValue: String);
@ -96,7 +96,7 @@ type
property AutoRemoveProperties: boolean read fAutoRemoveProperties;
property ReplaceUnits: TStringToStringTree read fReplaceUnits;
property ReplaceTypes: TStringToStringTree read fReplaceTypes;
property ReplaceFuncs: TStringList read fReplaceFuncs;
property ReplaceFuncs: TFuncsAndCategories read fReplaceFuncs;
end;
@ -141,11 +141,9 @@ implementation
procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string;
Tree: TStringToStringTree);
var
Cnt: LongInt;
SubPath: String;
CurName: String;
CurValue: String;
i: Integer;
CurName, CurValue: String;
Cnt, i: Integer;
begin
Tree.Clear;
Cnt:=Config.GetValue(Path+'Count', 0);
@ -162,8 +160,8 @@ procedure SaveStringToStringTree(Config: TConfigStorage; const Path: string;
var
Node: TAVLTreeNode;
Item: PStringToStringTreeItem;
i, j: Integer;
SubPath: String;
i, j: Integer;
begin
Config.SetDeleteValue(Path+'Count', Tree.Tree.Count, 0);
Node:=Tree.Tree.FindLowest;
@ -183,55 +181,73 @@ begin
end;
end;
// Load and store configuration in TStringList + TFuncReplacement :
// Load and store configuration in TFuncsAndCategories :
procedure LoadFuncReplacements(Config: TConfigStorage; const Path: string;
aFuncs: TStringList);
procedure LoadFuncReplacements(Config: TConfigStorage;
const FuncPath, CategPath: string; aFuncsAndCateg: TFuncsAndCategories);
var
Cnt: LongInt;
SubPath: String;
FuncRepl: TFuncReplacement;
SubPath: String;
xCategory, xDelphiFunc, xReplacement, xPackage, xUnitName: String;
i: Integer;
Cnt, i: Integer;
begin
aFuncs.Clear;
Cnt:=Config.GetValue(Path+'Count', 0);
aFuncsAndCateg.Clear;
// Replacement functions
Cnt:=Config.GetValue(FuncPath+'Count', 0);
for i:=0 to Cnt-1 do begin
SubPath:=Path+'Item'+IntToStr(i)+'/';
SubPath:=FuncPath+'Item'+IntToStr(i)+'/';
xCategory :=Config.GetValue(SubPath+'Category','');
xDelphiFunc :=Config.GetValue(SubPath+'DelphiFunction','');
xReplacement:=Config.GetValue(SubPath+'Replacement','');
xPackage :=Config.GetValue(SubPath+'Package','');
xUnitName :=Config.GetValue(SubPath+'UnitName','');
if xDelphiFunc<>'' then begin
FuncRepl:=TFuncReplacement.Create(xCategory,
xDelphiFunc, xReplacement, xPackage, xUnitName);
aFuncs.AddObject(xDelphiFunc, FuncRepl);
end;
aFuncsAndCateg.AddFunc(xCategory, xDelphiFunc, xReplacement, xPackage, xUnitName);
end;
// Categories
Cnt:=Config.GetValue(CategPath+'Count', 0);
for i:=0 to Cnt-1 do begin
SubPath:=CategPath+'Item'+IntToStr(i)+'/';
xCategory:=Config.GetValue(SubPath+'Name','');
aFuncsAndCateg.AddCategory(xCategory);
end;
end;
procedure SaveFuncReplacements(Config: TConfigStorage; const Path: string;
aFuncs: TStringList);
procedure SaveFuncReplacements(Config: TConfigStorage;
const FuncPath, CategPath: string; aFuncsAndCateg: TFuncsAndCategories);
var
SubPath: String;
FuncRepl: TFuncReplacement;
i, j: Integer;
SubPath, s: String;
i: Integer;
begin
Config.SetDeleteValue(Path+'Count', aFuncs.Count, 0);
for i:=0 to aFuncs.Count-1 do
if (aFuncs[i]<>'') and (aFuncs.Objects[i]<>nil) then begin
FuncRepl:=TFuncReplacement(aFuncs.Objects[i]);
SubPath:=Path+'Item'+IntToStr(i)+'/';
// Replacement functions
Config.SetDeleteValue(FuncPath+'Count', aFuncsAndCateg.Funcs.Count, 0);
for i:=0 to aFuncsAndCateg.Funcs.Count-1 do begin
FuncRepl:=aFuncsAndCateg.FuncAtInd(i);
if FuncRepl<>nil then begin
SubPath:=FuncPath+'Item'+IntToStr(i)+'/';
Config.SetDeleteValue(SubPath+'Category' ,FuncRepl.Category,'');
Config.SetDeleteValue(SubPath+'DelphiFunction',aFuncs[i],'');
Config.SetDeleteValue(SubPath+'DelphiFunction',aFuncsAndCateg.Funcs[i],'');
Config.SetDeleteValue(SubPath+'Replacement' ,FuncRepl.ReplClause,'');
Config.SetDeleteValue(SubPath+'Package' ,FuncRepl.PackageName,'');
Config.SetDeleteValue(SubPath+'UnitName' ,FuncRepl.UnitName,'');
end;
end;
// Remove leftover items in case the list has become shorter.
for j:=i to i+10 do begin
SubPath:=Path+'Item'+IntToStr(j)+'/';
for i:=aFuncsAndCateg.Funcs.Count to aFuncsAndCateg.Funcs.Count+10 do begin
SubPath:=FuncPath+'Item'+IntToStr(i)+'/';
Config.DeletePath(SubPath);
end;
// Categories
Config.SetDeleteValue(CategPath+'Count', aFuncsAndCateg.CategInUse.Count, 0);
for i:=0 to aFuncsAndCateg.CategInUse.Count-1 do begin
s:=aFuncsAndCateg.CategInUse[i];
if s<>'' then begin
SubPath:=CategPath+'Item'+IntToStr(i)+'/';
Config.SetDeleteValue(SubPath+'Name',s,'');
end;
end;
for i:=aFuncsAndCateg.CategInUse.Count to aFuncsAndCateg.CategInUse.Count+10 do begin
SubPath:=CategPath+'Item'+IntToStr(i)+'/';
Config.DeletePath(SubPath);
end;
end;
@ -255,9 +271,7 @@ begin
fMainPath:='';
fReplaceUnits:=TStringToStringTree.Create(false);
fReplaceTypes:=TStringToStringTree.Create(false);
fReplaceFuncs:=TStringList.Create;
fReplaceFuncs.Sorted:=True;
fReplaceFuncs.CaseSensitive:=False;
fReplaceFuncs:=TFuncsAndCategories.Create;
// Load settings from ConfigStorage.
fConfigStorage:=GetIDEConfigStorage('delphiconverter.xml', true);
fBackupFiles :=fConfigStorage.GetValue('BackupFiles', true);
@ -267,9 +281,10 @@ begin
fAutoRemoveProperties :=fConfigStorage.GetValue('AutoRemoveProperties', true);
LoadStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
LoadStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
LoadFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
LoadFuncReplacements (fConfigStorage, 'FuncReplacements/', 'Categories/', fReplaceFuncs);
// Add default values for configuration if ConfigStorage doesn't have them.
// Add default values for string maps if ConfigStorage doesn't have them.
// Map Delphi units to Lazarus units.
TheMap:=fReplaceUnits;
MapReplacement('Windows', 'LCLIntf, LCLType, LMessages');
@ -310,15 +325,18 @@ begin
MapReplacement('^TTnt(.+[^L][^X])$','T$1');
// Map Delphi function names to FCL/LCL functions.
AddReplaceFunc(fReplaceFuncs, 'Other', 'ShellExecute',
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '');
fReplaceFuncs.AddFunc('Other', 'ShellExecute',
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '');
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts.
AddReplaceFunc(fReplaceFuncs, 'UTF8Names', 'FileExists', 'FileExistsUTF8($1)', '', '');
fReplaceFuncs.AddFunc('UTF8Names', 'FileExists', 'FileExistsUTF8($1)', '', '');
// File functions using a handle.
AddReplaceFunc(fReplaceFuncs, 'Other', 'CreateFile', 'FileCreate($1)', '', 'SysUtils');
AddReplaceFunc(fReplaceFuncs, 'Other', 'GetFileSize', 'FileSize($1)' , '', 'SysUtils');
AddReplaceFunc(fReplaceFuncs, 'Other', 'ReadFile', 'FileRead($1)' , '', 'SysUtils');
AddReplaceFunc(fReplaceFuncs, 'Other', 'CloseHandle', 'FileClose($1)' , '', 'SysUtils');
fReplaceFuncs.AddFunc('Other', 'CreateFile', 'FileCreate($1)', '', 'SysUtils');
fReplaceFuncs.AddFunc('Other', 'GetFileSize', 'FileSize($1)' , '', 'SysUtils');
fReplaceFuncs.AddFunc('Other', 'ReadFile', 'FileRead($1)' , '', 'SysUtils');
fReplaceFuncs.AddFunc('Other', 'CloseHandle', 'FileClose($1)' , '', 'SysUtils');
// Categories.
fReplaceFuncs.AddCategory('UTF8Names');
fReplaceFuncs.AddCategory('Other');
end;
destructor TConvertSettings.Destroy;
@ -333,13 +351,10 @@ begin
fConfigStorage.SetDeleteValue('AutoRemoveProperties', fAutoRemoveProperties, false);
SaveStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
SaveStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
SaveFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
SaveFuncReplacements (fConfigStorage, 'FuncReplacements/', 'Categories/', fReplaceFuncs);
// Free stuff
fConfigStorage.Free;
for i:=0 to fReplaceFuncs.Count-1 do begin
fReplaceFuncs.Objects[i].Free;
fReplaceFuncs.Objects[i]:=nil;
end;
fReplaceFuncs.Clear;
fReplaceFuncs.Free;
fReplaceTypes.Free;
fReplaceUnits.Free;

2
converter/replacefuncsunit.lfm
View File

@ -66,7 +66,7 @@ object ReplaceFuncsForm: TReplaceFuncsForm
100
)
end
object CheckListBox1: TCheckListBox
object CategoryListBox: TCheckListBox
Left = 0
Height = 270
Top = 0

215
converter/replacefuncsunit.pas
View File

@ -46,12 +46,29 @@ type
property Params: TStringList read fParams;
end;
{ TFuncsAndCategories }
TFuncsAndCategories = class
private
fFuncs: TStringList; // Objects property has TFuncReplacement items.
fCategInUse: TStringList; // Categories to be replaced.
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function AddFunc(aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string): integer;
function AddCategory(aCategory: string): integer;
function FuncAtInd(Ind: integer): TFuncReplacement;
public
property Funcs: TStringList read fFuncs;
property CategInUse: TStringList read fCategInUse;
end;
{ TReplaceFuncsForm }
TReplaceFuncsForm = class(TForm)
ButtonPanel: TButtonPanel;
CheckListBox1: TCheckListBox;
CategoryListBox: TCheckListBox;
DeleteRow1: TMenuItem;
Grid: TStringGrid;
InsertRow1: TMenuItem;
@ -62,100 +79,39 @@ type
procedure InsertRow1Click(Sender: TObject);
procedure DeleteRow1Click(Sender: TObject);
procedure GridEditingDone(Sender: TObject);
procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string);
procedure OKButtonClick(Sender: TObject);
private
IsLasRow: Boolean;
public
end;
function FromFuncListToUI(aFuncsAndCateg: TFuncsAndCategories): boolean;
function FromUIToFuncList(aFuncsAndCateg: TFuncsAndCategories): boolean;
end;
var
ReplaceFuncsForm: TReplaceFuncsForm;
procedure ClearFuncList(aFuncs: TStringList);
procedure AddReplaceFunc(aFuncs: TStringList;
aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string);
function FromFuncListToUI(aFuncs: TStringList; aGrid: TStringGrid): boolean;
function FromUIToFuncList(aFuncs: TStringList; aGrid: TStringGrid): boolean;
function EditFuncReplacements(aFuncs: TStringList; aTitle: string): TModalResult;
function EditFuncReplacements(aFuncsAndCateg: TFuncsAndCategories;
aTitle: string): TModalResult;
implementation
{$R *.lfm}
procedure ClearFuncList(aFuncs: TStringList);
var
i: Integer;
begin
for i := 0 to aFuncs.Count-1 do
aFuncs.Objects[i].Free;
aFuncs.Clear;
end;
procedure AddReplaceFunc(aFuncs: TStringList;
aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string);
var
FuncRepl: TFuncReplacement;
x: integer;
begin
if not aFuncs.Find(aDelphiFunc, x) then begin
FuncRepl:=TFuncReplacement.Create(aCategory,
aDelphiFunc, aReplaceFunc, aPackage, aUnitName);
aFuncs.AddObject(aDelphiFunc, FuncRepl);
end;
end;
function FromFuncListToUI(aFuncs: TStringList; aGrid: TStringGrid): boolean;
// Copy strings from Map to Grid.
var
i: Integer;
FuncRepl: TFuncReplacement;
begin
Result:=true;
aGrid.BeginUpdate;
for i:=1 to aFuncs.Count do begin // Skip the fixed row in grid.
if aGrid.RowCount<i+2 then
aGrid.RowCount:=i+2; // Leave one empty row to the end.
FuncRepl:=TFuncReplacement(aFuncs.Objects[i-1]);
aGrid.Cells[0,i]:=FuncRepl.fCategory;
aGrid.Cells[1,i]:=aFuncs[i-1]; // Delphi function name
aGrid.Cells[2,i]:=FuncRepl.fReplClause;
aGrid.Cells[3,i]:=FuncRepl.PackageName;
aGrid.Cells[4,i]:=FuncRepl.fUnitName;
end;
aGrid.EndUpdate;
end;
function FromUIToFuncList(aFuncs: TStringList; aGrid: TStringGrid): boolean;
var
i: Integer;
begin
Result:=true;
ClearFuncList(aFuncs);
// Collect (maybe edited) properties from StringGrid to fStringMap.
for i:=1 to aGrid.RowCount-1 do // Skip the fixed row.
if aGrid.Cells[1,i]<>'' then // Delphi function name must have something.
AddReplaceFunc(aFuncs, aGrid.Cells[0,i],
aGrid.Cells[1,i],
aGrid.Cells[2,i],
aGrid.Cells[3,i],
aGrid.Cells[4,i]);
end;
function EditFuncReplacements(aFuncs: TStringList; aTitle: string): TModalResult;
function EditFuncReplacements(aFuncsAndCateg: TFuncsAndCategories;
aTitle: string): TModalResult;
var
RFForm: TReplaceFuncsForm;
begin
RFForm:=TReplaceFuncsForm.Create(nil);
try
RFForm.Caption:=aTitle;
FromFuncListToUI(aFuncs, RFForm.Grid);
RFForm.FromFuncListToUI(aFuncsAndCateg);
Result:=RFForm.ShowModal;
if Result=mrOK then
FromUIToFuncList(aFuncs, RFForm.Grid);
RFForm.FromUIToFuncList(aFuncsAndCateg);
finally
RFForm.Free;
end;
@ -315,6 +271,62 @@ begin
end;
{ TFuncsAndCategories }
constructor TFuncsAndCategories.Create;
begin
inherited Create;
fFuncs:=TStringList.Create;
fFuncs.Sorted:=True;
fFuncs.CaseSensitive:=False;
fCategInUse:=TStringList.Create;
end;
destructor TFuncsAndCategories.Destroy;
begin
fCategInUse.Free;
fFuncs.Free;
inherited Destroy;
end;
procedure TFuncsAndCategories.Clear;
var
i: Integer;
begin
for i := 0 to fFuncs.Count-1 do
fFuncs.Objects[i].Free;
fFuncs.Clear;
fCategInUse.Clear;
end;
function TFuncsAndCategories.AddFunc(
aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string): integer;
// This is called when settings are read or when user made changes in GUI.
var
FuncRepl: TFuncReplacement;
x: integer;
begin
Result:=-1;
if (aDelphiFunc<>'') and not fFuncs.Find(aDelphiFunc, x) then begin
FuncRepl:=TFuncReplacement.Create(aCategory,
aDelphiFunc, aReplaceFunc, aPackage, aUnitName);
Result:=fFuncs.AddObject(aDelphiFunc, FuncRepl);
end;
end;
function TFuncsAndCategories.AddCategory(aCategory: string): integer;
begin
Result:=fCategInUse.Add(aCategory);
end;
function TFuncsAndCategories.FuncAtInd(Ind: integer): TFuncReplacement;
begin
Result:=nil;
if fFuncs[Ind]<>'' then
Result:=TFuncReplacement(fFuncs.Objects[Ind]);
end;
{ TReplaceFuncsForm }
procedure TReplaceFuncsForm.FormCreate(Sender: TObject);
@ -327,7 +339,7 @@ procedure TReplaceFuncsForm.PopupMenu1Popup(Sender: TObject);
var
ControlCoord, NewCell: TPoint;
begin
ControlCoord := Grid.ScreenToControl(PopupMenu1.PopupPoint);
ControlCoord:=Grid.ScreenToControl(PopupMenu1.PopupPoint);
NewCell:=Grid.MouseToCell(ControlCoord);
Grid.Col:=NewCell.X;
Grid.Row:=NewCell.Y;
@ -368,6 +380,61 @@ begin
ModalResult:=mrOK;
end;
function TReplaceFuncsForm.FromFuncListToUI(aFuncsAndCateg: TFuncsAndCategories): boolean;
// Copy strings from Map to Grid.
var
FuncRepl: TFuncReplacement;
NewCategories: TStringList;
i, x: Integer;
NewCatInd: longint;
begin
Result:=true;
NewCategories:=TStringList.Create;
NewCategories.Sorted:=True;
try
Grid.BeginUpdate;
for i:=1 to aFuncsAndCateg.fFuncs.Count do begin // Skip the fixed row in grid.
if Grid.RowCount<i+2 then
Grid.RowCount:=i+2; // Leave one empty row to the end.
FuncRepl:=TFuncReplacement(aFuncsAndCateg.fFuncs.Objects[i-1]);
Grid.Cells[0,i]:=FuncRepl.fCategory;
Grid.Cells[1,i]:=aFuncsAndCateg.fFuncs[i-1]; // Delphi function name
Grid.Cells[2,i]:=FuncRepl.fReplClause;
Grid.Cells[3,i]:=FuncRepl.PackageName;
Grid.Cells[4,i]:=FuncRepl.fUnitName;
if not NewCategories.Find(FuncRepl.fCategory, x) then begin
CategoryListBox.Items.Add(FuncRepl.fCategory);
NewCatInd:=NewCategories.Add(FuncRepl.fCategory);
CategoryListBox.Checked[NewCatInd]:=
aFuncsAndCateg.fCategInUse.Find(FuncRepl.fCategory, x);
end;
end;
Grid.EndUpdate;
finally
NewCategories.Free;
end;
end;
function TReplaceFuncsForm.FromUIToFuncList(aFuncsAndCateg: TFuncsAndCategories): boolean;
var
i: Integer;
begin
Result:=true;
aFuncsAndCateg.Clear;
// Collect (maybe edited) properties from StringGrid to fStringMap.
for i:=1 to Grid.RowCount-1 do // Skip the fixed row.
if Grid.Cells[1,i]<>'' then // Delphi function name must have something.
aFuncsAndCateg.AddFunc(Grid.Cells[0,i],
Grid.Cells[1,i],
Grid.Cells[2,i],
Grid.Cells[3,i],
Grid.Cells[4,i]);
// Copy checked (used) categories.
for i:=0 to CategoryListBox.Count-1 do
if CategoryListBox.Checked[i] then
aFuncsAndCateg.AddCategory(CategoryListBox.Items[i]);
end;
end.