On 19/05/2010, Marco van de Voort wrote:
>
> First: I don't see an urgent need for such draconic measures.
So Michael having to wait 10 years to see it implemented is called
"urgent" in your eye? :)
> Second: I don't see a good solution, exactly because the whole framework was
> not designed for this.
No need for a whole framework designed. Just adding some extra
functionality. Clearly you need a code example to understand it. See
the code example below.
> E.g. an Observer pattern typically uses interfaces, and interfaces are not
> designed into the framework.
Hell no! Observer has nothing to do with interfaces! The Observer is
implemented in tiOPF without interfaces. Using interfaces just makes
it easier to inject Observable behaviour - but injecting behaviour is
a feature of interfaces in general (not specific to Observer). The
other benefit of interfaces (now that we have interface delegation) is
that you only need to implement the Observer once and bolt that
implementation onto other classes. Saving you lots of duplicated code
and time.
Attached is a stripped down version of Observer implemented as a separate unit.
And here is how you can add Observer functionality to a class using
interfaces (purely to reduce code). This is what Michael and I are
proposing we do to base classes like TStrings or even TPersistent etc.
(note the final implementation my not look 100% like this - this is
just a quick example):
{$interfaces corba}
TMyClass = class(TList, IFPObserved)
private
FObservedHook: TObservedHook;
property ObservedHook: TObservedHook read FObservedHook
implements IFPObserved; // are will always access it via a interface
so it can stay private
public
function Add(....): Integer; override;
end;
function TMyClass.Add(....)
begin
inherited Add(...)
if Assigned(ObservedHook) then
ObservedHook.NotifyObservers(self, ooChanged);
end;
That's it! Now TMyClass can be observed. No huge amounts of code or
"draconic measures" as you phrased it.
You can now add observers of that class as follows in your program:
TMakeMeObserveSomething = class(TObject, IFPObserver)
private
procedure ObservedChanged(ASender: TObject;
Operation: TObservedOperation);
public
procedure DoItNow;
end;
procedure TMakeMeObserveSomething.DoItNow;
var
intf: IFPObserved;
begin
if MyClass.GetInterface(IFPObserved, intf) then
intf.AttachObserver(self);
end;
In tiOPF's implementation of Observer I optimized the code that extra
resources are only used when you actually use the observable
functionality by adding an observer the for the first time. I also
added extra optimization so that when you add many items for example
to a list that it works similar to BeginUpdate; .... EndUpdate; so
that observers are only notified once when a long running action is
completed or after multiple items was added to a list. Similar
optimization could be added the what Michael is proposing (if he
hasn't implemented this yet).
--
Regards,
- Graeme -
_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/
unit fpg_observer;
{$ifdef FPC}
{$mode objfpc}{$h+}
{$interfaces corba}
{$endif}
interface
uses
Classes, SysUtils;
const
SGUIDObserved = '{663C603C-3F3C-4CC5-823C-AC8079F979E5}';
SGUIDObserver = '{BC7376EA-199C-4C2A-8684-F4805F0691CA}';
GUIDObserved : TGUID = SGUIDObserved;
GUIDObserver : TGUID = SGUIDObserver;
type
// Notification operations :
// Observer has changed, is freed, item added to/deleted from list, custom event.
TObservedOperation = (ooChanged,ooFree,ooAddItem,ooDeleteItem,ooCustom);
IFPObserved = interface[SGUIDObserved]
// attach a new observer
procedure AttachObserver(AObserver : TObject);
// Detach an observer
procedure DetachObserver(AObserver : TObject);
// Notify all observers of a change.
procedure NotifyObservers(ASender : TObject; AOperation : TObservedOperation);
end;
IFPObserver = Interface [SGUIDObserver]
// Called by observed when observers are notified.
procedure ObservedChanged(ASender: TObject; Operation: TObservedOperation);
end;
{ TObservedHook }
{ Use this as an encapsulated mechanism for implementing TFPObserved }
TObservedHook = class(TObject, IFPObserved)
Protected
FObservers : TFPList;
FSender : TObject;
Public
// ASender will be the default sender.
constructor CreateSender(ASender : TObject);
destructor Destroy; override;
procedure AttachObserver(AObserver : TObject);
procedure DetachObserver(AObserver : TObject);
procedure Changed;
procedure AddItem(AItem : TObject);
procedure DeleteItem(AItem : TObject);
procedure CustomNotify;
procedure NotifyObservers(ASender : TObject; AOperation : TObservedOperation);
property Sender : TObject Read FSender;
end;
EObserver = Class(Exception);
implementation
resourcestring
SErrNotObserver = 'Instance of class %s is not an observer.';
SErrInvalidPropertyName = '%s is not a valid published property of class %s';
SErrObjectCannotBeObserved = 'Cannot observe an instance of class %d';
sErrInvalidFieldName = 'No fieldname specified for column %d';
sErrInvalidAlignmentChar = 'Invalid alignment character "%s" specified for column %d';
sErrInvalidWidthSpecifier = 'Invalid with "%s" specified for column %d';
sErrNotListObject = '%s is not a TObservedObjectList';
sErrCompositeNeedsList = '%s needs a TObservedObjectList class but is registered with %s';
SErrActive = 'Operation not allowed while the mediator is active';
SErrNoGuiFieldName = 'no gui fieldname set';
SErrNoSubjectFieldName = 'no subject fieldname set';
{ TObservedHook }
constructor TObservedHook.CreateSender(ASender: TObject);
begin
FSender:=ASender;
If FSender=Nil then
FSender:=Self;
end;
destructor TObservedHook.Destroy;
begin
If Assigned(FObservers) then
begin
NotifyObservers(FSender,ooFree);
FreeAndNil(FObservers);
end;
inherited Destroy;
end;
procedure TObservedHook.AttachObserver(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 TObservedHook.DetachObserver(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 TObservedHook.Changed;
begin
NotifyObservers(Sender,ooChanged)
end;
procedure TObservedHook.AddItem(AItem: TObject);
begin
NotifyObservers(AItem,ooAddItem);
end;
procedure TObservedHook.DeleteItem(AItem: TObject);
begin
NotifyObservers(AItem,ooDeleteItem);
end;
procedure TObservedHook.CustomNotify;
begin
NotifyObservers(Sender,ooCustom);
end;
procedure TObservedHook.NotifyObservers(ASender: TObject; AOperation: TObservedOperation);
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.ObservedChanged(ASender,AOperation);
end;
end;
end.
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
