deactivated FCL TDataModule

git-svn-id: trunk@4408 -
2025-04-09 19:08:03 +02:00 · 2003-07-14 09:03:39 +00:00 · 2003-07-14 09:03:39 +00:00 · c4156a9592
commit c4156a9592
parent 9d4d13de9c
6 changed files with 104 additions and 86 deletions
--- a/designer/jitform/jitform.pas
+++ b/designer/jitform/jitform.pas
@ -43,9 +43,9 @@ uses
 type
  // TJITForm is a template TForm descendent class that can be altered at
  // runtime
-  TJITForm = class (TForm)
+  TJITForm = class(TForm)
  protected
-    class function NewInstance : TObject; override;
+    class function NewInstance: TObject; override;
  public
  end;

@ -54,9 +54,9 @@ type

  // TJITDataModule is a template TDataModule descendent class that can be
  // altered at runtime
-  TJITDataModule = class (TDataModule)
+  TJITDataModule = class(TDataModule)
  protected
-    class function NewInstance : TObject; override;
+    class function NewInstance: TObject; override;
    procedure ValidateRename(AComponent: TComponent;
                             const CurName, NewName: string); override;
  public
@ -72,6 +72,8 @@ type
    procedure DoNothing;
  end;
  
+  TJITClass = class of TPersistent;
+  

 implementation

@ -89,14 +91,6 @@ begin
  AComponent.SetDesigning(Value);
 end;

-{ TJITForm }
-
-function TJITForm.NewInstance: TObject;
-begin
-  Result:=inherited NewInstance;
-  TSetDesigningComponent.SetDesigningOfControl(TComponent(Result),true);
-end;
-
 { TPersistentWithTemplates }

 procedure TPersistentWithTemplates.DoNothing;
@ -105,6 +99,14 @@ begin
  // !!! do not write any code in here !!!
 end;

+{ TJITForm }
+
+function TJITForm.NewInstance: TObject;
+begin
+  Result:=inherited NewInstance;
+  TSetDesigningComponent.SetDesigningOfControl(TComponent(Result),true);
+end;
+
 { TJITDataModule }

 function TJITDataModule.NewInstance: TObject;
--- a/designer/jitforms.pp
+++ b/designer/jitforms.pp
@ -39,6 +39,8 @@ unit JITForms;

 {$I ide.inc}

+{ $DEFINE VerboseJITForms}
+
 interface

 uses
@ -89,10 +91,10 @@ type
    procedure FreevmtCopy(vmtCopy: Pointer);
    procedure DoAddNewMethod(JITClass:TClass;
                             const AName:ShortString; ACode:Pointer);
-      // AddNewMethod does not check if method already exists
+      // Note: AddNewMethod does not check if method already exists
    procedure DoRemoveMethod(JITClass:TClass; AName:ShortString;
                             var OldCode:Pointer);
-      // RemoveMethod does not free code memory
+      // Note: RemoveMethod does not free code memory
    procedure DoRenameMethod(JITClass:TClass; OldName,NewName:ShortString);
    procedure DoRenameClass(JITClass:TClass; const NewName:ShortString);
    // TReader events
@ -146,6 +148,7 @@ type
      BinStream: TStream; ComponentClass: TComponentClass;
      ParentControl: TWinControl): TComponent;
  public
+    BaseJITClass: TJITClass;
    property OnReaderError: TJITReaderErrorEvent
                                       read FOnReaderError write FOnReaderError;
    property CurReadJITComponent:TComponent read FCurReadJITComponent;
@ -164,7 +167,6 @@ type
  private
    function GetItem(Index: integer): TForm;
  protected
-    procedure DoFinishReading; override;
    function CreateDefaultVMTCopy: Pointer; override;
  public
    constructor Create;
