* Added observer support

git-svn-id: trunk@22257 -

rtl/objpas/classes/classesh.inc

@@ -147,6 +147,51 @@ type
   EInvalidOperation = class(Exception);
   TExceptionClass = Class of Exception;
 
+{ ---------------------------------------------------------------------
+  Free Pascal Observer support
+  ---------------------------------------------------------------------}
+
+
+Const
+  BaseGUIDObserved = '{663C603C-3F3C-4CC5-823C-AC8079F979E5}';
+  BaseGUIDObserver = '{BC7376EA-199C-4C2A-8684-F4805F0691CA}';
+
+  GUIDObserved : TGUID = BaseGUIDObserved;
+  GUIDObserver : TGUID = BaseGUIDObserver;
+
+  // String is needed for testing
+  SGUIDObserver = BaseGUIDObserver;
+  SGUIDObserved = BaseGUIDObserved;
+
+
+
+Type
+  // Notification operations :
+  // Observer has changed, is freed, item added to/deleted from list, custom event.
+  TFPObservedOperation = (ooChanged,ooFree,ooAddItem,ooDeleteItem,ooCustom);
+{$INTERFACES CORBA}
+
+  { IFPObserved }
+
+  IFPObserved = Interface [BaseGUIDObserved]
+    // attach a new observer
+    Procedure FPOAttachObserver(AObserver : TObject);
+    // Detach an observer
+    Procedure FPODetachObserver(AObserver : TObject);
+    // Notify all observers of a change.
+    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
+  end;
+
+  { IFPObserver }
+
+  IFPObserver = Interface  [BaseGUIDObserver]
+    // Called by observed when observers are notified.
+    Procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer);
+  end;
+{$INTERFACES COM}
+
+  EObserver = Class(Exception);
+
 { Forward class declarations }
 
   TStream = class;
@@ -269,9 +314,10 @@ type
     property Current: Pointer read GetCurrent;
   end;
 
-  TList = class(TObject)
+  TList = class(TObject,IFPObserved)
   private
     FList: TFPList;
+    FObservers : TFPList;
     procedure CopyMove (aList : TList);
     procedure MergeMove (aList : TList);
     procedure DoCopy(ListA, ListB : TList);
@@ -293,6 +339,9 @@ type
   public
     constructor Create;
     destructor Destroy; override;
+    Procedure FPOAttachObserver(AObserver : TObject);
+    Procedure FPODetachObserver(AObserver : TObject);
+    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
     Procedure AddList(AList : TList);
     function Add(Item: Pointer): Integer;
     procedure Clear; virtual;
@@ -390,14 +439,19 @@ type
 
 {$M+}
 
-  TPersistent = class(TObject)
+  TPersistent = class(TObject,IFPObserved)
   private
+    FObservers : TFPList;
     procedure AssignError(Source: TPersistent);
   protected
     procedure AssignTo(Dest: TPersistent); virtual;
     procedure DefineProperties(Filer: TFiler); virtual;
     function  GetOwner: TPersistent; dynamic;
+    Procedure FPOAttachObserver(AObserver : TObject);
+    Procedure FPODetachObserver(AObserver : TObject);
+    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
   public
+    Destructor Destroy; override;
     procedure Assign(Source: TPersistent); virtual;
     function  GetNamePath: string; virtual; {dynamic;}
   end;

rtl/objpas/classes/collect.inc

@@ -288,6 +288,7 @@ end;
 
 procedure TCollection.Update(Item: TCollectionItem);
 begin
+  FPONotifyObservers(Self,ooChanged,Pointer(Item));
 end;
 
 
@@ -395,6 +396,12 @@ end;
 
 procedure TCollection.Notify(Item: TCollectionItem;Action: TCollectionNotification);
 begin
+  if Assigned(FObservers) then
+    Case Action of
+      cnAdded      : FPONotifyObservers(Self,ooAddItem,Pointer(Item));
+      cnExtracting : FPONotifyObservers(Self,ooCustom,Pointer(Item));
+      cnDeleting   : FPONotifyObservers(Self,ooDeleteItem,Pointer(Item));
+    end;
 end;
 
 procedure TCollection.Sort(Const Compare : TCollectionSortCompare);

rtl/objpas/classes/lists.inc

@@ -606,6 +606,12 @@ end;
 
 procedure TList.Notify(Ptr: Pointer; Action: TListNotification);
 begin
+   if Assigned(FObservers) then
+     Case ACtion of
+       lnAdded     : FPONotifyObservers(Self,ooAddItem,Ptr);
+       lnExtracted : FPONotifyObservers(Self,ooCustom,Ptr);
+       lnDeleted   : FPONotifyObservers(Self,ooDeleteItem,Ptr);
+     end;
 end;
 
 function TList.GetCapacity: integer;
@@ -642,10 +648,61 @@ destructor TList.Destroy;
 begin
   If (Flist<>Nil) then
     Clear;
