Implemented replacing properties and class types in form files.

git-svn-id: trunk@24155 -
2025-08-12 13:50:06 +02:00 · 2010-03-21 22:06:01 +00:00 · 2010-03-21 22:06:01 +00:00 · a1ba019bb2
commit a1ba019bb2
parent 37284318cb
5 changed files with 194 additions and 93 deletions
--- a/converter/convertdelphi.pas
+++ b/converter/convertdelphi.pas
@ -636,6 +636,7 @@ begin
  if fLfmCode<>nil then begin
    LfmFixer:=TLfmFixer.Create(fUnitCode,fLfmCode,@IDEMessagesWindow.AddMsg);
    try
+      LfmFixer.Settings:=fSettings;
      LfmFixer.RootMustBeClassInIntf:=true;
      LfmFixer.ObjectsMustExists:=true;
 //      was: if RepairLFMBuffer(...,true,true)<>mrOk
--- a/converter/convertsettings.pas
+++ b/converter/convertsettings.pas
@ -140,6 +140,7 @@ begin
  fReplaceProps['TGridPanel']:='TPanel';
  fReplaceProps['TComboBoxEx']:='TComboBox';
  fReplaceProps['TCoolBar']:='TPanel';
+  fReplaceProps['TRichEdit']:='TMemo';
  fReplaceProps['TDBRichEdit']:='TDBMemo';
 end;

--- a/converter/missingpropertiesdlg.lfm
+++ b/converter/missingpropertiesdlg.lfm
@ -1,19 +1,19 @@
 object FixLFMDialog: TFixLFMDialog
-  Left = 337
-  Height = 580
-  Top = 150
-  Width = 749
+  Left = 143
+  Height = 536
+  Top = 143
+  Width = 826
  ActiveControl = LFMSynEdit
  Caption = 'Repair LFM file'
-  ClientHeight = 580
-  ClientWidth = 749
+  ClientHeight = 536
+  ClientWidth = 826
  OnCreate = CheckLFMDialogCreate
  LCLVersion = '0.9.29'
  object NoteLabel: TLabel
    Left = 0
    Height = 16
    Top = 0
-    Width = 749
+    Width = 826
    Align = alTop
    Caption = 'NoteLabel'
    ParentColor = False
@ -21,17 +21,17 @@ object FixLFMDialog: TFixLFMDialog
  end
  object LFMGroupBox: TGroupBox
    Left = 0
-    Height = 412
+    Height = 368
    Top = 16
    Width = 408
    Align = alLeft
    Caption = 'LFM file'
-    ClientHeight = 390
+    ClientHeight = 346
    ClientWidth = 398
    TabOrder = 0
    inline LFMSynEdit: TSynEdit
      Left = 0
-      Height = 390
+      Height = 346
      Top = 0
      Width = 398
      Align = alClient
@ -514,6 +514,7 @@ object FixLFMDialog: TFixLFMDialog
      Lines.Strings = (
        'LFMSynEdit'
      )
+      ReadOnly = True
      BracketHighlightStyle = sbhsBoth
      OnSpecialLineMarkup = LFMSynEditSpecialLineMarkup
      inline TSynGutterPartList
@ -628,18 +629,18 @@ object FixLFMDialog: TFixLFMDialog
  object ErrorsGroupBox: TGroupBox
    Left = 0
    Height = 104
-    Top = 428
-    Width = 749
+    Top = 384
+    Width = 826
    Align = alBottom
    Caption = 'Errors'
    ClientHeight = 82
-    ClientWidth = 739
+    ClientWidth = 816
    TabOrder = 1
    object ErrorsListBox: TListBox
      Left = 0
      Height = 82
      Top = 0
-      Width = 739
+      Width = 816
      Align = alClient
      ItemHeight = 0
      OnClick = ErrorsListBoxClick
@ -649,16 +650,16 @@ object FixLFMDialog: TFixLFMDialog
  object BtnPanel: TPanel
    Left = 0
    Height = 48
-    Top = 532
-    Width = 749
+    Top = 488
+    Width = 826
    Align = alBottom
    AutoSize = True
    BevelOuter = bvNone
    ClientHeight = 48
