IDE: designer: started creating nested frames

git-svn-id: trunk@15200 -

designer/jitforms.pp

@@ -27,11 +27,6 @@
     and such stuff. Also these forms can be loaded from streams and missing
     components and methods are added just-in-time to the class definition.
     Hence the name for the class: TJITForms.
-    Subcomponents are looked up in the list of registered components
-    (TJITForms.RegCompList).
-
-  ToDo:
-    -Add recursion needed for frames.
 }
 unit JITForms;
 
@@ -48,7 +43,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, SysUtils, AvgLvlTree, TypInfo, LCLProc, LResources, Forms, Controls,
-  LCLMemManager, LCLIntf, Dialogs, JITForm, ComponentReg, IDEProcs,
+  LCLMemManager, LCLIntf, Dialogs, JITForm, IDEProcs,
   BasePkgManager;
 
 type
@@ -70,6 +65,9 @@ type
   TJITFindAncestorBinStream = procedure(Sender: TObject; AClass: TClass;
                                         var BinStream: TExtMemoryStream;
                                         var IsBaseClass, Abort: boolean) of object;
+  TJITFindClass = procedure(Sender: TObject;
+                            const ComponentClassName: string;
+                            var ComponentClass: TComponentClass) of object;
 
 
   { TJITComponentList }
@@ -85,6 +83,7 @@ type
     FCurUnknownProperty: string;
     FErrors: TLRPositionLinks;
     FOnFindAncestorBinStream: TJITFindAncestorBinStream;
+    FOnFindClass: TJITFindClass;
     FOnPropertyNotFound: TJITPropertyNotFoundEvent;
   protected
     FCurReadErrorMsg: string;
@@ -175,6 +174,7 @@ type
                              read FOnPropertyNotFound write FOnPropertyNotFound;
     property OnFindAncestorBinStream: TJITFindAncestorBinStream
                    read FOnFindAncestorBinStream write FOnFindAncestorBinStream;
+    property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass;
     property CurReadJITComponent: TComponent read FCurReadJITComponent;
     property CurReadClass: TClass read FCurReadClass;
     property CurReadChild: TComponent read FCurReadChild;
@@ -1558,19 +1558,15 @@ end;
 
 procedure TJITComponentList.ReaderFindComponentClass(Reader: TReader;
   const FindClassName: Ansistring; var ComponentClass: TComponentClass);
-var
-  RegComp: TRegisteredComponent;
 begin
   fCurReadChild:=nil;
   fCurReadChildClass:=ComponentClass;
   FCurUnknownClass:=FindClassName;
   if ComponentClass=nil then begin
