Browse Source

* Some small cosmetic changes and minor fixes

sg 25 years ago
parent
commit
b1fb6d6d4f
1 changed files with 156 additions and 194 deletions
  1. 156 194
      fcl/inc/classes.inc

+ 156 - 194
fcl/inc/classes.inc

@@ -136,13 +136,11 @@ var
   IntConstList: TThreadList;
 
 
-// !!!: INSERTION START, only slightly modified until now
-
 type
   TIntConst = class
-    IntegerType: PTypeInfo;
-    IdentToIntFn: TIdentToInt;
-    IntToIdentFn: TIntToIdent;
+    IntegerType: PTypeInfo;		// The integer type RTTI pointer
+    IdentToIntFn: TIdentToInt;		// Identifier to Integer conversion
+    IntToIdentFn: TIntToIdent;		// Integer to Identifier conversion
     constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
       AIntToIdent: TIntToIdent);
   end;
@@ -163,18 +161,14 @@ end;
 
 function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
 var
-  I: Integer;
+  i: Integer;
 begin
-  Result := nil;
   with IntConstList.LockList do
   try
-    for I := 0 to Count - 1 do
-      with TIntConst(Items[I]) do
-        if AIntegerType = IntegerType then
-        begin
-          Result := IntToIdentFn;
-          Exit;
-        end;
+    for i := 0 to Count - 1 do
+      if TIntConst(Items[i]).IntegerType = AIntegerType then
+        exit(TIntConst(Items[i]).IntToIdentFn);
+    Result := nil;
   finally
     IntConstList.UnlockList;
   end;
@@ -182,55 +176,48 @@ end;
 
 function FindIdentToInt(AIntegerType: Pointer): TIdentToInt;
 var
-  I: Integer;
+  i: Integer;
 begin
-  Result := nil;
   with IntConstList.LockList do
   try
-    for I := 0 to Count - 1 do
+    for i := 0 to Count - 1 do
       with TIntConst(Items[I]) do
-        if AIntegerType = IntegerType then
-        begin
-          Result := IdentToIntFn;
-          Exit;
-        end;
+        if TIntConst(Items[I]).IntegerType = AIntegerType then
+          exit(IdentToIntFn);
+    Result := nil;
   finally
     IntConstList.UnlockList;
   end;
 end;
 
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
+function IdentToInt(const Ident: String; var Int: LongInt;
+  const Map: array of TIdentMapEntry): Boolean;
 var
-  I: Integer;
+  i: Integer;
 begin
-  for I := Low(Map) to High(Map) do
-    if UpperCase(Map[I].Name) = UpperCase(Ident) then
+  for i := Low(Map) to High(Map) do
+    if CompareText(Map[i].Name, Ident) = 0 then
     begin
-      Result := True;
-      Int := Map[I].Value;
-      Exit;
+      Int := Map[i].Value;
+      exit(True);
     end;
   Result := False;
 end;
 
-function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
+function IntToIdent(Int: LongInt; var Ident: String;
+  const Map: array of TIdentMapEntry): Boolean;
 var
-  I: Integer;
+  i: Integer;
 begin
-  for I := Low(Map) to High(Map) do
-    if Map[I].Value = Int then
+  for i := Low(Map) to High(Map) do
+    if Map[i].Value = Int then
     begin
-      Result := True;
-      Ident := Map[I].Name;
-      Exit;
+      Ident := Map[i].Name;
+      exit(True);
     end;
   Result := False;
 end;
 
-// !!!: INSERTION END
-
-
-// !!!: INSERTION START
 
 { TPropFixup }
 
@@ -241,41 +228,37 @@ type
     FPropInfo: PPropInfo;
     FRootName: string;
     FName: string;
-    constructor Create(Instance: TPersistent; InstanceRoot: TComponent;
-      PropInfo: PPropInfo; const RootName, Name: string);
+    constructor Create(AInstance: TPersistent; AInstanceRoot: TComponent;
+      APropInfo: PPropInfo; const ARootName, AName: String);
     function MakeGlobalReference: Boolean;
   end;
 
 var
   GlobalFixupList: TThreadList;
 