-    ClientWidth = 749
+    ClientWidth = 826
    TabOrder = 2
    object CancelButton: TBitBtn
-      Left = 662
+      Left = 739
      Height = 36
      Top = 6
      Width = 81
@ -672,63 +673,59 @@ object FixLFMDialog: TFixLFMDialog
      NumGlyphs = 0
      TabOrder = 0
    end
-    object RemoveAllButton: TBitBtn
+    object ReplaceAllButton: TBitBtn
      Left = 6
      Height = 25
      Top = 6
-      Width = 175
+      Width = 227
      AutoSize = True
      BorderSpacing.Around = 6
-      Caption = 'Remove all invalid properties'
+      Caption = 'Replace and remove invalid properties'
      NumGlyphs = 0
-      OnClick = RemoveAllButtonClick
-      TabOrder = 1
-    end
-    object ReplaceAllButton: TBitBtn
-      AnchorSideLeft.Control = RemoveAllButton
-      AnchorSideLeft.Side = asrBottom
-      Left = 192
-      Height = 25
-      Top = 6
-      Width = 137
-      AutoSize = True
-      BorderSpacing.Left = 11
-      Caption = 'Replace all properties'
      OnClick = ReplaceAllButtonClick
-      TabOrder = 2
-      Visible = False
+      TabOrder = 1
    end
  end
  object PropertyReplaceGroupBox: TGroupBox
    Left = 413
-    Height = 412
+    Height = 368
    Top = 16
-    Width = 336
+    Width = 413
    Align = alClient
    Caption = 'Properties to replace'
-    ClientHeight = 390
-    ClientWidth = 326
+    ClientHeight = 346
+    ClientWidth = 403
    TabOrder = 3
    object PropertyReplaceGrid: TStringGrid
      Left = 0
-      Height = 390
+      Height = 346
      Top = 0
-      Width = 326
+      Width = 403
      Align = alClient
-      ColCount = 3
+      AutoFillColumns = True
+      ColCount = 2
      Columns = <      
        item
          Title.Caption = 'Delphi Property'
+          Width = 198
        end      
        item
-          Title.Caption = 'New Property'
+          Title.Caption = 'New property'
+          Width = 199
        end>
+      FixedCols = 0
+      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
+      RowCount = 2
      TabOrder = 0
+      ColWidths = (
+        198
+        199
+      )
    end
  end
  object Splitter1: TSplitter
    Left = 408
-    Height = 412
+    Height = 368
    Top = 16
    Width = 5
  end
--- a/converter/missingpropertiesdlg.pas
+++ b/converter/missingpropertiesdlg.pas
@ -34,11 +34,11 @@ interface
 uses
  // FCL+LCL
  Classes, SysUtils, Math, LCLProc, Forms, Controls,
-  Graphics, Dialogs, Buttons, StdCtrls,
+  Graphics, Dialogs, Buttons, StdCtrls, contnrs, IniFiles,
  // components
  SynHighlighterLFM, SynEdit, SynEditMiscClasses, LFMTrees,
  // codetools
-  BasicCodeTools, CodeCache, CodeToolManager,
+  BasicCodeTools, CodeCache, CodeToolManager, CodeToolsStructs,
  // IDE
  IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
  CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
@ -50,22 +50,28 @@ type

  TLFMFixer = class(TLFMChecker)
  private
+    fSettings: TConvertSettings;
    // References to controls in UI:
    fPropReplaceGrid: TStringGrid;
+    function ReplaceAndRemoveAll: TModalResult;
+    // Fill StringGrid with missing properties from fLFMTree.
+    procedure FillPropReplaceList;
  protected
+    procedure LoadLFM;
    function ShowRepairLFMWizard: TModalResult; override;
  public
    constructor Create(APascalBuffer, ALFMBuffer: TCodeBuffer;
                       const AOnOutput: TOnAddFilteredLine);
    destructor Destroy; override;
    function Repair: TModalResult;
