Added code for registerclass, GetClass and RegisterClasses

Shane

fcl/inc/cregist.inc

@@ -17,14 +17,36 @@
 { Class registration routines }
 
 procedure RegisterClass(AClass: TPersistentClass);
-
+var
+aClassname : String;
 begin
+  //Classlist is created during initialization.
+  with Classlist.Locklist do
+     try
+      while Indexof(AClass) = -1 do
+         begin
+           aClassname := AClass.ClassName;
+           if GetClass(aClassName) <> nil then  //class alread registered!
+                 Begin
+                 //raise an error
+                 exit;
+                 end;
+          Add(AClass);
+          if AClass = TPersistent then break;
+          AClass := TPersistentClass(AClass.ClassParent);
+         end;
+     finally
+       ClassList.UnlockList;
+     end;
 end;
 
 
 procedure RegisterClasses(AClasses: array of TPersistentClass);
-
+var
+I : Integer;
 begin
+for I := low(aClasses) to high(aClasses) do
+       RegisterClass(aClasses[I]);
 end;
 
 
@@ -60,13 +82,28 @@ end;
 
 
 function GetClass(const ClassName: string): TPersistentClass;
-
+var
+I : Integer;
 begin
-  GetClass:=nil;
+  with ClassList.LockList do
+   try
+    for I := 0 to Count-1 do
+       begin
+        Result := TPersistentClass(Items[I]);
+        if Result.ClassNameIs(ClassName) then Exit;
+       end;
+       I := ClassAliasList.Indexof(ClassName);
+       if I >= 0 then  //found
+          Begin
+          Result := TPersistentClass(ClassAliasList.Objects[i]);
+          exit;
+          end;
+       Result := nil;
+    finally
+      ClassList.Unlocklist;
+    end;
 end;
 
-
-
 { Component registration routines }
 
 type
@@ -148,7 +185,11 @@ end;
 
 {
   $Log$
-  Revision 1.4  2000-01-07 01:24:33  peter
+  Revision 1.5  2000-06-27 17:17:34  lazarus
+  Added code for registerclass, GetClass and RegisterClasses
+  Shane
+
+  Revision 1.4  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.3  2000/01/06 01:20:33  peter

fcl/linux/classes.pp

@@ -36,24 +36,30 @@ uses
 
 var
 ClassList : TThreadlist;
-
+ClassAliasList : TStringList;
 { OS - independent class implementations are in /inc directory. }
 {$i classes.inc}
 
 
 initialization
-ClassList := TThreadList.Create;
+  ClassList := TThreadList.Create;
+  ClassAliasList := TStringList.Create;
 
 finalization
-ClassList.Free;
+  ClassList.Free;
+  ClassAliasList.Free;
 
-if ThreadsInited then
-   DoneThreads;
+  if ThreadsInited then
+     DoneThreads;
 
 end.
 {
   $Log$
-  Revision 1.16  2000-06-27 15:55:19  lazarus
+  Revision 1.17  2000-06-27 17:17:34  lazarus
+  Added code for registerclass, GetClass and RegisterClasses
+  Shane
+
+  Revision 1.16  2000/06/27 15:55:19  lazarus
   Added TThreadlist code.   Shane
 
   Revision 1.15  2000/01/07 01:24:34  peter