Converter: separate missing properties and class types to their own grids.

git-svn-id: trunk@25994 -
This commit is contained in:
juha 2010-06-08 21:46:17 +00:00
parent c6f133de70
commit bc2773b52f
4 changed files with 150 additions and 63 deletions

View File

@ -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

View File

@ -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);

View File

@ -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;

View File

@ -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%'