+  public
+    property Settings: TConvertSettings read fSettings write fSettings;
  end;


  { TFixLFMDialog }

  TFixLFMDialog = class(TForm)
-    ReplaceAllButton: TBitBtn;
    CancelButton: TBitBtn;
    ErrorsGroupBox: TGroupBox;
    ErrorsListBox: TListBox;
@ -74,12 +80,11 @@ type
    LFMGroupBox: TGroupBox;
    LFMSynEdit: TSynEdit;
    BtnPanel: TPanel;
-    RemoveAllButton: TBitBtn;
+    ReplaceAllButton: TBitBtn;
    Splitter1: TSplitter;
    PropertyReplaceGrid: TStringGrid;
    SynLFMSyn1: TSynLFMSyn;
    procedure ErrorsListBoxClick(Sender: TObject);
-    procedure RemoveAllButtonClick(Sender: TObject);
    procedure ReplaceAllButtonClick(Sender: TObject);
    procedure LFMSynEditSpecialLineMarkup(Sender: TObject;
      Line: integer; var Special: boolean; AMarkup: TSynSelectedColor);
@ -110,6 +115,110 @@ begin
  inherited Destroy;
 end;

+function TLFMFixer.ReplaceAndRemoveAll: TModalResult;
+var
+  CurError: TLFMError;
+  TheNode: TLFMTreeNode;
+  // Property name --> replacement name.
+  PropNameRepl: THashedStringList;
+  // List of TLFMChangeEntry objects.
+  ChgEntryRepl: TObjectList;
+  OldIdent, NewIdent: string;
+  StartPos, EndPos: integer;
+  i: Integer;
+begin
+  Result:=mrNone;
+  ChgEntryRepl:=TObjectList.Create;
+  PropNameRepl:=THashedStringList.Create;
+  try
+    // Collect (maybe edited) properties from StringGrid to PropNameRepl.
+    for i:=1 to fPropReplaceGrid.RowCount-1 do begin // Skip the fixed row.
+      OldIdent:=fPropReplaceGrid.Cells[0,i];
+      NewIdent:=fPropReplaceGrid.Cells[1,i];
+      PropNameRepl.Values[OldIdent]:=NewIdent;
+    end;
+    // Replace each missing property or delete it if there is no replacement.
+    CurError:=fLFMTree.LastError;
+    while CurError<>nil do begin
+      TheNode:=CurError.FindContextNode;
+      if (TheNode<>nil) and (TheNode.Parent<>nil) then begin
+        if CurError.IsMissingObjectType then begin
+          OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
+          StartPos:=(CurError.Node as TLFMObjectNode).TypeNamePosition;
+          EndPos:=StartPos+Length(OldIdent);
+          NewIdent:=PropNameRepl.Values[OldIdent];
+          // Keep the old class name if no replacement.
+          if NewIdent<>'' then
+            AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
+        end
+        else begin
+          TheNode.FindIdentifier(StartPos,EndPos);
+          if StartPos>0 then begin
+            OldIdent:=copy(fLFMBuffer.Source,StartPos,EndPos-StartPos);
+            NewIdent:=PropNameRepl.Values[OldIdent];
+            // Delete the whole property line if no replacement.
+            if NewIdent='' then
+              FindNiceNodeBounds(TheNode,StartPos,EndPos);
+            AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
+          end;
+        end;
+      end;
+      CurError:=CurError.PrevError;
+    end;
+    if ApplyReplacements(ChgEntryRepl) then
+      Result:=mrOk;
+  finally
+    PropNameRepl.Free;
+    ChgEntryRepl.Free;
+  end;
+end;
+
+procedure TLFMFixer.FillPropReplaceList;
+var
+  CurError: TLFMError;
+  SeenPropName: TStringList;
+  OldIdent, NewIdent: string;
+  i: integer;
+begin
+  SeenPropName:=TStringList.Create;
+  try
+    fPropReplaceGrid.BeginUpdate;
+    if fLFMTree<>nil then begin
+      i:=1;
+      CurError:=fLFMTree.FirstError;
+      while CurError<>nil do begin
+        if CurError.IsMissingObjectType then begin
+          OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
+        end
+        else begin
+          OldIdent:=CurError.Node.GetIdentifier;
+        end;
+        // Add only one instance of each property name.
+        if SeenPropName.IndexOf(OldIdent)<0 then begin
+          SeenPropName.Append(OldIdent);
+          NewIdent:=fSettings.ReplaceProps[OldIdent];
+          if fPropReplaceGrid.RowCount<i+1 then
+            fPropReplaceGrid.RowCount:=i+1;
+          fPropReplaceGrid.Cells[0,i]:=OldIdent;
+          fPropReplaceGrid.Cells[1,i]:=NewIdent;
+          Inc(i);
+        end;
+        CurError:=CurError.NextError;
+      end;
+    end;
+    fPropReplaceGrid.EndUpdate;
+  finally
+    SeenPropName.Free;
+  end;
+end;
+
+procedure TLFMFixer.LoadLFM;
+begin
+  inherited LoadLFM;
+  // Fill PropertyReplaceGrid
+  FillPropReplaceList;
+end;
+
 function TLFMFixer.ShowRepairLFMWizard: TModalResult;
 var
  FixLFMDialog: TFixLFMDialog;
