Converter: add needed units to uses section automatically. A class in LCL can be in a different unit than in VCL. Issue #23900

git-svn-id: trunk@40558 -

converter/convertdelphi.pas

@@ -672,7 +672,7 @@ begin
       LfmFixer.RootMustBeClassInUnit:=true;
       LfmFixer.RootMustBeClassInIntf:=true;
       LfmFixer.ObjectsMustExist:=true;
-      if LfmFixer.Repair<>mrOk then begin
+      if LfmFixer.ConvertAndRepair<>mrOk then begin
         LazarusIDE.DoJumpToCompilerMessage(-1,true);
         fOwnerConverter.fErrorMsg:='Problems when repairing form file '
                                   +fOrigUnitFilename;

converter/missingpropertiesdlg.pas

@@ -42,7 +42,7 @@ uses
   // IDE
   IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf, DialogProcs,
   CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
-  EditorOptions, CheckLFMDlg, IDEMsgIntf,
+  EditorOptions, CheckLFMDlg, IDEMsgIntf, Project,
   // Converter
   ConverterTypes, ConvertSettings, ReplaceNamesUnit,
   ConvCodeTool, FormFileConv, UsedUnits;
@@ -83,14 +83,15 @@ type
     function AddNewProps(aNewProps: TList): TModalResult;
     // Fill StringGrids with missing properties and types from fLFMTree.
     procedure FillReplaceGrids;
+    function ShowConvertLFMWizard: TModalResult;
   protected
+    function FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult; override;
     procedure LoadLFM;
-    function ShowRepairLFMWizard: TModalResult; override;
   public
     constructor Create(ACTLink: TCodeToolLink; ALFMBuffer: TCodeBuffer;
                        const AOnOutput: TOnAddFilteredLine);
     destructor Destroy; override;
-    function Repair: TModalResult;
+    function ConvertAndRepair: TModalResult;
   public
     property Settings: TConvertSettings read fSettings write fSettings;
     property UsedUnitsTool: TUsedUnitsTool read fUsedUnitsTool write fUsedUnitsTool;
@@ -311,11 +312,6 @@ begin
             AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
             IDEMessagesWindow.AddMsg(Format(
                       'Replaced type "%s" with "%s".',[OldIdent, NewIdent]),'',-1);
-            if Assigned(fUsedUnitsTool) then begin
-              // ToDo: This is a test and will be replaced by configurable unit names.
-              if NewIdent='TRichMemo' then
-                fUsedUnitsTool.AddUnitIfNeeded('RichMemo');
-            end;
             Result:=mrRetry;
           end;
         end
@@ -436,13 +432,7 @@ begin
   end;
 end;
 
-procedure TLFMFixer.LoadLFM;
+function TLFMFixer.ShowConvertLFMWizard: TModalResult;
-begin
-  inherited LoadLFM;
-  FillReplaceGrids;         // Fill both ReplaceGrids.
-end;
-
-function TLFMFixer.ShowRepairLFMWizard: TModalResult;
 var
   FixLFMDialog: TFixLFMDialog;
   PrevCursor: TCursor;
@@ -473,7 +463,44 @@ begin
   end;
 end;
 
-function TLFMFixer.Repair: TModalResult;
+function TLFMFixer.FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult;
+// This is called from TLFMChecker.FindAndFixMissingComponentClasses.
+// Add needed units to uses section using methods already defined in fUsedUnitsTool.
+var
+  RegComp: TRegisteredComponent;
+  ClassUnitInfo: TUnitInfo;
+  i: Integer;
+  CompClassName, NeededUnitName: String;
+begin
+  Result:=mrOK;
+  if not Assigned(fUsedUnitsTool) then Exit;
+  for i := 0 to aMissingTypes.Count-1 do begin
+    CompClassName := aMissingTypes[i];
+    RegComp:=IDEComponentPalette.FindComponent(CompClassName);
+    NeededUnitName:='';
+    if (RegComp<>nil) then begin
+      if RegComp.ComponentClass<>nil then begin
+        NeededUnitName:=RegComp.ComponentClass.UnitName;
+        if NeededUnitName='' then
+          NeededUnitName:=RegComp.GetUnitName;
+      end;
+    end else begin
+      ClassUnitInfo:=Project1.UnitWithComponentClassName(CompClassName);
+      if ClassUnitInfo<>nil then
+        NeededUnitName:=ClassUnitInfo.Unit_Name;
+    end;
+    if NeededUnitName<>'' then
+      fUsedUnitsTool.AddUnitIfNeeded(NeededUnitName);
+  end;
+end;
+
+procedure TLFMFixer.LoadLFM;
+begin
+  inherited LoadLFM;
+  FillReplaceGrids;         // Fill both ReplaceGrids.
+end;
+
+function TLFMFixer.ConvertAndRepair: TModalResult;
 var
   ConvTool: TConvDelphiCodeTool;
   FormFileTool: TFormFileConverter;
@@ -499,13 +526,24 @@ begin
         fRootMustBeClassInUnit, fRootMustBeClassInIntf, fObjectsMustExist) then
       Result:=mrOk
     else                     // Rename/remove properties and types interactively.
-      Result:=ShowRepairLFMWizard;  // Can return mrRetry.
+      Result:=ShowConvertLFMWizard;  // Can return mrRetry.
     Inc(LoopCount);
   until (Result in [mrOK, mrCancel]) or (LoopCount=10);
