--- Merging r23091 into '.':

U    packages/fcl-base/src/fpobserver.pp
--- Merging r23092 into '.':
A    packages/fcl-base/examples/dobserver.pp
--- Merging r23142 into '.':
U    packages/fcl-base/src/contnrs.pp
--- Merging r23143 into '.':
G    packages/fcl-base/src/contnrs.pp

# revisions: 23091,23092,23142,23143
r23091 | michael | 2012-12-02 12:19:20 +0100 (Sun, 02 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/fpobserver.pp

* Speed optimization similar to tpersist and tlist
r23092 | michael | 2012-12-02 12:24:42 +0100 (Sun, 02 Dec 2012) | 1 line
Changed paths:
   A /trunk/packages/fcl-base/examples/dobserver.pp

* Small observer demo from Graeme Geldenhuys (bug ID 23329)
r23142 | michael | 2012-12-14 11:55:48 +0100 (Fri, 14 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/contnrs.pp

ForeachCall needs to be pubic
r23143 | michael | 2012-12-14 15:49:00 +0100 (Fri, 14 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/contnrs.pp

* Hide internals of ForeachCall data structure

git-svn-id: branches/fixes_2_6@24560 -

.gitattributes

@@ -1664,6 +1664,7 @@ packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
 packages/fcl-base/examples/debugtest.pp svneol=native#text/plain
 packages/fcl-base/examples/decodeascii85.pp svneol=native#text/plain
+packages/fcl-base/examples/dobserver.pp svneol=native#text/plain
 packages/fcl-base/examples/doecho.pp svneol=native#text/plain
 packages/fcl-base/examples/dparser.pp svneol=native#text/plain
 packages/fcl-base/examples/dsockcli.pp svneol=native#text/plain

packages/fcl-base/examples/dobserver.pp

@@ -0,0 +1,67 @@
+{ This demo is very basic, but shows the Observer support in the RTL }
+program dobserver;
+
+{$mode objfpc}{$h+}
+{$ifdef mswindows}{$apptype console}{$endif}
+
+uses
+ Classes, SysUtils, typinfo;
+
+type
+  TMyObserver = class(TObject, IFPObserver)
+  private
+    procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer);
+  end; 
+  
+{ TMyObserver }
+
+procedure TMyObserver.FPOObservedChanged(ASender: TObject;
+               Operation: TFPObservedOperation; Data: Pointer);
+
+  function OperationToString(AOperation: TFPObservedOperation): string;
+  begin
+    result := GetEnumName(TypeInfo(TFPObservedOperation),
+                         Ord(AOperation));
+  end;
+var
+  intf: IFPObserved;
+begin
+  if Operation = ooFree then
+  begin
+    writeln('[ooFree] detected so we should detach ourselves');
+    if Supports(ASender, IFPObserved, intf) then
+      intf.FPODetachObserver(self);
+  end
+  else
+  begin
+    writeln(ASender.ClassName + ' has changed ['+
+      OperationToString(Operation) + ']');
+  end;
+end;
+  
+var
+  sl: TStringList;
+  observer: TMyObserver;
+  intf: IFPObserved;
+begin
+  { This stringlist will be the subject (observed) }
+  sl := TStringList.Create;
+  { this instance will be the observer - notified when StringList changes }
+  observer := TMyObserver.Create;
+
+  { attach observer }  
+  if Supports(sl, IFPObserved, intf) then
+  begin
+    intf.FPOAttachObserver(observer);
+  end;
+  
+  { Do something to the stringlist }
+  sl.Add('Item one');
+  sl.Add('Item two');
+  sl.Delete(0);
+  
+  { Clean-up code - also shows ooFree operation }
+  sl.Free;
+  observer.Free;
+end.
+

packages/fcl-base/src/contnrs.pp

@@ -413,8 +413,8 @@ type
     Procedure AddNode(ANode : THTCustomNode); override;
     procedure SetData(const index: string; const AValue: Pointer); virtual;
     function GetData(const index: string):Pointer; virtual;
-    function ForEachCall(aMethod: TDataIteratorMethod): THTDataNode; virtual;
   Public
+    function ForEachCall(aMethod: TDataIteratorMethod): Pointer; virtual;
     procedure Add(const aKey: string; AItem: pointer); virtual;
     property Items[const index: string]: Pointer read GetData write SetData; default;
   end;
@@ -434,8 +434,8 @@ type
     Procedure AddNode(ANode : THTCustomNode); override;
     procedure SetData(const Index, AValue: string); virtual;
     function GetData(const index: string): String; virtual;
-    function ForEachCall(aMethod: TStringIteratorMethod): THTStringNode; virtual;
   Public
+    function ForEachCall(aMethod: TStringIteratorMethod): String; virtual;
     procedure Add(const aKey,aItem: string); virtual;
     property Items[const index: string]: String read GetData write SetData; default;
   end;
@@ -464,10 +464,10 @@ type
     Procedure AddNode(ANode : THTCustomNode); override;
     procedure SetData(const Index: string; AObject : TObject); virtual;
     function GetData(const index: string): TObject; virtual;
-    function ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode; virtual;
   Public
     constructor Create(AOwnsObjects : Boolean = True);
     constructor CreateWith(AHashTableSize: Longword; aHashFunc: THashFunction; AOwnsObjects : Boolean = True);
+    function ForEachCall(aMethod: TObjectIteratorMethod): TObject; virtual;
     procedure Add(const aKey: string; AItem : TObject); virtual;
     property Items[const index: string]: TObject read GetData write SetData; default;
     Property OwnsObjects : Boolean Read FOwnsObjects Write FOwnsObjects;
@@ -2255,7 +2255,7 @@ begin
   Result:=THTDataNode.CreateWith(aKey);
 end;
 
-function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): THTDataNode;
+function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): Pointer;
 var
   i, j: Longword;
   continue: boolean;
