paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 23:21:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added observer support

Browse Source 
git-svn-id: trunk@22257 -
This commit is contained in:
michael 2012-08-27 19:28:14 +00:00
parent e40505a998
commit 43be53351e
5 changed files with 182 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
rtl/objpas/classes/classesh.inc
View File

@ -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;

7
rtl/objpas/classes/collect.inc
View File

@ -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);

63
rtl/objpas/classes/lists.inc
View File

@ -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;

54
rtl/objpas/classes/persist.inc
View File

@ -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

4
rtl/objpas/classes/stringl.inc
View File

@ -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;