+  If Assigned(FObservers) then
+    begin
+    FPONotifyObservers(Self,ooFree,Nil);
+    FreeAndNil(FObservers);
+    end;
   FreeAndNil(FList);
   inherited Destroy;
 end;
 
+procedure TList.FPOAttachObserver(AObserver: TObject);
+
+Var
+   I : IFPObserver;
+
+begin
+  If Not AObserver.GetInterface(SGUIDObserver,I) then
+    Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+  If not Assigned(FObservers) then
+    FObservers:=TFPList.Create;
+  FObservers.Add(AObserver);
+end;
+
+procedure TList.FPODetachObserver(AObserver: TObject);
+Var
+  I : IFPObserver;
+
+begin
+  If Not AObserver.GetInterface(SGUIDObserver,I) then
+    Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+  If Assigned(FObservers) then
+    begin
+    FObservers.Remove(AObserver);
+    If (FObservers.Count=0) then
+      FreeAndNil(FObservers);
+    end;
+end;
+
+procedure TList.FPONotifyObservers(ASender: TObject;
+  AOperation: TFPObservedOperation; Data : Pointer);
+
+Var
+  O : TObject;
+  I : Integer;
+  Obs : IFPObserver;
+
+begin
+  If Assigned(FObservers) then
+    For I:=FObservers.Count-1 downto 0 do
+      begin
+      O:=TObject(FObservers[i]);
+      If O.GetInterface(SGUIDObserver,Obs) then
+        Obs.FPOObservedChanged(Self,AOperation,Data);
+      end;
+end;
+
 function TList.Add(Item: Pointer): Integer;
 begin
   Result := FList.Add(Item);
@@ -664,7 +721,7 @@ begin
   for I := 0 to AList.Count - 1 do
     if AList[I] <> nil then
       Notify(AList[I], lnAdded);
-end;            
+end;
 
 procedure TList.Clear;
 
@@ -681,7 +738,8 @@ var P : pointer;
 begin
   P:=FList.Get(Index);
   FList.Delete(Index);
-  if assigned(p) then Notify(p, lnDeleted);
+  if assigned(p) then
+    Notify(p, lnDeleted);
 end;
 
 class procedure TList.Error(const Msg: string; Data: PtrInt);
@@ -692,6 +750,7 @@ end;
 procedure TList.Exchange(Index1, Index2: Integer);
 begin
   FList.Exchange(Index1, Index2);
+  FPONotifyObservers(Self,ooChanged,Nil);
 end;
 
 function TList.Expand: TList;

rtl/objpas/classes/persist.inc

@@ -49,6 +49,60 @@ begin
   Result:=Nil;
 end;
 
+destructor TPersistent.Destroy;
+begin
+  If Assigned(FObservers) then
+    begin
+    FPONotifyObservers(Self,ooFree,Nil);
+    FreeAndNil(FObservers);
+    end;
+  inherited Destroy;
+end;
+
+procedure TPersistent.FPOAttachObserver(AObserver: TObject);
+Var
+   I : IFPObserver;
+
+begin
+   If Not AObserver.GetInterface(SGUIDObserver,I) then
+     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+   If not Assigned(FObservers) then
+     FObservers:=TFPList.Create;
+   FObservers.Add(AObserver);
+end;
+
+procedure TPersistent.FPODetachObserver(AObserver: TObject);
+Var
+  I : IFPObserver;
+
+begin
+  If Not AObserver.GetInterface(SGUIDObserver,I) then
+    Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+  If Assigned(FObservers) then
+    begin
+    FObservers.Remove(AObserver);
+    If (FObservers.Count=0) then
+      FreeAndNil(FObservers);
+    end;
+end;
+
+procedure TPersistent.FPONotifyObservers(ASender: TObject;
+  AOperation: TFPObservedOperation; Data : Pointer);
+Var
+  O : TObject;
+  I : Integer;
+  Obs : IFPObserver;
+
+begin
+  If Assigned(FObservers) then
+    For I:=FObservers.Count-1 downto 0 do
+      begin
+      O:=TObject(FObservers[i]);
+      If O.GetInterface(SGUIDObserver,Obs) then
+        Obs.FPOObservedChanged(Self,AOperation,Data);
+      end;
+end;
+
 procedure TPersistent.Assign(Source: TPersistent);
 
 begin

rtl/objpas/classes/stringl.inc

@@ -551,6 +551,7 @@ end;
 Procedure TStrings.SetUpdateState(Updating: Boolean);
 
 begin
+  FPONotifyObservers(Self,ooChanged,Nil);
 end;
 
 
@@ -1030,8 +1031,11 @@ Procedure TStringList.Changed;
 
 begin
   If (FUpdateCount=0) Then
+   begin
    If Assigned(FOnChange) then
      FOnchange(Self);
+   FPONotifyObservers(Self,ooChanged,Nil);
+   end;
 end;