@ -305,11 +307,11 @@ end;
 function TJITComponentList.AddNewJITComponent:integer;
 var NewComponentName,NewClassName:shortstring;
 begin
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  Writeln('[TJITComponentList] AddNewJITComponent');
  {$ENDIF}
  GetUnusedNames(NewComponentName,NewClassName);
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  Writeln('NewComponentName is ',NewComponentName,', NewClassName is ',NewClassName);
  {$ENDIF}
  Result:=DoCreateJITComponent(NewComponentName,NewClassName);
@ -332,18 +334,18 @@ begin

    exit;
  end;
-  {$IFDEF IDE_VERBOSE}
-  writeln('[TJITComponentList.AddJITFormFromStream] 1');
+  {$IFDEF VerboseJITForms}
+  writeln('[TJITComponentList.AddJITComponentFromStream] Create ...');
  {$ENDIF}
  try
    Result:=DoCreateJITComponent('',NewClassName);
-    {$IFDEF IDE_VERBOSE}
-    writeln('[TJITComponentList.AddJITFormFromStream] 2');
+    {$IFDEF VerboseJITForms}
+    writeln('[TJITComponentList.AddJITComponentFromStream] InitReading ...');
    {$ENDIF}

    InitReading(BinStream,Reader);
-    {$IFDEF IDE_VERBOSE}
-    writeln('[TJITComponentList.AddJITFormFromStream] 3');
+    {$IFDEF VerboseJITForms}
+    writeln('[TJITComponentList.AddJITComponentFromStream] Read ...');
    {$ENDIF}
    try
      Reader.ReadRootComponent(FCurReadJITComponent);
@ -354,8 +356,8 @@ begin
        FCurReadJITComponent.Name:=NewName;
      end;

-      {$IFDEF IDE_VERBOSE}
-      writeln('[TJITComponentList.AddJITFormFromStream] 5');
+      {$IFDEF VerboseJITForms}
+      writeln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...');
      {$ENDIF}
      DoFinishReading;
    finally
@ -385,7 +387,7 @@ begin
  MyFindGlobalComponentProc:=@OnFindGlobalComponent;
  FindGlobalComponent:=@MyFindGlobalComponent;

-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.InitReading] A');
  {$ENDIF}
  // connect TReader events
@ -397,7 +399,7 @@ begin
  Reader.OnCreateComponent:=@ReaderCreateComponent;
  Reader.OnFindComponentClass:=@ReaderFindComponentClass;

-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.InitReading] B');
  {$ENDIF}

@ -452,6 +454,9 @@ procedure TJITComponentList.RemoveMethod(JITComponent:TComponent;
  const AName:ShortString);
 var OldCode:Pointer;
 begin
+  {$IFDEF VerboseJITForms}
+  writeln('TJITComponentList.RemoveMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
+  {$ENDIF}
  if JITComponent=nil then
    raise Exception.Create('TJITComponentList.RemoveMethod JITComponent=nil');
  if IndexOf(JITComponent)<0 then
@ -467,6 +472,9 @@ end;
 procedure TJITComponentList.RenameMethod(JITComponent:TComponent;
  const OldName,NewName:ShortString);
 begin
+  {$IFDEF VerboseJITForms}
+  writeln('TJITComponentList.RenameMethod ',JITComponent.Name,':',JITComponent.Name,' Old=',OldName,' NewName=',NewName);
+  {$ENDIF}
  if JITComponent=nil then
    raise Exception.Create('TJITComponentList.RenameMethod JITComponent=nil');
  if IndexOf(JITComponent)<0 then
@ -480,6 +488,9 @@ end;
 procedure TJITComponentList.RenameComponentClass(JITComponent:TComponent;
  const NewName:ShortString);
 begin
+  {$IFDEF VerboseJITForms}
+  writeln('TJITComponentList.RenameComponentClass ',JITComponent.Name,':',JITComponent.Name,' New=',NewName);
+  {$ENDIF}
  if JITComponent=nil then
    raise Exception.Create('TJITComponentList.RenameComponentClass JITComponent=nil');
  if IndexOf(JITComponent)<0 then
@ -501,12 +512,12 @@ begin
  NewComponent:=nil;
  if IndexOf(JITOwnerComponent)<0 then
    RaiseException('TJITComponentList.AddJITChildComponentFromStream');
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.AddJITChildComponentFromStream] A');
  {$ENDIF}
  try
    InitReading(BinStream,Reader);