@@ -2273,7 +2273,7 @@ begin
           aMethod(THTDataNode(Chain(i)[j]).Data, THTDataNode(Chain(i)[j]).Key, continue);
           if not continue then
           begin
-            Result := THTDataNode(Chain(i)[j]);
+            Result := THTDataNode(Chain(i)[j]).Data;
             Exit;
           end;
         end;
@@ -2332,12 +2332,12 @@ begin
 end;
 
 
-function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): THTStringNode;
+function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): String;
 var
   i, j: Longword;
   continue: boolean;
 begin
-  Result := nil;
+  Result := '';
   continue := true;
   if FHashTableSize>0 then
    for i := 0 to FHashTableSize-1 do
@@ -2350,7 +2350,7 @@ begin
           aMethod(THTStringNode(Chain(i)[j]).Data, THTStringNode(Chain(i)[j]).Key, continue);
           if not continue then
           begin
-            Result := THTStringNode(Chain(i)[j]);
+            Result := THTStringNode(Chain(i)[j]).Data;
             Exit;
           end;
         end;
@@ -2405,7 +2405,7 @@ begin
 end;
 
 
-function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode;
+function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): TObject;
 var
   i, j: Longword;
   continue: boolean;
@@ -2423,7 +2423,7 @@ begin
           aMethod(THTObjectNode(Chain(i)[j]).Data, THTObjectNode(Chain(i)[j]).Key, continue);
           if not continue then
           begin
-            Result := THTObjectNode(Chain(i)[j]);
+            Result := THTObjectNode(Chain(i)[j]).Data;
             Exit;
           end;
         end;

packages/fcl-base/src/fpobserver.pp

@@ -473,7 +473,7 @@ begin
     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
   If not Assigned(FObservers) then
     FObservers:=TFPList.Create;
-  FObservers.Add(AObserver);
+  FObservers.Add(I);
 end;
 
 procedure TObservedHook.FPODetachObserver(AObserver: TObject);
@@ -486,7 +486,7 @@ begin
     Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
   If Assigned(FObservers) then
     begin
-    FObservers.Remove(AObserver);
+    FObservers.Remove(I);
     If (FObservers.Count=0) then
       FreeAndNil(FObservers);
     end;
@@ -523,9 +523,8 @@ 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(ASender,AOperation,Data);
+      Obs:=IFPObserver(FObservers[i]);
+      Obs.FPOObservedChanged(ASender,AOperation,Data);
       end;
 end;