-    RegComp:=IDEComponentPalette.FindComponent(FindClassName);
+    if Assigned(OnFindClass) then
-    if RegComp<>nil then begin
+      OnFindClass(Self,FindClassName,ComponentClass);
-      //debugln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
+    fCurReadChildClass:=ComponentClass;
-      //   +''' is registered');
+    if ComponentClass=nil then begin
-      ComponentClass:=RegComp.ComponentClass;
-    end else begin
       DebugLn('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
          +''' is unregistered');
       // The reader will create a ReaderError automatically

ide/checklfmdlg.pas

@@ -40,7 +40,8 @@ uses
   LFMTrees,
   // IDE
   PropEdits, IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
-  LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs, EditorOptions;
+  CustomFormEditor, LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs,
+  EditorOptions;
 
 type
   TCheckLFMDialog = class(TForm)
@@ -133,23 +134,46 @@ var
     end;
   end;
   
+  procedure FindMissingClass(ObjNode: TLFMObjectNode);
+  var
+    i: Integer;
+    AClassName: String;
+    RegComp: TRegisteredComponent;
+  begin
+    AClassName:=ObjNode.TypeName;
+    // search in already missing classes
+    if (MissingClasses<>nil) then begin
+      for i:=0 to MissingClasses.Count-1 do
+        if SysUtils.CompareText(AClassName,MissingClasses[i])=0 then
+          exit;
+    end;
+    // search in designer base classes
+    if BaseFormEditor1.FindDesignerBaseClassByName(AClassName,true)<>nil then
+      exit;
+    // search in registered classes
+    RegComp:=IDEComponentPalette.FindComponent(ObjNode.TypeName);
+    if (RegComp<>nil) and (RegComp.GetUnitName<>'') then exit;
+    // class is missing
+    DebugLn(['FindMissingClass ',ObjNode.Name,':',ObjNode.TypeName,' IsInherited=',ObjNode.IsInherited]);
+    if MissingClasses=nil then
+      MissingClasses:=TStringList.Create;
+    MissingClasses.Add(AClassName);
+  end;
+  
   procedure FindMissingClasses;
   var
     Node: TLFMTreeNode;
     ObjNode: TLFMObjectNode;
-    RegComp: TRegisteredComponent;
   begin
     Node:=LFMTree.Root;
+    if Node=nil then exit;
+    // skip root
+    Node:=Node.Next;
+    // check all other
     while Node<>nil do begin
       if Node is TLFMObjectNode then begin
         ObjNode:=TLFMObjectNode(Node);
-        RegComp:=IDEComponentPalette.FindComponent(ObjNode.TypeName);
+        FindMissingClass(ObjNode);
-        if (RegComp=nil) or (RegComp.GetUnitName='') then begin
-          DebugLn(['FindMissingClasses ',ObjNode.Name,':',ObjNode.TypeName,' IsInherited=',ObjNode.IsInherited]);
-          if MissingClasses=nil then
-            MissingClasses:=TStringList.Create;
-          MissingClasses.Add(ObjNode.TypeName);
-        end;
       end;
       Node:=Node.Next;
     end;

ide/customformeditor.pp

@@ -141,6 +141,9 @@ each control that's dropped onto the form
     procedure JITListFindAncestorBinStream(Sender: TObject; AClass: TClass;
                                            var BinStream: TExtMemoryStream;
                                            var IsBaseClass, Abort: boolean);
+    procedure JITListFindClass(Sender: TObject;
+                               const ComponentClassName: string;
+                               var ComponentClass: TComponentClass);
 
     function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
     procedure OnDesignerMenuItemClick(Sender: TObject); virtual;
@@ -251,7 +254,7 @@ each control that's dropped onto the form
     function DesignerBaseClassCount: Integer; override;
     procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
     function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
-    function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; override;
+    function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override;
 
     // define properties
     procedure FindDefineProperty(const APersistentClassName,
@@ -335,6 +338,8 @@ function TryFreeComponent(var AComponent: TComponent): boolean;
 
 procedure RegisterStandardClasses;
 
+var
+  BaseFormEditor1: TCustomFormEditor = nil;
 
 implementation
 
@@ -817,6 +822,15 @@ end;
 { TCustomFormEditor }
 
 constructor TCustomFormEditor.Create;
+
+  procedure InitJITList(List: TJITComponentList);
+  begin
+    List.OnReaderError:=@JITListReaderError;
+    List.OnPropertyNotFound:=@JITListPropertyNotFound;
+    List.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
+    List.OnFindClass:=@JITListFindClass;
+  end;
+
 var
   l: Integer;
 begin
@@ -829,14 +843,10 @@ begin
     FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
 
   JITFormList := TJITForms.Create;
-  JITFormList.OnReaderError:=@JITListReaderError;
+  InitJITList(JITFormList);
-  JITFormList.OnPropertyNotFound:=@JITListPropertyNotFound;
-  JITFormList.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
 
   JITNonFormList := TJITNonFormComponents.Create;
-  JITNonFormList.OnReaderError:=@JITListReaderError;
+  InitJITList(JITNonFormList);
-  JITNonFormList.OnPropertyNotFound:=@JITListPropertyNotFound;
-  JITNonFormList.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
 
   DesignerMenuItemClick:=@OnDesignerMenuItemClick;
   OnGetDesignerForm:=@GetDesignerForm;
@@ -1781,10 +1791,20 @@ begin
 end;
 
 function TCustomFormEditor.FindDesignerBaseClassByName(
-  const AClassName: shortstring): TComponentClass;
+  const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
 var
   i: Integer;
 begin
+  if WithDefaults then begin
+    for i:=Low(StandardDesignerBaseClasses) to high(StandardDesignerBaseClasses)
+    do begin
+      if CompareText(AClassName,StandardDesignerBaseClasses[i].ClassName)=0 then
+      begin
+        Result:=StandardDesignerBaseClasses[i];
+        exit;
+      end;
+    end;
+  end;
   for i:=FDesignerBaseClasses.Count-1 downto 0 do begin
     Result:=DesignerBaseClasses[i];
     if CompareText(Result.ClassName,AClassName)=0 then exit;
@@ -1861,12 +1881,12 @@ var
       if APersistent<>nil then
         debugln('TCustomFormEditor.GetDefineProperties ComponentClass ',
           AClassName,' is a resource,'
-          +' but inheriting design is not yet implemented');
+          +' but inheriting design properties is not yet implemented');
     end;
 
     // try default classes
     if (APersistent=nil) then begin
-      AncestorClass:=FindDesignerBaseClassByName(AClassName);
+      AncestorClass:=FindDesignerBaseClassByName(AClassName,true);
       if AncestorClass<>nil then begin
         if not CreateTempPersistent(AncestorClass) then exit;
       end;
@@ -2106,6 +2126,35 @@ begin
   end;
 end;
 
+procedure TCustomFormEditor.JITListFindClass(Sender: TObject;
+  const ComponentClassName: string; var ComponentClass: TComponentClass);
+var
+  AnUnitInfo: TUnitInfo;
+  Component: TComponent;
+  RegComp: TRegisteredComponent;
+begin
+  DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
+  RegComp:=IDEComponentPalette.FindComponent(ComponentClassName);
+  if RegComp<>nil then begin
+    //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
+    ComponentClass:=RegComp.ComponentClass;
+  end else begin
+    // ToDo: search only in reachable forms
+    AnUnitInfo:=Project1.FirstUnitWithComponent;
+    while AnUnitInfo<>nil do begin
+      Component:=AnUnitInfo.Component;
+      if SysUtils.CompareText(Component.ClassName,ComponentClassName)=0 then
+      begin
+        DebugLn(['TCustomFormEditor.JITListFindClass found nested class '+DbgSName(Component)+' in unit '+AnUnitInfo.Filename]);
+        ComponentClass:=TComponentClass(Component.ClassType);
+        break;
+      end;
+      AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
+    end;
+  end;
+  DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' Class=',DbgSName(ComponentClass)]);
+end;
+
 function TCustomFormEditor.GetDesignerBaseClasses(Index: integer
   ): TComponentClass;
 begin

ide/formeditor.pp

@@ -59,6 +59,7 @@ procedure CreateFormEditor;
 begin
   if FormEditor1=nil then begin
     FormEditor1 := TFormEditor.Create;
+    BaseFormEditor1 := FormEditor1;
     FormEditingHook := FormEditor1;
     IDECmdScopeDesignerOnly.AddWindowClass(TDesignerIDECommandForm);
   end;
@@ -70,6 +71,7 @@ begin
   FormEditingHook:=nil;
   FormEditor1.Free;
   FormEditor1:=nil;
+  BaseFormEditor1 := nil;
 end;
 
 procedure TFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg);

ide/main.pp

@@ -5368,6 +5368,10 @@ var
   LCLVersion: string;
   MissingClasses: TStrings;
   LFMComponentName: string;
+  i: Integer;
+  NestedClassName: string;
+  NestedClass: TComponentClass;
+  NestedUnitInfo: TUnitInfo;
 begin
   debugln('TMainIDE.DoLoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
 
@@ -5424,11 +5428,38 @@ begin
         exit;
       end;
 
-      BinStream:=nil;
+      // load missing component classes (e.g. ancestor and frames)
-      try
       Result:=DoLoadAncestorDependencyHidden(AnUnitInfo,NewClassName,OpenFlags,
                                              AncestorType,AncestorUnitInfo);
+      if Result<>mrOk then begin
+        DebugLn(['TMainIDE.DoLoadLFM DoLoadAncestorDependencyHidden failed for ',AnUnitInfo.Filename]);
+        exit;
+      end;
+      if MissingClasses<>nil then begin
+        for i:=MissingClasses.Count-1 downto 0 do begin
+          {$IFNDEF EnableTFrame}
+          if i>=0 then continue;// just skip
+          {$ENDIF}
+          NestedClassName:=MissingClasses[i];
+          if SysUtils.CompareText(NestedClassName,AncestorType.ClassName)=0 then
+          begin
+            MissingClasses.Delete(i);
+          end else begin
+            DebugLn(['TMainIDE.DoLoadLFM loading nested class ',NestedClassName,' needed by ',AnUnitInfo.Filename]);
+            NestedClass:=nil;
+            NestedUnitInfo:=nil;
+            Result:=DoLoadComponentDependencyHidden(AnUnitInfo,NestedClassName,
+                                     OpenFlags,true,NestedClass,NestedUnitInfo);
+            if Result<>mrOk then begin
+              DebugLn(['TMainIDE.DoLoadLFM DoLoadComponentDependencyHidden NestedClassName=',NestedClassName,' failed for ',AnUnitInfo.Filename]);
+              exit;
+            end;
+          end;
+        end;
+      end;
 
+      BinStream:=nil;
+      try
         // convert text to binary format
         BinStream:=TExtMemoryStream.Create;
         TxtLFMStream:=TExtMemoryStream.Create;
@@ -5555,13 +5586,7 @@ function TMainIDE.FindBaseComponentClass(const AComponentClassName,
 begin
   // find the ancestor class
   if AComponentClassName<>'' then begin
-    if CompareText(AComponentClassName,'TForm')=0 then begin
+    if (DescendantClassName<>'')
-      AComponentClass:=TForm;
-    end else if CompareText(AComponentClassName,'TDataModule')=0 then begin
-      AComponentClass:=TDataModule;
-    end else if CompareText(AComponentClassName,'TFrame')=0 then begin
-      AComponentClass:=TFrame;
-    end else if (DescendantClassName<>'')
     and (CompareText(AComponentClassName,'TCustomForm')=0) then begin
       // this is a common user mistake
       MessageDlg(lisCodeTemplError, Format(
@@ -5581,7 +5606,7 @@ begin
       exit;
     end else begin
       // search in the registered base classes
-      AComponentClass:=FormEditor1.FindDesignerBaseClassByName(AComponentClassName);
+      AComponentClass:=FormEditor1.FindDesignerBaseClassByName(AComponentClassName,true);
     end;
   end else begin
     // default is TForm
@@ -5784,7 +5809,7 @@ begin
     AncestorClass) then
   begin
     DebugLn(['TMainIDE.DoLoadAncestorDependencyHidden FindUnitComponentClass failed for AncestorClassName=',AncestorClassName]);
-    exit;
+    exit(mrCancel);
   end;
 
   // try loading the ancestor first (unit, lfm and component instance)
@@ -5814,6 +5839,7 @@ begin
   if AncestorClass=nil then
     AncestorClass:=TForm;
   //DebugLn('TMainIDE.DoLoadAncestorDependencyHidden Filename="',AnUnitInfo.Filename,'" AncestorClassName=',AncestorClassName,' AncestorClass=',dbgsName(AncestorClass));
+  Result:=mrOk;
 end;
 
 function TMainIDE.DoLoadComponentDependencyHidden(AnUnitInfo: TUnitInfo;
@@ -5949,7 +5975,7 @@ var
       end;
     end;
 
-    debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' Loading ancestor unit ',UnitFilename);
+    debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' Loading referenced form ',UnitFilename);
     // load unit source
     TheModalResult:=LoadCodeBuffer(UnitCode,UnitFilename,[lbfCheckIfText]);
     if TheModalResult<>mrOk then begin
@@ -5987,7 +6013,7 @@ var
   begin
     Result:=false;
     AComponentClass:=
-                   FormEditor1.FindDesignerBaseClassByName(AComponentClassName);
+              FormEditor1.FindDesignerBaseClassByName(AComponentClassName,true);
     if AComponentClass<>nil then begin
       DebugLn(['TMainIDE.DoLoadComponentDependencyHidden.TryRegisteredClasses found: ',AComponentClass.ClassName]);
       TheModalResult:=mrOk;

ideintf/formeditingintf.pas

@@ -126,7 +126,7 @@ type
     property DesignerBaseClasses[Index: integer]: TComponentClass read GetDesignerBaseClasses;
     procedure UnregisterDesignerBaseClass(AClass: TComponentClass); virtual; abstract;
     function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
-    function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; virtual; abstract;
+    function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; virtual; abstract;
 
     // designers
     function DesignerCount: integer; virtual; abstract;