-    {$IFDEF IDE_VERBOSE}
+    {$IFDEF VerboseJITForms}
    writeln('[TJITComponentList.AddJITChildComponentFromStream] B');
    {$ENDIF}
    try
@ -514,7 +525,7 @@ begin
      FCurReadClass:=JITOwnerComponent.ClassType;

      FFlags:=FFlags+[jclAutoRenameComponents];
-      {$IFDEF IDE_VERBOSE}
+      {$IFDEF VerboseJITForms}
      writeln('[TJITComponentList.AddJITChildComponentFromStream] C1 ',ComponentClass.ClassName);
      {$ENDIF}
      Reader.Root := FCurReadJITComponent;
@ -530,7 +541,7 @@ begin
      end;
      writeln('[TJITComponentList.AddJITChildComponentFromStream] C6 ');

-      {$IFDEF IDE_VERBOSE}
+      {$IFDEF VerboseJITForms}
      writeln('[TJITComponentList.AddJITChildComponentFromStream] D');
      {$ENDIF}
      DoFinishReading;
@ -553,6 +564,9 @@ var CodeTemplate,NewCode:Pointer;
  CodeSize:integer;
  OldCode: Pointer;
 begin
+  {$IFDEF VerboseJITForms}
+  writeln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
+  {$ENDIF}
  if JITComponent=nil then
    raise Exception.Create('TJITComponentList.CreateNewMethod JITComponent=nil');
  if IndexOf(JITComponent)<0 then
@ -602,7 +616,7 @@ end;
 function TJITComponentList.CreateVMTCopy(SourceClass:TClass;
  const NewClassName:ShortString):Pointer;
 const
-  vmtSize:integer=2000; //XXX how big is the vmt of class TJITForm ?
+  vmtSize:integer=5000; //XXX how big is the vmt of class TJITForm ?
 var MethodTable, NewMethodTable : PMethodNameTable;
  MethodTableSize: integer;
  ClassNamePtr, ClassNamePShortString: Pointer;
@ -639,7 +653,7 @@ procedure TJITComponentList.FreevmtCopy(vmtCopy:Pointer);
    CurMethod: TMethodNameRec;
  begin
    if MethodTable=nil then exit;
-    BaseMethodTable:=PMethodNameTable((Pointer(TJITForm)+vmtMethodTable)^);
+    BaseMethodTable:=PMethodNameTable((Pointer(BaseJITClass)+vmtMethodTable)^);
    if Assigned(BaseMethodTable) then
      BaseCount:=BaseMethodTable^.Count
    else
@ -661,7 +675,9 @@ var
  MethodTable : PMethodNameTable;
  ClassNamePtr: Pointer;
 begin