-constructor TPropFixup.Create(Instance: TPersistent; InstanceRoot: TComponent;
-  PropInfo: PPropInfo; const RootName, Name: string);
+constructor TPropFixup.Create(AInstance: TPersistent; AInstanceRoot: TComponent;
+  APropInfo: PPropInfo; const ARootName, AName: String);
 begin
-  FInstance := Instance;
-  FInstanceRoot := InstanceRoot;
-  FPropInfo := PropInfo;
-  FRootName := RootName;
-  FName := Name;
+  FInstance := AInstance;
+  FInstanceRoot := AInstanceRoot;
+  FPropInfo := APropInfo;
+  FRootName := ARootName;
+  FName := AName;
 end;
 
 function TPropFixup.MakeGlobalReference: Boolean;
 var
-  S: PChar;
-  P: PChar;
+  i: Integer;
+  s, p: PChar;
 begin
-  Result := False;
-  S := PChar(Pointer(FName));
-  P := S;
-  while not (P^ in ['.', #0]) do Inc(P);
-  if P^ = #0 then Exit;
-  SetString(FRootName, S, P - S);
-  Delete(FName, 1, P - S + 1);
+  i := Pos('.', FName);
+  if i = 0 then
+    exit(False);
+  FRootName := Copy(FName, 1, i - 1);
+  FName := Copy(FName, i + 1, Length(FName));
   Result := True;
 end;
 
-// !!!: INSERTION END
-
 
 function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
 
@@ -287,9 +270,10 @@ function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boo
       { Init the parent class first }
       Result := DoInitClass(ClassType.ClassParent);
 
-      { !!!: Too Win32-specific in VCL:
-      Result := InternalReadComponentRes(ClassType.ClassName, FindResourceHInstance(
-        FindClassHInstance(ClassType)), Instance) or Result;}
+      { !!!: This would work only on Win32, how should we do this multiplatform?
+      Result := InternalReadComponentRes(ClassType.ClassName,
+        FindResourceHInstance(FindClassHInstance(ClassType)), Instance)
+	or Result;}
       Result := False;
     end;
   end;
@@ -314,31 +298,31 @@ begin
 end;
 
 
-function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
+function InitComponentRes(const ResName: String; Instance: TComponent): Boolean;
 
 begin
-  { !!!: Too Win32-specific in VCL }
-  InitComponentRes:=False;
+  { !!!: Too Win32-specific }
+  InitComponentRes := False;
 end;
 
 
-function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
+function ReadComponentRes(const ResName: String; Instance: TComponent): TComponent;
 
 begin
-  { !!!: Too Win32-specific in VCL }
-  ReadComponentRes:=nil;
+  { !!!: Too Win32-specific }
+  ReadComponentRes := nil;
 end;
 
 
-function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
+function ReadComponentResEx(HInstance: THandle; const ResName: String): TComponent;
 
 begin
   { !!!: Too Win32-specific in VCL }
-  ReadComponentResEx:=nil;
+  ReadComponentResEx := nil;
 end;
 
 
-function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
+function ReadComponentResFile(const FileName: String; Instance: TComponent): TComponent;
 var
   FileStream: TStream;
 begin
@@ -351,7 +335,7 @@ begin
 end;
 
 
-procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
+procedure WriteComponentResFile(const FileName: String; Instance: TComponent);
 var
   FileStream: TStream;
 begin
@@ -364,108 +348,83 @@ begin
 end;
 
 
-// !!!: INSERTION START
 procedure GlobalFixupReferences;
 var
-  FinishedList: TList;
-  NotFinishedList: TList;
-  GlobalList: TList;
-  I: Integer;
+  GlobalList, DoneList, ToDoList: TList;
+  I, Index: Integer;
   Root: TComponent;
   Instance: TPersistent;
   Reference: Pointer;
-
-  procedure AddFinished(Instance: TPersistent);
-  begin
-    if (FinishedList.IndexOf(Instance) < 0) and
-      (NotFinishedList.IndexOf(Instance) >= 0) then
-      FinishedList.Add(Instance);
-  end;
-
-  procedure AddNotFinished(Instance: TPersistent);
-  var
-    Index: Integer;
-  begin
-    Index := FinishedList.IndexOf(Instance);
-    if Index <> -1 then FinishedList.Delete(Index);
-    if NotFinishedList.IndexOf(Instance) < 0 then
-      NotFinishedList.Add(Instance);
-  end;
-
 begin
-  if Assigned(FindGlobalComponent) then
-  begin
-    // Fixup resolution requires a stable component / name space
-    // Block construction and destruction of forms / datamodules during fixups
-    {!!!: GlobalNameSpace.BeginWrite;
-    try}
-      GlobalList := GlobalFixupList.LockList;
-      try
-        if GlobalList.Count > 0 then
-        begin
-          FinishedList := TList.Create;
-          try
-            NotFinishedList := TList.Create;
-            try
-              I := 0;
-              while I < GlobalList.Count do
-                with TPropFixup(GlobalList[I]) do
+  if not Assigned(FindGlobalComponent) then
+    exit;
+
+  {!!!: GlobalNameSpace.BeginWrite;
+  try}
+    GlobalList := GlobalFixupList.LockList;
+    try
+      if GlobalList.Count > 0 then
+      begin
+        ToDoList := nil;
+	DoneList := TList.Create;
+	ToDoList := TList.Create;
+	try
+	  i := 0;
+	  while i < GlobalList.Count do
+	    with TPropFixup(GlobalList[i]) do
+            begin
+              Root := FindGlobalComponent(FRootName);
+              if Assigned(Root) or (GetOrdProp(FInstance, FPropInfo) <> 0) then
+              begin
+                if Assigned(Root) then
                 begin
-                  Root := FindGlobalComponent(FRootName);
-                  if (Root <> nil) or (GetOrdProp(FInstance, FPropInfo) <> 0) then
-                  begin
-                    if Root <> nil then
-                    begin
-                      Reference := FindNestedComponent(Root, FName);
-                      SetOrdProp(FInstance, FPropInfo, Longint(Reference));
-                    end;
-                    AddFinished(FInstance);
-                    GlobalList.Delete(I);
-                    Free;
-                  end else
-                  begin
-                    AddNotFinished(FInstance);
-                    Inc(I);
-                  end;
+                  Reference := FindNestedComponent(Root, FName);
+                  SetOrdProp(FInstance, FPropInfo, Longint(Reference));
                 end;
-            finally
-              NotFinishedList.Free;
+		// Move component to list of done components, if necessary
+		if (DoneList.IndexOf(FInstance) < 0) and
+		  (ToDoList.IndexOf(FInstance) >= 0) then
+		  DoneList.Add(FInstance);
+                GlobalList.Delete(i);
+                Free;	// ...the fixup
+              end else
+              begin
+	        // Move component to list of components to process, if necessary
+		Index := DoneList.IndexOf(FInstance);
+		if Index <> -1 then
+		  DoneList.Delete(Index);
+		if ToDoList.IndexOf(FInstance) < 0 then
+		  ToDoList.Add(FInstance);
+		Inc(i);
+              end;
             end;
-            for I := 0 to FinishedList.Count - 1 do
+            for i := 0 to DoneList.Count - 1 do
             begin
-              Instance := TPersistent(FinishedList[I]);
-              if Instance is TComponent then
+              Instance := TPersistent(DoneList[I]);
+              if Instance.InheritsFrom(TComponent) then
                 Exclude(TComponent(Instance).FComponentState, csFixups);
             end;
           finally
-            FinishedList.Free;
+	    ToDoList.Free;
+            DoneList.Free;
           end;
         end;
-      finally
-        GlobalFixupList.UnlockList;
-      end;
-    {finally
-      GlobalNameSpace.EndWrite;
-    end;}
-  end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
+  {finally
+    GlobalNameSpace.EndWrite;
+  end;}
 end;
 
-// !!!: INSERTION END
-
 
-// !!!: Rename this function
-function NameInStrings(Strings: TStrings; const Name: String): Boolean;
+function IsStringInList(const AString: String; AList: TStrings): Boolean;
 var
-  n: String;
-  I: Integer;
+  i: Integer;
 begin
-  n := UpperCase(Name);
-  for i := 0 to Strings.Count - 1 do
-    if UpperCase(Strings[i]) = n then
-    begin
-      Result := True;
-      exit;
-    end;
+  for i := 0 to AList.Count - 1 do
+    if CompareText(AList[i], AString) = 0 then
+      exit(True);
   Result := False;
 end;
 
@@ -481,7 +440,7 @@ begin
       begin
         CurFixup := TPropFixup(Items[i]);
         if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
-          not NameInStrings(Names, CurFixup.FRootName) then
+          not IsStringInList(CurFixup.FRootName, Names) then
           Names.Add(CurFixup.FRootName);
       end;
     finally
@@ -503,7 +462,7 @@ begin
         CurFixup := TPropFixup(Items[i]);
         if (CurFixup.FInstanceRoot = Root) and
           (UpperCase(ReferenceRootName) = UpperCase(CurFixup.FRootName)) and
-          not NameInStrings(Names, CurFixup.FName) then
+          not IsStringInList(CurFixup.FName, Names) then
           Names.Add(CurFixup.FName);
       end;
     finally
@@ -539,23 +498,25 @@ var
   i: Integer;
   CurFixup: TPropFixup;
 begin
-  if Assigned(GlobalFixupList) then
-    with GlobalFixupList.LockList do
-      try
-        for i := Count - 1 downto 0 do
+  if not Assigned(GlobalFixupList) then
+    exit;
+
+  with GlobalFixupList.LockList do
+    try
+      for i := Count - 1 downto 0 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+          ((Length(RootName) = 0) or
+          (UpperCase(RootName) = UpperCase(CurFixup.FRootName))) then
         begin
-          CurFixup := TPropFixup(Items[i]);
-          if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
-            ((Length(RootName) = 0) or
-            (UpperCase(RootName) = UpperCase(CurFixup.FRootName))) then
-          begin
-            Delete(i);
-            CurFixup.Free;
-          end;
+          Delete(i);
+          CurFixup.Free;
         end;
-      finally
-        GlobalFixupList.UnlockList;
       end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
 end;
 
 
@@ -564,21 +525,23 @@ var
   i: Integer;
   CurFixup: TPropFixup;
 begin
-  if Assigned(GlobalFixupList) then
-    with GlobalFixupList.LockList do
-      try
-        for i := Count - 1 downto 0 do
+  if not Assigned(GlobalFixupList) then
+    exit;
+
+  with GlobalFixupList.LockList do
+    try
+      for i := Count - 1 downto 0 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if (CurFixup.FInstance = Instance) then
         begin
-          CurFixup := TPropFixup(Items[i]);
-          if (CurFixup.FInstance = Instance) then
-          begin
-            Delete(i);
-            CurFixup.Free;
-          end;
+          Delete(i);
+          CurFixup.Free;
         end;
-      finally
-        GlobalFixupList.UnlockList;
       end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
 end;
 
 
@@ -618,11 +581,9 @@ begin
   Result := Current;
 end;
 
-{!!!: threadvar block copied from VCL}
-{threadvar  -  doesn't work for all platforms yet!}
+{!!!: Should be threadvar  -  doesn't work for all platforms yet!}
 var
-  GlobalLoaded: TList;
-  GlobalLists: TList;
+  GlobalLoaded, GlobalLists: TList;
 
 
 procedure BeginGlobalLoading;
@@ -635,15 +596,13 @@ begin
 end;
 
 
+{ Notify all global components that they have been loaded completely }
 procedure NotifyGlobalLoading;
 var
-  List: TList;
   i: Integer;
 begin
-  List := GlobalLoaded;
-  { Notify all global components that they have been loaded completely }
-  for i := 0 to List.Count - 1 do
-    TComponent(List[i]).Loaded;
+  for i := 0 to GlobalLoaded.Count - 1 do
+    TComponent(GlobalLoaded[i]).Loaded;
 end;
 
 
@@ -662,8 +621,8 @@ end;
 
 
 function CollectionsEqual(C1, C2: TCollection): Boolean;
-
 begin
+  // !!!: Implement this
   CollectionsEqual:=false;
 end;
 
@@ -1222,7 +1181,10 @@ end;
 
 {
   $Log$
-  Revision 1.3  2000-07-22 14:55:56  sg
+  Revision 1.4  2000-10-13 12:33:23  sg
+  * Some small cosmetic changes and minor fixes
+
+  Revision 1.3  2000/07/22 14:55:56  sg
   * Fixed some DFM parser bugs
 
   Revision 1.2  2000/07/13 11:32:59  michael