mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 22:58:50 +02:00
Converter: improved function replacement with categories. Added more UTF8 functions.
git-svn-id: trunk@26720 -
This commit is contained in:
juha
parent
62d890f71d
commit
60d84c8bf0
@ -52,12 +52,12 @@ type
|
||||
function CommentOutUnits: boolean;
|
||||
function ReplaceFuncsInSource: boolean;
|
||||
function RememberProcDefinition(aNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function ReplaceFuncCalls: boolean;
|
||||
function ReplaceFuncCalls(aIsConsoleApp: boolean): boolean;
|
||||
function HandleCodetoolError: TModalResult;
|
||||
public
|
||||
constructor Create(Code: TCodeBuffer);
|
||||
destructor Destroy; override;
|
||||
function Convert: TModalResult;
|
||||
function Convert(aIsConsoleApp: boolean): TModalResult;
|
||||
function FindApptypeConsole: boolean;
|
||||
function RemoveUnits: boolean;
|
||||
function RenameUnits: boolean;
|
||||
@ -126,7 +126,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TConvDelphiCodeTool.Convert: TModalResult;
|
||||
function TConvDelphiCodeTool.Convert(aIsConsoleApp: boolean): TModalResult;
|
||||
// add {$mode delphi} directive
|
||||
// remove {$R *.dfm} or {$R *.xfm} directive
|
||||
// Change {$R *.RES} to {$R *.res} if needed
|
||||
@ -139,7 +139,7 @@ begin
|
||||
// these changes can be applied together without rescan
|
||||
if not AddModeDelphiDirective then exit;
|
||||
if not RenameResourceDirectives then exit;
|
||||
if not ReplaceFuncCalls then exit;
|
||||
if not ReplaceFuncCalls(aIsConsoleApp) then exit;
|
||||
if not fSrcCache.Apply then exit;
|
||||
finally
|
||||
fSrcCache.EndUpdate;
|
||||
@ -508,7 +508,7 @@ var
|
||||
ParamList: TStringList;
|
||||
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.
|
||||
// Returns the first position where comments can be searched from.
|
||||
var
|
||||
@ -549,7 +549,7 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetComment(aStr: string; aPossibleStartPos: integer): string;
|
||||
function GetComment(const aStr: string; aPossibleStartPos: integer): string;
|
||||
// Extract and return a possible comment.
|
||||
var
|
||||
CommChBeg, CommBeg, CommEnd, i: Integer; // Start and end of comment.
|
||||
@ -630,10 +630,10 @@ begin
|
||||
Result:=aNode.Next;
|
||||
end;
|
||||
|
||||
function TConvDelphiCodeTool.ReplaceFuncCalls: boolean;
|
||||
function TConvDelphiCodeTool.ReplaceFuncCalls(aIsConsoleApp: boolean): boolean;
|
||||
// Copied and modified from TFindDeclarationTool.FindReferences.
|
||||
// Search for calls to functions / procedures given in a list in current unit's
|
||||
// implementation section. Add their positions to another list for replacement.
|
||||
// Search for calls to functions / procedures in a list from current unit's
|
||||
// implementation section. Replace found calls with a given replacement.
|
||||
var
|
||||
xStart: Integer;
|
||||
|
||||
@ -695,7 +695,7 @@ var
|
||||
|
||||
procedure ReadFuncCall(MaxPos: Integer);
|
||||
var
|
||||
FuncInfo: TFuncReplacement;
|
||||
FuncDefInfo, FuncCallInfo: TFuncReplacement;
|
||||
FuncName: string;
|
||||
i, x, IdentEndPos: Integer;
|
||||
begin
|
||||
@ -709,12 +709,17 @@ var
|
||||
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(fReplaceFuncs.FuncAtInd(i));
|
||||
ReadParams(FuncInfo);
|
||||
IdentEndPos:=FuncInfo.EndPos; // Skip the params, too, for next search.
|
||||
fFuncsToReplace.Add(FuncInfo);
|
||||
Break;
|
||||
FuncDefInfo:=fReplaceFuncs.FuncAtInd(i);
|
||||
if fReplaceFuncs.CategoryInUse.Find(FuncDefInfo.Category, x)
|
||||
and not (aIsConsoleApp and (FuncDefInfo.Category='UTF8Names'))
|
||||
then begin
|
||||
// Create a new replacement object for params, position and other info.
|
||||
FuncCallInfo:=TFuncReplacement.Create(FuncDefInfo);
|
||||
ReadParams(FuncCallInfo);
|
||||
IdentEndPos:=FuncCallInfo.EndPos; // Skip the params, too, for next search.
|
||||
fFuncsToReplace.Add(FuncCallInfo);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -492,6 +492,7 @@ function TConvertDelphiUnit.ConvertUnitFile: TModalResult;
|
||||
var
|
||||
DfmFilename: string; // Delphi .DFM file name.
|
||||
LfmFilename: string; // Lazarus .LFM file name.
|
||||
ConsApp: Boolean;
|
||||
ConvTool: TConvDelphiCodeTool;
|
||||
begin
|
||||
fUnitsToRemove:=TStringList.Create;
|
||||
@ -546,7 +547,11 @@ begin
|
||||
// Fix or comment missing units, show error messages.
|
||||
Result:=FixMissingUnits;
|
||||
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.
|
||||
ConvTool.Ask:=Assigned(fOwnerConverter);
|
||||
ConvTool.LowerCaseRes:=FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res'));
|
||||
@ -556,7 +561,7 @@ begin
|
||||
ConvTool.UnitsToRemove:=fUnitsToRemove;
|
||||
ConvTool.UnitsToRename:=fUnitsToRename;
|
||||
ConvTool.UnitsToComment:=fUnitsToComment;
|
||||
Result:=ConvTool.Convert;
|
||||
Result:=ConvTool.Convert(ConsApp);
|
||||
finally
|
||||
ConvTool.Free;
|
||||
fUnitsToComment.Free;
|
||||
|
||||
@ -237,15 +237,15 @@ begin
|
||||
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];
|
||||
Config.SetDeleteValue(CategPath+'Count', aFuncsAndCateg.CategoryInUse.Count, 0);
|
||||
for i:=0 to aFuncsAndCateg.CategoryInUse.Count-1 do begin
|
||||
s:=aFuncsAndCateg.CategoryInUse[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
|
||||
for i:=aFuncsAndCateg.CategoryInUse.Count to aFuncsAndCateg.CategoryInUse.Count+10 do begin
|
||||
SubPath:=CategPath+'Item'+IntToStr(i)+'/';
|
||||
Config.DeletePath(SubPath);
|
||||
end;
|
||||
@ -257,6 +257,7 @@ end;
|
||||
constructor TConvertSettings.Create(const ATitle: string);
|
||||
var
|
||||
TheMap: TStringToStringTree;
|
||||
Categ: string;
|
||||
|
||||
procedure MapReplacement(ADelphi, ALCL: string);
|
||||
begin
|
||||
@ -324,18 +325,44 @@ begin
|
||||
MapReplacement('^TTnt(.+[^L][^X])$','T$1');
|
||||
|
||||
// Map Delphi function names to FCL/LCL functions.
|
||||
fReplaceFuncs.AddFunc('Other', 'ShellExecute',
|
||||
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '');
|
||||
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts.
|
||||
fReplaceFuncs.AddFunc('UTF8Names', 'FileExists', 'FileExistsUTF8($1)', '', '');
|
||||
// File functions using a handle.
|
||||
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');
|
||||
with fReplaceFuncs do begin
|
||||
// File name encoding.
|
||||
Categ:='UTF8Names';
|
||||
if AddFunc(Categ,'FileExists', 'FileExistsUTF8($1)','LCL','FileUtil')<>-1 then
|
||||
AddCategory(Categ); // Use the category by default if the func was added.
|
||||
AddFunc(Categ,'FileAge', 'FileAgeUTF8($1)', 'LCL','FileUtil');
|
||||
AddFunc(Categ,'DirectoryExists', 'DirectoryExistsUTF8($1)', 'LCL','FileUtil');
|
||||
AddFunc(Categ,'ExpandFileName', 'ExpandFileNameUTF8($1)', 'LCL','FileUtil');
|
||||
AddFunc(Categ,'ExpandUNCFileName', 'ExpandUNCFileNameUTF8($1)', 'LCL','FileUtil');
|
||||
AddFunc(Categ,'ExtractShortPathName','ExtractShortPathNameUTF8($1)','LCL','FileUtil');
|
||||
AddFunc(Categ,'FindFirst', 'FindFirstUTF8($1,$2,$3)', 'LCL','FileUtil');
|
||||
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;
|
||||
|
||||
destructor TConvertSettings.Destroy;
|
||||
|
||||
@ -1,18 +1,19 @@
|
||||
object ReplaceFuncsForm: TReplaceFuncsForm
|
||||
Left = 361
|
||||
Height = 321
|
||||
Top = 90
|
||||
Width = 856
|
||||
Left = 508
|
||||
Height = 626
|
||||
Top = 104
|
||||
Width = 928
|
||||
Caption = 'Functions to replace'
|
||||
ClientHeight = 321
|
||||
ClientWidth = 856
|
||||
ClientHeight = 626
|
||||
ClientWidth = 928
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object ButtonPanel: TButtonPanel
|
||||
Left = 6
|
||||
Height = 39
|
||||
Top = 276
|
||||
Width = 844
|
||||
Top = 581
|
||||
Width = 916
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.Caption = '&OK'
|
||||
OKButton.OnClick = OKButtonClick
|
||||
@ -27,19 +28,22 @@ object ReplaceFuncsForm: TReplaceFuncsForm
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
end
|
||||
object Grid: TStringGrid
|
||||
AnchorSideLeft.Control = Splitter1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideBottom.Control = ButtonPanel
|
||||
Left = 162
|
||||
Height = 270
|
||||
Height = 575
|
||||
Top = 0
|
||||
Width = 694
|
||||
Align = alClient
|
||||
Width = 766
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
Columns = <
|
||||
item
|
||||
Title.Caption = 'Category'
|
||||
Width = 80
|
||||
Width = 100
|
||||
end
|
||||
item
|
||||
Title.Caption = 'Delphi Function'
|
||||
Width = 120
|
||||
Width = 150
|
||||
end
|
||||
item
|
||||
Title.Caption = 'Replacement'
|
||||
@ -47,11 +51,11 @@ object ReplaceFuncsForm: TReplaceFuncsForm
|
||||
end
|
||||
item
|
||||
Title.Caption = 'Package'
|
||||
Width = 100
|
||||
Width = 90
|
||||
end
|
||||
item
|
||||
Title.Caption = 'Unit'
|
||||
Width = 100
|
||||
Width = 90
|
||||
end>
|
||||
FixedCols = 0
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll]
|
||||
@ -59,19 +63,24 @@ object ReplaceFuncsForm: TReplaceFuncsForm
|
||||
RowCount = 2
|
||||
TabOrder = 1
|
||||
ColWidths = (
|
||||
80
|
||||
120
|
||||
100
|
||||
150
|
||||
310
|
||||
100
|
||||
100
|
||||
90
|
||||
90
|
||||
)
|
||||
end
|
||||
object CategoryListBox: TCheckListBox
|
||||
AnchorSideTop.Control = CategoriesLabel
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Splitter1
|
||||
AnchorSideBottom.Control = ButtonPanel
|
||||
Left = 0
|
||||
Height = 270
|
||||
Top = 0
|
||||
Height = 546
|
||||
Top = 29
|
||||
Width = 157
|
||||
Align = alLeft
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Top = 5
|
||||
ItemHeight = 0
|
||||
TabOrder = 2
|
||||
end
|
||||
@ -80,6 +89,17 @@ object ReplaceFuncsForm: TReplaceFuncsForm
|
||||
Height = 270
|
||||
Top = 0
|
||||
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
|
||||
object PopupMenu1: TPopupMenu
|
||||
OnPopup = PopupMenu1Popup
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
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;
|
||||
|
||||
type
|
||||
@ -61,7 +61,7 @@ type
|
||||
function FuncAtInd(Ind: integer): TFuncReplacement;
|
||||
public
|
||||
property Funcs: TStringList read fFuncs;
|
||||
property CategInUse: TStringList read fCategInUse;
|
||||
property CategoryInUse: TStringList read fCategInUse;
|
||||
end;
|
||||
|
||||
{ TReplaceFuncsForm }
|
||||
@ -72,6 +72,7 @@ type
|
||||
DeleteRow1: TMenuItem;
|
||||
Grid: TStringGrid;
|
||||
InsertRow1: TMenuItem;
|
||||
CategoriesLabel: TLabel;
|
||||
PopupMenu1: TPopupMenu;
|
||||
Splitter1: TSplitter;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
@ -280,6 +281,8 @@ begin
|
||||
fFuncs.Sorted:=True;
|
||||
fFuncs.CaseSensitive:=False;
|
||||
fCategInUse:=TStringList.Create;
|
||||
fCategInUse.Sorted:=True;
|
||||
fCategInUse.Duplicates:=dupIgnore;
|
||||
end;
|
||||
|
||||
destructor TFuncsAndCategories.Destroy;
|
||||
@ -302,6 +305,7 @@ 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.
|
||||
// Returns index for the added func replacement, or -1 if not added (duplicate).
|
||||
var
|
||||
FuncRepl: TFuncReplacement;
|
||||
x: integer;
|
||||
@ -395,10 +399,10 @@ begin
|
||||
NewCategories:=TStringList.Create;
|
||||
NewCategories.Sorted:=True;
|
||||
try
|
||||
Grid.BeginUpdate;
|
||||
for i:=1 to aFuncsAndCateg.fFuncs.Count do begin // Skip the fixed row in grid.
|
||||
Grid.BeginUpdate; // Skip the fixed row in grid.
|
||||
for i:=1 to aFuncsAndCateg.fFuncs.Count do begin
|
||||
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]);
|
||||
Grid.Cells[0,i]:=FuncRepl.fCategory;
|
||||
Grid.Cells[1,i]:=aFuncsAndCateg.fFuncs[i-1]; // Delphi function name
|
||||
@ -409,7 +413,7 @@ begin
|
||||
CategoryListBox.Items.Add(FuncRepl.fCategory);
|
||||
NewCatInd:=NewCategories.Add(FuncRepl.fCategory);
|
||||
CategoryListBox.Checked[NewCatInd]:=
|
||||
aFuncsAndCateg.fCategInUse.Find(FuncRepl.fCategory, x);
|
||||
aFuncsAndCateg.fCategInUse.Find(FuncRepl.fCategory, x);
|
||||
end;
|
||||
end;
|
||||
Grid.EndUpdate;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user