paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 12:59:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Converter: improved function replacement with categories. Added more UTF8 functions.

Browse Source 
git-svn-id: trunk@26720 -
This commit is contained in:
juha 2010-07-17 20:58:58 +00:00
parent 62d890f71d
commit 60d84c8bf0
5 changed files with 123 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
converter/convcodetool.pas
View File

@ -52,12 +52,12 @@ type
function CommentOutUnits: boolean; function CommentOutUnits: boolean;
function ReplaceFuncsInSource: boolean; function ReplaceFuncsInSource: boolean;
function RememberProcDefinition(aNode: TCodeTreeNode): TCodeTreeNode; function RememberProcDefinition(aNode: TCodeTreeNode): TCodeTreeNode;
function ReplaceFuncCalls: boolean; function ReplaceFuncCalls(aIsConsoleApp: boolean): boolean;
function HandleCodetoolError: TModalResult; function HandleCodetoolError: TModalResult;
public public
constructor Create(Code: TCodeBuffer); constructor Create(Code: TCodeBuffer);
destructor Destroy; override; destructor Destroy; override;
function Convert: TModalResult; function Convert(aIsConsoleApp: boolean): TModalResult;
function FindApptypeConsole: boolean; function FindApptypeConsole: boolean;
function RemoveUnits: boolean; function RemoveUnits: boolean;
function RenameUnits: boolean; function RenameUnits: boolean;
@ -126,7 +126,7 @@ begin
end; end;
end; end;
function TConvDelphiCodeTool.Convert: TModalResult; function TConvDelphiCodeTool.Convert(aIsConsoleApp: boolean): TModalResult;
// add {$mode delphi} directive // add {$mode delphi} directive
// remove {$R *.dfm} or {$R *.xfm} directive // remove {$R *.dfm} or {$R *.xfm} directive
// Change {$R *.RES} to {$R *.res} if needed // Change {$R *.RES} to {$R *.res} if needed
@ -139,7 +139,7 @@ begin
// these changes can be applied together without rescan // these changes can be applied together without rescan
if not AddModeDelphiDirective then exit; if not AddModeDelphiDirective then exit;
if not RenameResourceDirectives then exit; if not RenameResourceDirectives then exit;
if not ReplaceFuncCalls then exit; if not ReplaceFuncCalls(aIsConsoleApp) then exit;
if not fSrcCache.Apply then exit; if not fSrcCache.Apply then exit;
finally finally
fSrcCache.EndUpdate; fSrcCache.EndUpdate;
@ -508,7 +508,7 @@ var
ParamList: TStringList; ParamList: TStringList;
BodyEnd: Integer; // End of function body. BodyEnd: Integer; // End of function body.
function ParseReplacementParams(aStr: string): integer; function ParseReplacementParams(const aStr: string): integer;
// Parse replacement params. They show which original params are copied where. // Parse replacement params. They show which original params are copied where.
// Returns the first position where comments can be searched from. // Returns the first position where comments can be searched from.
var var
@ -549,7 +549,7 @@ var
end; end;
end; end;
function GetComment(aStr: string; aPossibleStartPos: integer): string; function GetComment(const aStr: string; aPossibleStartPos: integer): string;
// Extract and return a possible comment. // Extract and return a possible comment.
var var
CommChBeg, CommBeg, CommEnd, i: Integer; // Start and end of comment. CommChBeg, CommBeg, CommEnd, i: Integer; // Start and end of comment.
@ -630,10 +630,10 @@ begin
Result:=aNode.Next; Result:=aNode.Next;
end; end;
function TConvDelphiCodeTool.ReplaceFuncCalls: boolean; function TConvDelphiCodeTool.ReplaceFuncCalls(aIsConsoleApp: boolean): boolean;
// Copied and modified from TFindDeclarationTool.FindReferences. // Copied and modified from TFindDeclarationTool.FindReferences.
// Search for calls to functions / procedures given in a list in current unit's // Search for calls to functions / procedures in a list from current unit's
// implementation section. Add their positions to another list for replacement. // implementation section. Replace found calls with a given replacement.
var var
xStart: Integer; xStart: Integer;
@ -695,7 +695,7 @@ var
procedure ReadFuncCall(MaxPos: Integer); procedure ReadFuncCall(MaxPos: Integer);
var var
FuncInfo: TFuncReplacement; FuncDefInfo, FuncCallInfo: TFuncReplacement;
FuncName: string; FuncName: string;
i, x, IdentEndPos: Integer; i, x, IdentEndPos: Integer;
begin begin
@ -709,12 +709,17 @@ var
and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[xStart])=0) and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[xStart])=0)
and not fDefinedProcNames.Find(FuncName, x) and not fDefinedProcNames.Find(FuncName, x)
then begin then begin
// Create a new replacement object for params, position and other info. FuncDefInfo:=fReplaceFuncs.FuncAtInd(i);
FuncInfo:=TFuncReplacement.Create(fReplaceFuncs.FuncAtInd(i)); if fReplaceFuncs.CategoryInUse.Find(FuncDefInfo.Category, x)
ReadParams(FuncInfo); and not (aIsConsoleApp and (FuncDefInfo.Category='UTF8Names'))
IdentEndPos:=FuncInfo.EndPos; // Skip the params, too, for next search. then begin
fFuncsToReplace.Add(FuncInfo); // Create a new replacement object for params, position and other info.
Break; FuncCallInfo:=TFuncReplacement.Create(FuncDefInfo);
ReadParams(FuncCallInfo);
IdentEndPos:=FuncCallInfo.EndPos; // Skip the params, too, for next search.
fFuncsToReplace.Add(FuncCallInfo);
Break;
end;
end; end;
end; end;
end; end;