@ -150,18 +259,13 @@ procedure TFixLFMDialog.CheckLFMDialogCREATE(Sender: TObject);
 begin
  Caption:=lisFixLFMFile;
  Position:=poScreenCenter;
-  IDEDialogLayoutList.ApplyLayout(Self,600,400);
+//  IDEDialogLayoutList.ApplyLayout(Self,600,400);
  SetupComponents;
 end;

 procedure TFixLFMDialog.ReplaceAllButtonClick(Sender: TObject);
 begin
-  ;
-end;
-
-procedure TFixLFMDialog.RemoveAllButtonClick(Sender: TObject);
-begin
-  ModalResult:=fLfmFixer.RemoveAll;
+  ModalResult:=fLfmFixer.ReplaceAndRemoveAll;
 end;

 procedure TFixLFMDialog.ErrorsListBoxClick(Sender: TObject);
@ -182,13 +286,14 @@ end;

 procedure TFixLFMDialog.SetupComponents;
 const // Will be moved to LazarusIDEStrConsts
-  lisReplaceAllProperties = 'Replace all properties';
+  lisLFMFileContainsInvalidProperties = 'The LFM (Lazarus form) '
+    +'file contains invalid properties/classes which do not exist in LCL. '
+    +'They can be replaced or removed.';
+  lisReplaceAllProperties = 'Replace and remove invalid properties';
 begin
-  NoteLabel.Caption:=lisTheLFMLazarusFormFileContainsInvalidPropertiesThis;
+  NoteLabel.Caption:=lisLFMFileContainsInvalidProperties;
  ErrorsGroupBox.Caption:=lisErrors;
  LFMGroupBox.Caption:=lisLFMFile;
-  RemoveAllButton.Caption:=lisRemoveAllInvalidProperties;
-  RemoveAllButton.LoadGlyphFromLazarusResource('laz_delete');
  ReplaceAllButton.Caption:=lisReplaceAllProperties;
  ReplaceAllButton.LoadGlyphFromLazarusResource('laz_refresh');
  EditorOpts.GetHighlighterSettings(SynLFMSyn1);
--- a/ide/checklfmdlg.pas
+++ b/ide/checklfmdlg.pas
@ -34,7 +34,7 @@ interface
 uses
  // FCL+LCL
  Classes, SysUtils, Math, TypInfo, LCLProc, LResources, Forms, Controls,
-  Graphics, Dialogs, Buttons, StdCtrls,
+  Graphics, Dialogs, Buttons, StdCtrls, contnrs,
  // components
  SynHighlighterLFM, SynEdit, BasicCodeTools, CodeCache, CodeToolManager,
  SynEditMiscClasses, LFMTrees,
@ -49,8 +49,6 @@ type

  TLFMChecker = class
  private