-  //writeln('[TJITComponentList.FreevmtCopy] ClassName='''+TClass(vmtCopy).ClassName+'''');
+  {$IFDEF VerboseJITForms}
+  writeln('[TJITComponentList.FreevmtCopy] ClassName='''+TClass(vmtCopy).ClassName+'''');
+  {$ENDIF}
  if vmtCopy=nil then exit;
  // free copy of methodtable
  MethodTable:=PMethodNameTable((Pointer(vmtCopy)+vmtMethodTable)^);
@ -717,11 +733,12 @@ end;

 procedure TJITComponentList.DoRemoveMethod(JITClass:TClass;
  AName:ShortString; var OldCode:Pointer);
+// Note: does not free OldCode
 var OldMethodTable, NewMethodTable: PMethodNameTable;
  NewMethodTableSize:integer;
  a:cardinal;
 begin
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.DoRemoveMethod] '''+JITClass.ClassName+'.'+AName+'''');
  {$ENDIF}
  AName:=uppercase(AName);
@ -736,13 +753,13 @@ begin
        FreeMem(OldMethodTable^.Entries[a].Name);
        if OldMethodTable^.Count>0 then begin
          NewMethodTableSize:=SizeOf(DWord)+
-                     OldMethodTable^.Count*SizeOf(TMethodNameRec);
+                              OldMethodTable^.Count*SizeOf(TMethodNameRec);
          GetMem(NewMethodTable,NewMethodTableSize);
          NewMethodTable^.Count:=OldMethodTable^.Count-1;
-          Move(OldMethodTable^,NewMethodTable^,SizeOf(DWord)+
-                                                     a*SizeOf(TMethodNameRec));
+          Move(OldMethodTable^,NewMethodTable^,
+               SizeOf(DWord)+a*SizeOf(TMethodNameRec));
          Move(OldMethodTable^.Entries[a],NewMethodTable^.Entries[a+1],
-                 SizeOf(DWord)+a*SizeOf(TMethodNameRec));
+               SizeOf(DWord)+a*SizeOf(TMethodNameRec));
        end else begin
          NewMethodTable:=nil;
        end;
@ -761,7 +778,7 @@ procedure TJITComponentList.DoRenameMethod(JITClass:TClass;
 var MethodTable: PMethodNameTable;
  a:integer;
 begin
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.DoRenameMethod] ClassName='''+JITClass.ClassName+''''
    +' OldName='''+OldName+''' NewName='''+OldName+'''');
  {$ENDIF}
@ -778,7 +795,7 @@ end;
 procedure TJITComponentList.DoRenameClass(JITClass:TClass;
  const NewName:ShortString);
 begin
-  {$IFDEF IDE_VERBOSE}
+  {$IFDEF VerboseJITForms}
  writeln('[TJITComponentList.DoRenameClass] OldName='''+JITClass.ClassName
    +''' NewName='''+NewName+''' ');
  {$ENDIF}
@ -924,6 +941,7 @@ constructor TJITForms.Create;
 begin
  inherited Create;
  FComponentPrefix:='Form';
+  BaseJITClass:=TJITForm;
 end;

 function TJITForms.IsJITForm(AComponent: TComponent): boolean;
@ -942,32 +960,6 @@ begin
  Result:=CreateVMTCopy(TJITForm,'TJITForm');
 end;

-procedure TJITForms.DoFinishReading;
-
-{  procedure ApplyVisible;
-  var
-    i: integer;
-    AControl: TControl;
-  begin
-    // The LCL has as default Visible=false. But for Delphi compatibility
-    // loading control defaults to true.
-    for i:=0 to FCurReadJITComponent.ComponentCount-1 do begin
-      AControl:=TControl(FCurReadJITComponent.Components[i]);
-      if (AControl is TControl) then begin
-        if (not (csVisibleSetInLoading in AControl.ControlState)) then
-          AControl.Visible:=true
-        else
-          AControl.ControlState:=
-            AControl.ControlState-[csVisibleSetInLoading];
-      end;
-    end;
-  end;}
-
-begin
-  inherited DoFinishReading;
-  //ApplyVisible;
-end;
-

 { TJITDataModules }

@ -985,6 +977,7 @@ constructor TJITDataModules.Create;
 begin
  inherited Create;
  FComponentPrefix:='DataModule';
+  BaseJITClass:=TJITDataModule;
 end;

 function TJITDataModules.IsJITDataModule(AComponent: TComponent): boolean;
--- a/ide/editdefinetree.pas
+++ b/ide/editdefinetree.pas
@ -86,8 +86,11 @@ implementation

 function FindPackagesTemplate: TDefineTemplate;
 begin
-  Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
-    PackagesDefTemplName,true);
+  if (CodeToolBoss<>nil) then
+    Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
+      PackagesDefTemplName,true)
+  else
+    Result:=nil;
 end;

 function FindPackageTemplateWithID(const PkgID: string): TDefineTemplate;
@ -103,8 +106,11 @@ end;

 function FindCurrentProjectTemplate: TDefineTemplate;
 begin
-  Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
-                                                      ProjectDefTemplName,true);
+  if (CodeToolBoss<>nil) then
+    Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
+                                                      ProjectDefTemplName,true)
+  else
+    Result:=nil;
 end;

 function CreateProjectTemplate(var ProjectDirTemplate: TDefineTemplate
@ -113,8 +119,12 @@ var
  ProjectDir, ProjectSrcPath, ProjectIncPath,
  ProjectUnitPath: TDefineTemplate;
 begin
+  if (CodeToolBoss=nil) then begin
+    Result:=nil;
+    exit;
+  end;
  Result:=FindCurrentProjectTemplate;
-  if Result<>nil then begin
+  if (Result<>nil) then begin
    ProjectDirTemplate:=Result.FindChildByName(ProjectDirDefTemplName);
    exit;
  end;
--- a/ide/main.pp
+++ b/ide/main.pp
@ -883,6 +883,8 @@ begin

  // free project, if it is still there
  FreeThenNil(Project1);
+  
+  // free IDE parts
  FreeThenNil(FormEditor1);
  FreeThenNil(PkgBoss);
  FreeThenNil(GlobalDesignHook);
@ -890,6 +892,7 @@ begin
  FreeThenNil(HiddenWindowsOnRun);
  FreeThenNil(TheOutputFilter);
  FreeThenNil(MacroList);
+  // IDE options objects
  FreeThenNil(CodeToolsOpts);
  FreeThenNil(MiscellaneousOptions);
  FreeThenNil(EditorOpts);
@ -9351,6 +9354,9 @@ end.

 { =============================================================================
  $Log$
+  Revision 1.624  2003/07/14 09:03:39  mattias
+  deactivated FCL TDataModule
+
  Revision 1.623  2003/07/12 09:11:28  mattias
  updated build scripts

--- a/ide/project.pp
+++ b/ide/project.pp
@ -2589,7 +2589,8 @@ end;
 procedure TProjectDefineTemplates.Clear;
 begin
  if FMain<>nil then begin
-    CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
+    if CodeToolBoss<>nil then
+      CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
    FMain:=nil;
    FProjectDir:=nil;
    FFlags:=FFlags+[ptfFlagsChanged];
@ -2667,6 +2668,9 @@ end.

 {
  $Log$
+  Revision 1.132  2003/07/14 09:03:39  mattias
+  deactivated FCL TDataModule
+
  Revision 1.131  2003/07/08 17:30:19  mattias
  fixed changing widget set and TStringGrid exceptions on ColCount=0

--- a/lcl/forms.pp
+++ b/lcl/forms.pp
@ -34,8 +34,10 @@ interface
 {$ASSERTIONS ON}
 {$endif}

-{$IFDEF VER1_0_8 or VER1_0_10}
-{$DEFINE UseFCLDataModule}
+{$IF VER1_0_8 or VER1_0_10}
+// There is a problem with try..except and calling JIT procedures, so we can't
+// use the FCL TDataModule at the moment
+{ $DEFINE UseFCLDataModule}
 {$ENDIF}

 uses
@ -1201,26 +1203,27 @@ end;
 procedure TDataModule.DoCreate;
 begin
  if Assigned(FOnCreate) then
-  try
+  //try
    FOnCreate(Self);
-  except
+  {except
    begin
      if not HandleCreateException then
        raise;
    end;
-  end;
+  end;}
 end;

 procedure TDataModule.DoDestroy;
 begin
-  if Assigned(FOnDestroy) then
-  try
-    FOnDestroy(Self);
-  except
-    begin
-      if Assigned(ApplicationHandleException) then
-        ApplicationHandleException(Self);
-    end;
+  if Assigned(FOnDestroy) then begin
+    //try
+      FOnDestroy(Self);
+    {except
+      begin
+        if Assigned(ApplicationHandleException) then
+          ApplicationHandleException(Self);
+      end;
+    end;}
  end;
 end;