9
converter/convertdelphi.pas
View File

@ -492,6 +492,7 @@ function TConvertDelphiUnit.ConvertUnitFile: TModalResult;
var var
DfmFilename: string; // Delphi .DFM file name. DfmFilename: string; // Delphi .DFM file name.
LfmFilename: string; // Lazarus .LFM file name. LfmFilename: string; // Lazarus .LFM file name.
ConsApp: Boolean;
ConvTool: TConvDelphiCodeTool; ConvTool: TConvDelphiCodeTool;
begin begin
fUnitsToRemove:=TStringList.Create; fUnitsToRemove:=TStringList.Create;
@ -546,7 +547,11 @@ begin
// Fix or comment missing units, show error messages. // Fix or comment missing units, show error messages.
Result:=FixMissingUnits; Result:=FixMissingUnits;
if Result<>mrOk then exit; if Result<>mrOk then exit;
// Check from the project if this is a console application.
if Assigned(fOwnerConverter) then
ConsApp:=fOwnerConverter.fIsConsoleApp
else
ConsApp:=False;
// Do the actual code conversion. // Do the actual code conversion.
ConvTool.Ask:=Assigned(fOwnerConverter); ConvTool.Ask:=Assigned(fOwnerConverter);
ConvTool.LowerCaseRes:=FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res')); ConvTool.LowerCaseRes:=FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res'));
@ -556,7 +561,7 @@ begin
ConvTool.UnitsToRemove:=fUnitsToRemove; ConvTool.UnitsToRemove:=fUnitsToRemove;
ConvTool.UnitsToRename:=fUnitsToRename; ConvTool.UnitsToRename:=fUnitsToRename;
ConvTool.UnitsToComment:=fUnitsToComment; ConvTool.UnitsToComment:=fUnitsToComment;
Result:=ConvTool.Convert; Result:=ConvTool.Convert(ConsApp);
finally finally
ConvTool.Free; ConvTool.Free;
fUnitsToComment.Free; fUnitsToComment.Free;

59
converter/convertsettings.pas
View File

