mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-12 23:59:59 +02:00
Converter: separate missing properties and class types to their own grids.
git-svn-id: trunk@25994 -
This commit is contained in:
parent
c6f133de70
commit
bc2773b52f
@ -1,13 +1,14 @@
|
||||
object FixLFMDialog: TFixLFMDialog
|
||||
Left = 280
|
||||
Height = 536
|
||||
Top = 233
|
||||
Left = 366
|
||||
Height = 637
|
||||
Top = 94
|
||||
Width = 756
|
||||
ActiveControl = LFMSynEdit
|
||||
Caption = 'Fix LFM file'
|
||||
ClientHeight = 536
|
||||
ClientHeight = 637
|
||||
ClientWidth = 756
|
||||
OnCreate = CheckLFMDialogCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object NoteLabel: TLabel
|
||||
Left = 0
|
||||
@ -21,17 +22,17 @@ object FixLFMDialog: TFixLFMDialog
|
||||
end
|
||||
object LFMGroupBox: TGroupBox
|
||||
Left = 0
|
||||
Height = 368
|
||||
Height = 469
|
||||
Top = 16
|
||||
Width = 408
|
||||
Align = alLeft
|
||||
Caption = 'LFM file'
|
||||
ClientHeight = 349
|
||||
ClientHeight = 450
|
||||
ClientWidth = 404
|
||||
TabOrder = 0
|
||||
inline LFMSynEdit: TSynEdit
|
||||
Left = 0
|
||||
Height = 349
|
||||
Height = 450
|
||||
Top = 0
|
||||
Width = 404
|
||||
Align = alClient
|
||||
@ -629,7 +630,7 @@ object FixLFMDialog: TFixLFMDialog
|
||||
object ErrorsGroupBox: TGroupBox
|
||||
Left = 0
|
||||
Height = 104
|
||||
Top = 384
|
||||
Top = 490
|
||||
Width = 756
|
||||
Align = alBottom
|
||||
Caption = 'Errors'
|
||||
@ -649,20 +650,20 @@ object FixLFMDialog: TFixLFMDialog
|
||||
end
|
||||
object BtnPanel: TPanel
|
||||
Left = 0
|
||||
Height = 48
|
||||
Top = 488
|
||||
Height = 43
|
||||
Top = 594
|
||||
Width = 756
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 48
|
||||
ClientHeight = 43
|
||||
ClientWidth = 756
|
||||
TabOrder = 2
|
||||
object CancelButton: TBitBtn
|
||||
Left = 669
|
||||
Height = 36
|
||||
Left = 670
|
||||
Height = 31
|
||||
Top = 6
|
||||
Width = 81
|
||||
Width = 80
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
@ -675,12 +676,12 @@ object FixLFMDialog: TFixLFMDialog
|
||||
end
|
||||
object ReplaceAllButton: TBitBtn
|
||||
Left = 6
|
||||
Height = 25
|
||||
Height = 26
|
||||
Top = 6
|
||||
Width = 230
|
||||
Width = 193
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Replace unknown types and properties'
|
||||
Caption = 'Fix unknown properties and types'
|
||||
NumGlyphs = 0
|
||||
OnClick = ReplaceAllButtonClick
|
||||
TabOrder = 1
|
||||
@ -688,29 +689,29 @@ object FixLFMDialog: TFixLFMDialog
|
||||
end
|
||||
object PropertyReplaceGroupBox: TGroupBox
|
||||
Left = 413
|
||||
Height = 368
|
||||
Height = 469
|
||||
Top = 16
|
||||
Width = 343
|
||||
Align = alClient
|
||||
Caption = 'Properties and Types to replace'
|
||||
ClientHeight = 349
|
||||
Caption = 'Replacements'
|
||||
ClientHeight = 450
|
||||
ClientWidth = 339
|
||||
TabOrder = 3
|
||||
object PropertyReplaceGrid: TStringGrid
|
||||
object PropReplaceGrid: TStringGrid
|
||||
Left = 0
|
||||
Height = 349
|
||||
Top = 0
|
||||
Height = 187
|
||||
Top = 17
|
||||
Width = 339
|
||||
Align = alClient
|
||||
Align = alTop
|
||||
AutoFillColumns = True
|
||||
ColCount = 2
|
||||
Columns = <
|
||||
item
|
||||
Title.Caption = 'Delphi name'
|
||||
Title.Caption = 'Delphi Property'
|
||||
Width = 167
|
||||
end
|
||||
item
|
||||
Title.Caption = 'New name'
|
||||
Title.Caption = 'New Property'
|
||||
Width = 168
|
||||
end>
|
||||
FixedCols = 0
|
||||
@ -722,13 +723,77 @@ object FixLFMDialog: TFixLFMDialog
|
||||
168
|
||||
)
|
||||
end
|
||||
object PropertiesText: TStaticText
|
||||
Left = 0
|
||||
Height = 17
|
||||
Top = 0
|
||||
Width = 339
|
||||
Align = alTop
|
||||
BorderStyle = sbsSunken
|
||||
Caption = 'Properties'
|
||||
TabOrder = 1
|
||||
end
|
||||
object Splitter3: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 204
|
||||
Width = 339
|
||||
Align = alTop
|
||||
ResizeAnchor = akTop
|
||||
end
|
||||
object TypeReplaceGrid: TStringGrid
|
||||
Left = 0
|
||||
Height = 224
|
||||
Top = 226
|
||||
Width = 339
|
||||
Align = alClient
|
||||
AutoFillColumns = True
|
||||
ColCount = 2
|
||||
Columns = <
|
||||
item
|
||||
Title.Caption = 'Delphi Type'
|
||||
Width = 167
|
||||
end
|
||||
item
|
||||
Title.Caption = 'New Type'
|
||||
Width = 168
|
||||
end>
|
||||
FixedCols = 0
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
|
||||
RowCount = 2
|
||||
TabOrder = 3
|
||||
ColWidths = (
|
||||
167
|
||||
168
|
||||
)
|
||||
end
|
||||
object TypesText: TStaticText
|
||||
Left = 0
|
||||
Height = 17
|
||||
Top = 209
|
||||
Width = 339
|
||||
Align = alTop
|
||||
BorderStyle = sbsSunken
|
||||
Caption = 'Types'
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 408
|
||||
Height = 368
|
||||
Height = 469
|
||||
Top = 16
|
||||
Width = 5
|
||||
end
|
||||
object Splitter2: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 485
|
||||
Width = 756
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
object SynLFMSyn1: TSynLFMSyn
|
||||
DefaultFilter = 'Lazarus Form Files (*.lfm)|*.lfm'
|
||||
Enabled = False
|
||||
|
@ -72,9 +72,10 @@ type
|
||||
fHasMissingObjectTypes: Boolean;
|
||||
// References to controls in UI:
|
||||
fPropReplaceGrid: TStringGrid;
|
||||
fTypeReplaceGrid: TStringGrid;
|
||||
function ReplaceAndRemoveAll: TModalResult;
|
||||
// Fill StringGrid with missing properties from fLFMTree.
|
||||
procedure FillPropReplaceList;
|
||||
// Fill StringGrids with missing properties and types from fLFMTree.
|
||||
procedure FillReplaceGrids;
|
||||
protected
|
||||
procedure LoadLFM;
|
||||
function ShowRepairLFMWizard: TModalResult; override;
|
||||
@ -94,6 +95,7 @@ type
|
||||
CancelButton: TBitBtn;
|
||||
ErrorsGroupBox: TGroupBox;
|
||||
ErrorsListBox: TListBox;
|
||||
TypeReplaceGrid: TStringGrid;
|
||||
PropertyReplaceGroupBox: TGroupBox;
|
||||
NoteLabel: TLabel;
|
||||
LFMGroupBox: TGroupBox;
|
||||
@ -101,7 +103,11 @@ type
|
||||
BtnPanel: TPanel;
|
||||
ReplaceAllButton: TBitBtn;
|
||||
Splitter1: TSplitter;
|
||||
PropertyReplaceGrid: TStringGrid;
|
||||
PropReplaceGrid: TStringGrid;
|
||||
Splitter2: TSplitter;
|
||||
Splitter3: TSplitter;
|
||||
PropertiesText: TStaticText;
|
||||
TypesText: TStaticText;
|
||||
SynLFMSyn1: TSynLFMSyn;
|
||||
procedure ErrorsListBoxClick(Sender: TObject);
|
||||
procedure ReplaceAllButtonClick(Sender: TObject);
|
||||
@ -246,21 +252,27 @@ var
|
||||
CurError: TLFMError;
|
||||
TheNode: TLFMTreeNode;
|
||||
ObjNode: TLFMObjectNode;
|
||||
// Type name --> replacement name.
|
||||
NameReplacements: TStringToStringTree;
|
||||
// Property / Type name --> replacement name.
|
||||
PropReplacements: TStringToStringTree;
|
||||
TypeReplacements: TStringToStringTree;
|
||||
// List of TLFMChangeEntry objects.
|
||||
ChgEntryRepl: TObjectList;
|
||||
GridUpdater: TGridUpdater;
|
||||
// Updater moves data between grid and map.
|
||||
PropUpdater: TGridUpdater;
|
||||
TypeUpdater: TGridUpdater;
|
||||
OldIdent, NewIdent: string;
|
||||
StartPos, EndPos: integer;
|
||||
begin
|
||||
Result:=mrOK;
|
||||
ChgEntryRepl:=TObjectList.Create;
|
||||
NameReplacements:=TStringToStringTree.Create(false);
|
||||
GridUpdater:=TGridUpdater.Create(NameReplacements, fPropReplaceGrid);
|
||||
PropReplacements:=TStringToStringTree.Create(false);
|
||||
TypeReplacements:=TStringToStringTree.Create(false);
|
||||
PropUpdater:=TGridUpdater.Create(PropReplacements, fPropReplaceGrid);
|
||||
TypeUpdater:=TGridUpdater.Create(TypeReplacements, fTypeReplaceGrid);
|
||||
try
|
||||
// Collect (maybe edited) properties from StringGrid to NameReplacements.
|
||||
GridUpdater.GridToMap;
|
||||
// Collect (maybe edited) properties from StringGrid to map.
|
||||
PropUpdater.GridToMap;
|
||||
TypeUpdater.GridToMap;
|
||||
// Replace each missing property / type or delete it if no replacement.
|
||||
CurError:=fLFMTree.LastError;
|
||||
while CurError<>nil do begin
|
||||
@ -270,7 +282,7 @@ begin
|
||||
// Object type
|
||||
ObjNode:=CurError.Node as TLFMObjectNode;
|
||||
OldIdent:=ObjNode.TypeName;
|
||||
NewIdent:=NameReplacements[OldIdent];
|
||||
NewIdent:=TypeReplacements[OldIdent];
|
||||
// Keep the old class name if no replacement.
|
||||
if NewIdent<>'' then begin
|
||||
StartPos:=ObjNode.TypeNamePosition;
|
||||
@ -284,7 +296,7 @@ begin
|
||||
TheNode.FindIdentifier(StartPos,EndPos);
|
||||
if StartPos>0 then begin
|
||||
OldIdent:=copy(fLFMBuffer.Source,StartPos,EndPos-StartPos);
|
||||
NewIdent:=NameReplacements[OldIdent];
|
||||
NewIdent:=PropReplacements[OldIdent];
|
||||
// Delete the whole property line if no replacement.
|
||||
if NewIdent='' then
|
||||
FindNiceNodeBounds(TheNode,StartPos,EndPos);
|
||||
@ -294,56 +306,61 @@ begin
|
||||
end;
|
||||
CurError:=CurError.PrevError;
|
||||
end;
|
||||
// Apply replacement types also to pascal source.
|
||||
if not CodeToolBoss.RetypeClassVariables(fPascalBuffer,
|
||||
TLFMObjectNode(fLFMTree.Root).TypeName, NameReplacements, false)
|
||||
then begin
|
||||
// Apply replacements to LFM.
|
||||
if not ApplyReplacements(ChgEntryRepl) then begin
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
end;
|
||||
// Apply replacements to LFM.
|
||||
if not ApplyReplacements(ChgEntryRepl) then
|
||||
// Apply replacement types also to pascal source.
|
||||
if not CodeToolBoss.RetypeClassVariables(fPascalBuffer,
|
||||
TLFMObjectNode(fLFMTree.Root).TypeName, TypeReplacements, false) then
|
||||
Result:=mrCancel;
|
||||
finally
|
||||
GridUpdater.Free;
|
||||
NameReplacements.Free;
|
||||
TypeUpdater.Free;
|
||||
PropUpdater.Free;
|
||||
TypeReplacements.Free;
|
||||
PropReplacements.Free;
|
||||
ChgEntryRepl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLFMFixer.FillPropReplaceList;
|
||||
procedure TLFMFixer.FillReplaceGrids;
|
||||
var
|
||||
PropUpdater: TGridUpdater;
|
||||
TypeUpdater: TGridUpdater;
|
||||
CurError: TLFMError;
|
||||
GridUpdater: TGridUpdater;
|
||||
OldIdent: string;
|
||||
begin
|
||||
fHasMissingObjectTypes:=false;
|
||||
GridUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fPropReplaceGrid);
|
||||
// ReplaceTypes is used for properties just in case it will provide some.
|
||||
PropUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fPropReplaceGrid);
|
||||
TypeUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fTypeReplaceGrid);
|
||||
try
|
||||
if fLFMTree<>nil then begin
|
||||
CurError:=fLFMTree.FirstError;
|
||||
while CurError<>nil do begin
|
||||
if CurError.IsMissingObjectType then begin
|
||||
OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
|
||||
TypeUpdater.AddUniqueToGrid(OldIdent); // Add a unique type only once.
|
||||
fHasMissingObjectTypes:=true;
|
||||
end
|
||||
else
|
||||
else begin
|
||||
OldIdent:=CurError.Node.GetIdentifier;
|
||||
// Add only one instance of each property name.
|
||||
GridUpdater.AddUnique(OldIdent);
|
||||
PropUpdater.AddUniqueToGrid(OldIdent); // Add a unique property only once.
|
||||
end;
|
||||
CurError:=CurError.NextError;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
GridUpdater.Free;
|
||||
TypeUpdater.Free;
|
||||
PropUpdater.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLFMFixer.LoadLFM;
|
||||
begin
|
||||
inherited LoadLFM;
|
||||
// Fill PropertyReplaceGrid
|
||||
FillPropReplaceList;
|
||||
FillReplaceGrids; // Fill both ReplaceGrids.
|
||||
end;
|
||||
|
||||
function TLFMFixer.ShowRepairLFMWizard: TModalResult;
|
||||
@ -356,7 +373,8 @@ begin
|
||||
try
|
||||
fLFMSynEdit:=FixLFMDialog.LFMSynEdit;
|
||||
fErrorsListBox:=FixLFMDialog.ErrorsListBox;
|
||||
fPropReplaceGrid:=FixLFMDialog.PropertyReplaceGrid;
|
||||
fPropReplaceGrid:=FixLFMDialog.PropReplaceGrid;
|
||||
fTypeReplaceGrid:=FixLFMDialog.TypeReplaceGrid;
|
||||
LoadLFM;
|
||||
if fSettings.AutoRemoveProperties and not fHasMissingObjectTypes then
|
||||
Result:=ReplaceAndRemoveAll
|
||||
@ -471,7 +489,9 @@ begin
|
||||
NoteLabel.Caption:=lisLFMFileContainsInvalidProperties;
|
||||
ErrorsGroupBox.Caption:=lisErrors;
|
||||
LFMGroupBox.Caption:=lisLFMFile;
|
||||
PropertyReplaceGroupBox.Caption:=lisReplacementPropTypes;
|
||||
PropertyReplaceGroupBox.Caption:=lisReplacements;
|
||||
PropertiesText.Caption:=lisProperties;
|
||||
TypesText.Caption:=lisTypes;
|
||||
ReplaceAllButton.Caption:=lisReplaceRemoveUnknown;
|
||||
ReplaceAllButton.LoadGlyphFromLazarusResource('laz_refresh');
|
||||
EditorOpts.GetHighlighterSettings(SynLFMSyn1);
|
||||
|
@ -33,7 +33,7 @@ type
|
||||
public
|
||||
constructor Create(AStringMap: TStringToStringTree; AGrid: TStringGrid);
|
||||
destructor Destroy; override;
|
||||
procedure AddUnique(AOldIdent: string);
|
||||
procedure AddUniqueToGrid(AOldIdent: string);
|
||||
procedure MapToGrid;
|
||||
procedure GridToMap;
|
||||
end;
|
||||
@ -177,7 +177,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGridUpdater.AddUnique(AOldIdent: string);
|
||||
procedure TGridUpdater.AddUniqueToGrid(AOldIdent: string);
|
||||
// Add a new Delphi -> Lazarus mapping to grid.
|
||||
var
|
||||
NewIdent: string;
|
||||
@ -199,7 +199,7 @@ end;
|
||||
|
||||
procedure TReplaceNamesForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:=lisReplacementPropTypes;
|
||||
Caption:=lisReplacements;
|
||||
IsLasRow:=false;
|
||||
end;
|
||||
|
||||
|
@ -467,8 +467,10 @@ resourcestring
|
||||
lisConvTypesToReplace = 'Types to replace';
|
||||
lisConvUnitReplacements = 'Unit Replacements';
|
||||
lisConvTypeReplacements = 'Type Replacements';
|
||||
lisReplacementPropTypes = 'Replacement Properties and Types';
|
||||
lisReplaceRemoveUnknown = 'Replace unknown types and properties';
|
||||
lisReplacements = 'Replacements';
|
||||
lisProperties = 'Properties (replace or delete)';
|
||||
lisTypes = 'Types (not removed if no replacement)';
|
||||
lisReplaceRemoveUnknown = 'Fix unknown properties and types';
|
||||
|
||||
lisUnableToLoadOldResourceFileTheResourceFileIs = 'Unable to load old '
|
||||
+'resource file.%sThe resource file is the first include file in the%'
|
||||
|
Loading…
Reference in New Issue
Block a user