-  // Show remaining errors to user.
+
-  WriteLFMErrors;
+  // Check for missing object types and add units as needed.
-  if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin
+  if not fLFMTree.ParseIfNeeded then
+    Exit(mrCancel);
+  if CodeToolBoss.CheckLFM(fPascalBuffer, fLFMBuffer, fLFMTree,
+      fRootMustBeClassInUnit, fRootMustBeClassInIntf, fObjectsMustExist) then
+    Result:=mrOk
+  else begin
+    Result:=FindAndFixMissingComponentClasses;
+    if Result = mrCancel then  // Returns mrCancel when nothing was done.
+      Result := mrOK;
+  end;
+
   // Fix top offsets of some components in visual containers
+  if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin
     FormFileTool:=TFormFileConverter.Create(fCTLink, fLFMBuffer);
     SrcCoordOffs:=TObjectList.Create;
     SrcNewProps:=TObjectList.Create;

ide/checklfmdlg.pas

@@ -49,10 +49,10 @@ type
   TLFMChecker = class
   private
     fOnOutput: TOnAddFilteredLine;
-    procedure WriteUnitError(Code: TCodeBuffer; X, Y: integer;
+    procedure WriteUnitError(Code: TCodeBuffer; X, Y: integer; const ErrorMessage: string);
-      const ErrorMessage: string);
     procedure WriteCodeToolsError;
     function CheckUnit: boolean;
+    function ShowRepairLFMWizard: TModalResult; // Show the interactive user interface.
   protected
     fPascalBuffer: TCodeBuffer;
     fLFMBuffer: TCodeBuffer;
@@ -70,14 +70,13 @@ type
                                  var StartPos, EndPos: integer);
     function FindListBoxError: TLFMError;
     procedure WriteLFMErrors;
-    function FixMissingComponentClasses: TModalResult;
+    function FindAndFixMissingComponentClasses: TModalResult;
+    function FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult; virtual;
     procedure FillErrorsListBox;
     procedure JumpToError(LFMError: TLFMError);
     procedure AddReplacement(LFMChangeList: TObjectList; StartPos, EndPos: integer;
                              const NewText: string);
     function ApplyReplacements(LFMChangeList: TList): boolean;
-    // Show the interactive user interface.
-    function ShowRepairLFMWizard: TModalResult; virtual;
   public
     constructor Create(APascalBuffer, ALFMBuffer: TCodeBuffer;
                        const AOnOutput: TOnAddFilteredLine);
@@ -426,7 +425,7 @@ begin
     Result:=mrOk;
     exit;
   end;
-  Result:=FixMissingComponentClasses;
+  Result:=FindAndFixMissingComponentClasses;
   if Result in [mrAbort,mrOk] then exit;
   WriteLFMErrors;
   Result:=ShowRepairLFMWizard;
@@ -480,7 +479,7 @@ begin
   Application.ProcessMessages;
 end;
 
-function TLFMChecker.FixMissingComponentClasses: TModalResult;
+function TLFMChecker.FindAndFixMissingComponentClasses: TModalResult;
 // returns true, if after adding units to uses section all errors are fixed
 var
   CurError: TLFMError;
@@ -501,8 +500,7 @@ begin
           MissingObjectTypes.Add(TypeName);
       end;
       CurError:=CurError.NextError;
-    end;
+    end;                                    // Missing object types in unit.
-    // Missing object types in unit.
 
     // keep all object types with a registered component class
     for i:=MissingObjectTypes.Count-1 downto 0 do begin
@@ -513,9 +511,17 @@ begin
     if MissingObjectTypes.Count=0 then exit;
     // Missing object types, but luckily found in IDE.
 
-    // there are missing object types with registered component classes
+    Result:=FixMissingComponentClasses(MissingObjectTypes); // Fix them.
+  finally
+    MissingObjectTypes.Free;
+  end;
+end;
+
+function TLFMChecker.FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult;
+begin
+  // add units for the missing object types with registered component classes
   Result:=PackageEditingInterface.AddUnitDependenciesForComponentClasses(
-         fPascalBuffer.Filename,MissingObjectTypes);
+       fPascalBuffer.Filename, aMissingTypes);
   if Result<>mrOk then exit;
 
   // check LFM again
@@ -526,9 +532,6 @@ begin
   end else begin
     Result:=mrCancel;
   end;
-  finally
-    MissingObjectTypes.Free;
-  end;
 end;
 
 function TLFMChecker.CheckUnit: boolean;
@@ -537,7 +540,6 @@ var
   NewX, NewY, NewTopLine: integer;
   ErrorMsg: string;
   MissingUnits: TStrings;
-  s: String;
 begin
   Result:=false;
   // check syntax
@@ -555,8 +557,8 @@ begin
       exit;
     end;
     if (MissingUnits<>nil) and (MissingUnits.Count>0) then begin
-      s:=StringListToText(MissingUnits,',');
+      ErrorMsg:=StringListToText(MissingUnits,',');
-      WriteUnitError(fPascalBuffer,1,1,'Units not found: '+s);
+      WriteUnitError(fPascalBuffer,1,1,'Units not found: '+ErrorMsg);
       exit;
     end;
   finally
@@ -704,7 +706,7 @@ begin
   end;
 end;
 
-function TLFMChecker.ApplyReplacements(LfmChangeList: TList): boolean;
+function TLFMChecker.ApplyReplacements(LFMChangeList: TList): boolean;
 var
   i: Integer;
   Entry: TLFMChangeEntry;