-    fPascalBuffer: TCodeBuffer;
-    fLFMBuffer: TCodeBuffer;
    fOnOutput: TOnAddFilteredLine;
    fRootMustBeClassInIntf: boolean;
    fObjectsMustExists: boolean;
@ -61,6 +59,8 @@ type
    function FixMissingComponentClasses: TModalResult;
    function CheckUnit: boolean;
  protected
+    fPascalBuffer: TCodeBuffer;
+    fLFMBuffer: TCodeBuffer;
    fLFMTree: TLFMTree;
    // References to controls in UI:
    fLFMSynEdit: TSynEdit;
@ -71,6 +71,7 @@ type
    procedure FindNiceNodeBounds(LFMNode: TLFMTreeNode;
                                 var StartPos, EndPos: integer);
    function FindListBoxError: TLFMError;
+    procedure FillErrorsListBox;
    procedure JumpToError(LFMError: TLFMError);
    procedure AddReplacement(LFMChangeList: TList; StartPos, EndPos: integer;
                             const NewText: string);
@ -82,7 +83,6 @@ type
                       const AOnOutput: TOnAddFilteredLine);
    destructor Destroy; override;
    function Repair: TModalResult;
-    procedure FillErrorsListBox;
    function AutomaticFixIsPossible: boolean;
  public
    property PascalBuffer: TCodeBuffer read fPascalBuffer;
@ -560,11 +560,10 @@ var
  CurError: TLFMError;
  DeleteNode: TLFMTreeNode;
  StartPos, EndPos: integer;
-  Replacements: TList;
-  i: integer;
+  Replacements: TObjectList;
 begin
  Result:=mrNone;
-  Replacements:=TList.Create;
+  Replacements:=TObjectList.Create;
  try
    // automatically delete each error location
    CurError:=fLFMTree.LastError;
@ -579,8 +578,6 @@ begin
    if ApplyReplacements(Replacements) then
      Result:=mrOk;
  finally
-    for i := 0 to Replacements.Count - 1 do
-      TObject(Replacements[i]).Free;
    Replacements.Free;
  end;
 end;
@ -611,6 +608,29 @@ begin
  end;
 end;

+procedure TLFMChecker.FillErrorsListBox;
+var
+  CurError: TLFMError;
+  Filename: String;
+  Msg: String;
+begin
+  fErrorsListBox.Items.BeginUpdate;
+  fErrorsListBox.Items.Clear;
+  if fLFMTree<>nil then begin
+    Filename:=ExtractFileName(fLFMBuffer.Filename);
+    CurError:=fLFMTree.FirstError;
+    while CurError<>nil do begin
+      Msg:=Filename
+           +'('+IntToStr(CurError.Caret.Y)+','+IntToStr(CurError.Caret.X)+')'
+           +' Error: '
+           +CurError.ErrorMessage;
+      fErrorsListBox.Items.Add(Msg);
+      CurError:=CurError.NextError;
+    end;
+  end;
+  fErrorsListBox.Items.EndUpdate;
+end;
+
 procedure TLFMChecker.JumpToError(LFMError: TLFMError);
 begin
  if LFMError=nil then exit;
@ -696,29 +716,6 @@ begin
  Result:=true;
 end;

-procedure TLFMChecker.FillErrorsListBox;
-var
-  CurError: TLFMError;
-  Filename: String;
-  Msg: String;
-begin
-  fErrorsListBox.Items.BeginUpdate;
-  fErrorsListBox.Items.Clear;
-  if fLFMTree<>nil then begin
-    Filename:=ExtractFileName(fLFMBuffer.Filename);
-    CurError:=fLFMTree.FirstError;
-    while CurError<>nil do begin
-      Msg:=Filename
-           +'('+IntToStr(CurError.Caret.Y)+','+IntToStr(CurError.Caret.X)+')'
-           +' Error: '
-           +CurError.ErrorMessage;
-      fErrorsListBox.Items.Add(Msg);
-      CurError:=CurError.NextError;
-    end;
-  end;
-  fErrorsListBox.Items.EndUpdate;
-end;
-
 function TLFMChecker.AutomaticFixIsPossible: boolean;
 var
  CurError: TLFMError;