@ -237,15 +237,15 @@ begin
Config.DeletePath(SubPath); Config.DeletePath(SubPath);
end; end;
// Categories // Categories
Config.SetDeleteValue(CategPath+'Count', aFuncsAndCateg.CategInUse.Count, 0); Config.SetDeleteValue(CategPath+'Count', aFuncsAndCateg.CategoryInUse.Count, 0);
for i:=0 to aFuncsAndCateg.CategInUse.Count-1 do begin for i:=0 to aFuncsAndCateg.CategoryInUse.Count-1 do begin
s:=aFuncsAndCateg.CategInUse[i]; s:=aFuncsAndCateg.CategoryInUse[i];
if s<>'' then begin if s<>'' then begin
SubPath:=CategPath+'Item'+IntToStr(i)+'/'; SubPath:=CategPath+'Item'+IntToStr(i)+'/';
Config.SetDeleteValue(SubPath+'Name',s,''); Config.SetDeleteValue(SubPath+'Name',s,'');
end; end;
end; end;
for i:=aFuncsAndCateg.CategInUse.Count to aFuncsAndCateg.CategInUse.Count+10 do begin for i:=aFuncsAndCateg.CategoryInUse.Count to aFuncsAndCateg.CategoryInUse.Count+10 do begin
SubPath:=CategPath+'Item'+IntToStr(i)+'/'; SubPath:=CategPath+'Item'+IntToStr(i)+'/';
Config.DeletePath(SubPath); Config.DeletePath(SubPath);
end; end;
@ -257,6 +257,7 @@ end;
constructor TConvertSettings.Create(const ATitle: string); constructor TConvertSettings.Create(const ATitle: string);
var var
TheMap: TStringToStringTree; TheMap: TStringToStringTree;
Categ: string;
procedure MapReplacement(ADelphi, ALCL: string); procedure MapReplacement(ADelphi, ALCL: string);
begin begin
@ -324,18 +325,44 @@ begin
MapReplacement('^TTnt(.+[^L][^X])$','T$1'); MapReplacement('^TTnt(.+[^L][^X])$','T$1');
// Map Delphi function names to FCL/LCL functions. // Map Delphi function names to FCL/LCL functions.
fReplaceFuncs.AddFunc('Other', 'ShellExecute', with fReplaceFuncs do begin
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', ''); // File name encoding.
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts. Categ:='UTF8Names';
fReplaceFuncs.AddFunc('UTF8Names', 'FileExists', 'FileExistsUTF8($1)', '', ''); if AddFunc(Categ,'FileExists', 'FileExistsUTF8($1)','LCL','FileUtil')<>-1 then
// File functions using a handle. AddCategory(Categ); // Use the category by default if the func was added.
fReplaceFuncs.AddFunc('Other', 'CreateFile', 'FileCreate($1)', '', 'SysUtils'); AddFunc(Categ,'FileAge', 'FileAgeUTF8($1)', 'LCL','FileUtil');
fReplaceFuncs.AddFunc('Other', 'GetFileSize', 'FileSize($1)' , '', 'SysUtils'); AddFunc(Categ,'DirectoryExists', 'DirectoryExistsUTF8($1)', 'LCL','FileUtil');
fReplaceFuncs.AddFunc('Other', 'ReadFile', 'FileRead($1)' , '', 'SysUtils'); AddFunc(Categ,'ExpandFileName', 'ExpandFileNameUTF8($1)', 'LCL','FileUtil');
fReplaceFuncs.AddFunc('Other', 'CloseHandle', 'FileClose($1)' , '', 'SysUtils'); AddFunc(Categ,'ExpandUNCFileName', 'ExpandUNCFileNameUTF8($1)', 'LCL','FileUtil');
// Categories. AddFunc(Categ,'ExtractShortPathName','ExtractShortPathNameUTF8($1)','LCL','FileUtil');
fReplaceFuncs.AddCategory('UTF8Names'); AddFunc(Categ,'FindFirst', 'FindFirstUTF8($1,$2,$3)', 'LCL','FileUtil');
fReplaceFuncs.AddCategory('Other'); AddFunc(Categ,'FindNext', 'FindNextUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'FindClose', 'FindCloseUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'FileSetDate', 'FileSetDateUTF8($1,$2)', 'LCL','FileUtil');
AddFunc(Categ,'FileGetAttr', 'FileGetAttrUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'FileSetAttr', 'FileSetAttrUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'DeleteFile', 'DeleteFileUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'RenameFile', 'RenameFileUTF8($1,$2)', 'LCL','FileUtil');
AddFunc(Categ,'FileSearch', 'FileSearchUTF8($1,$2)', 'LCL','FileUtil');
AddFunc(Categ,'FileIsReadOnly', 'FileIsReadOnlyUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'GetCurrentDir', 'GetCurrentDirUTF8', 'LCL','FileUtil');
AddFunc(Categ,'SetCurrentDir', 'SetCurrentDirUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'CreateDir', 'CreateDirUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'RemoveDir', 'RemoveDirUTF8($1)', 'LCL','FileUtil');
AddFunc(Categ,'ForceDirectories', 'ForceDirectoriesUTF8($1)', 'LCL','FileUtil');
// File functions using a handle.
Categ:='FileHandle';
if AddFunc(Categ,'CreateFile','FileCreate($1)','','SysUtils')<>-1 then
AddCategory(Categ);
AddFunc(Categ, 'GetFileSize','FileSize($1)' ,'','SysUtils');
AddFunc(Categ, 'ReadFile', 'FileRead($1)' ,'','SysUtils');
AddFunc(Categ, 'CloseHandle','FileClose($1)','','SysUtils');
// Others
Categ:='Other';
if AddFunc(Categ, 'ShellExecute',
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '')<>-1 then
AddCategory(Categ);
end;
end; end;
destructor TConvertSettings.Destroy; destructor TConvertSettings.Destroy;

64
converter/replacefuncsunit.lfm
View File

@ -1,18 +1,19 @@
object ReplaceFuncsForm: TReplaceFuncsForm object ReplaceFuncsForm: TReplaceFuncsForm
Left = 361 Left = 508
Height = 321 Height = 626
Top = 90 Top = 104
Width = 856 Width = 928
Caption = 'Functions to replace' Caption = 'Functions to replace'
ClientHeight = 321 ClientHeight = 626
ClientWidth = 856 ClientWidth = 928
OnCreate = FormCreate OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
object ButtonPanel: TButtonPanel object ButtonPanel: TButtonPanel
Left = 6 Left = 6
Height = 39 Height = 39
Top = 276 Top = 581
Width = 844 Width = 916
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.Caption = '&OK' OKButton.Caption = '&OK'
OKButton.OnClick = OKButtonClick OKButton.OnClick = OKButtonClick
@ -27,19 +28,22 @@ object ReplaceFuncsForm: TReplaceFuncsForm
ShowButtons = [pbOK, pbCancel, pbHelp] ShowButtons = [pbOK, pbCancel, pbHelp]
end end
object Grid: TStringGrid object Grid: TStringGrid
AnchorSideLeft.Control = Splitter1
AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = ButtonPanel
Left = 162 Left = 162
Height = 270 Height = 575
Top = 0 Top = 0
Width = 694 Width = 766
Align = alClient Anchors = [akTop, akLeft, akRight, akBottom]
Columns = < Columns = <
item item
Title.Caption = 'Category' Title.Caption = 'Category'
Width = 80 Width = 100
end end
item item
Title.Caption = 'Delphi Function' Title.Caption = 'Delphi Function'
Width = 120 Width = 150
end end
item item
Title.Caption = 'Replacement' Title.Caption = 'Replacement'
@ -47,11 +51,11 @@ object ReplaceFuncsForm: TReplaceFuncsForm
end end
item item
Title.Caption = 'Package' Title.Caption = 'Package'
Width = 100 Width = 90
end end
item item
Title.Caption = 'Unit' Title.Caption = 'Unit'
Width = 100 Width = 90
end> end>
FixedCols = 0 FixedCols = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll]
@ -59,19 +63,24 @@ object ReplaceFuncsForm: TReplaceFuncsForm
RowCount = 2 RowCount = 2
TabOrder = 1 TabOrder = 1
ColWidths = ( ColWidths = (
80 100
120 150
310 310
100 90
100 90
) )
end end
object CategoryListBox: TCheckListBox object CategoryListBox: TCheckListBox
AnchorSideTop.Control = CategoriesLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Splitter1
AnchorSideBottom.Control = ButtonPanel
Left = 0 Left = 0
Height = 270 Height = 546
Top = 0 Top = 29
Width = 157 Width = 157
Align = alLeft Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 5
ItemHeight = 0 ItemHeight = 0
TabOrder = 2 TabOrder = 2
end end
@ -80,6 +89,17 @@ object ReplaceFuncsForm: TReplaceFuncsForm
Height = 270 Height = 270
Top = 0 Top = 0
Width = 5 Width = 5
Align = alNone
end
object CategoriesLabel: TLabel
Left = 6
Height = 16
Top = 8
Width = 131
Caption = 'Categories to convert :'
Font.Height = -13
ParentColor = False
ParentFont = False
end end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup OnPopup = PopupMenu1Popup

16
converter/replacefuncsunit.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, ButtonPanel, ComCtrls, Grids, CheckLst, Menus, SynRegExpr, Buttons, ButtonPanel, ComCtrls, Grids, CheckLst, Menus, StdCtrls, SynRegExpr,
LazarusIDEStrConsts, ConverterTypes; LazarusIDEStrConsts, ConverterTypes;
type type
@ -61,7 +61,7 @@ type
function FuncAtInd(Ind: integer): TFuncReplacement; function FuncAtInd(Ind: integer): TFuncReplacement;
public public
property Funcs: TStringList read fFuncs; property Funcs: TStringList read fFuncs;
property CategInUse: TStringList read fCategInUse; property CategoryInUse: TStringList read fCategInUse;
end; end;
{ TReplaceFuncsForm } { TReplaceFuncsForm }
@ -72,6 +72,7 @@ type
DeleteRow1: TMenuItem; DeleteRow1: TMenuItem;
Grid: TStringGrid; Grid: TStringGrid;
InsertRow1: TMenuItem; InsertRow1: TMenuItem;
CategoriesLabel: TLabel;
PopupMenu1: TPopupMenu; PopupMenu1: TPopupMenu;
Splitter1: TSplitter; Splitter1: TSplitter;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
@ -280,6 +281,8 @@ begin
fFuncs.Sorted:=True; fFuncs.Sorted:=True;
fFuncs.CaseSensitive:=False; fFuncs.CaseSensitive:=False;
fCategInUse:=TStringList.Create; fCategInUse:=TStringList.Create;
fCategInUse.Sorted:=True;
fCategInUse.Duplicates:=dupIgnore;
end; end;
destructor TFuncsAndCategories.Destroy; destructor TFuncsAndCategories.Destroy;
@ -302,6 +305,7 @@ end;
function TFuncsAndCategories.AddFunc( function TFuncsAndCategories.AddFunc(
aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string): integer; aCategory, aDelphiFunc, aReplaceFunc, aPackage, aUnitName: string): integer;
// This is called when settings are read or when user made changes in GUI. // This is called when settings are read or when user made changes in GUI.
// Returns index for the added func replacement, or -1 if not added (duplicate).
var var
FuncRepl: TFuncReplacement; FuncRepl: TFuncReplacement;
x: integer; x: integer;
@ -395,10 +399,10 @@ begin
NewCategories:=TStringList.Create; NewCategories:=TStringList.Create;
NewCategories.Sorted:=True; NewCategories.Sorted:=True;
try try
Grid.BeginUpdate; Grid.BeginUpdate; // Skip the fixed row in grid.
for i:=1 to aFuncsAndCateg.fFuncs.Count do begin // Skip the fixed row in grid. for i:=1 to aFuncsAndCateg.fFuncs.Count do begin
if Grid.RowCount<i+2 then if Grid.RowCount<i+2 then
Grid.RowCount:=i+2; // Leave one empty row to the end. Grid.RowCount:=i+2; // Leave one empty row to the end.
FuncRepl:=TFuncReplacement(aFuncsAndCateg.fFuncs.Objects[i-1]); FuncRepl:=TFuncReplacement(aFuncsAndCateg.fFuncs.Objects[i-1]);
Grid.Cells[0,i]:=FuncRepl.fCategory; Grid.Cells[0,i]:=FuncRepl.fCategory;
Grid.Cells[1,i]:=aFuncsAndCateg.fFuncs[i-1]; // Delphi function name Grid.Cells[1,i]:=aFuncsAndCateg.fFuncs[i-1]; // Delphi function name
@ -409,7 +413,7 @@ begin
CategoryListBox.Items.Add(FuncRepl.fCategory); CategoryListBox.Items.Add(FuncRepl.fCategory);
NewCatInd:=NewCategories.Add(FuncRepl.fCategory); NewCatInd:=NewCategories.Add(FuncRepl.fCategory);
CategoryListBox.Checked[NewCatInd]:= CategoryListBox.Checked[NewCatInd]:=
aFuncsAndCateg.fCategInUse.Find(FuncRepl.fCategory, x); aFuncsAndCateg.fCategInUse.Find(FuncRepl.fCategory, x);
end; end;
end; end;
Grid.EndUpdate; Grid.EndUpdate;