* Implememented more parts of the new MVP framework for tiOPF and fpGUI.

5 files changed, 376 insertions, 68 deletions

diff --git a/extras/tiopf/mvp/basic_impl.pas b/extras/tiopf/mvp/basic_impl.pas
index e855a726..791f16e0 100644
--- a/extras/tiopf/mvp/basic_impl.pas
+++ b/extras/tiopf/mvp/basic_impl.pas
@@ -25,28 +25,6 @@ type
   end;
 
 
-  TListModel = class(TInterfacedObject, IListModel, ISubject)
-  private
-    fItems: IInterfaceList;
-    fSubject: ISubject;
-  protected
-    property Items: IInterfaceList read fItems;
-    // IListModel
-    function GetCount: Integer;
-    function GetItem(Idx: Integer): IInterface;
-    procedure Add(Item: IInterface);
-    procedure Clear;
-    procedure Insert(Item, Before: IInterface);
-    procedure Move(Item, Before: IInterface);
-    procedure Remove(Item: IInterface);
-    // ISubject
-    property Subject: ISubject read FSubject implements ISubject;
-  public
-    constructor Create; virtual;
-    destructor Destroy; override;
-  end;
-  
-  
   TString = class(TInterfacedObject, IString, IVisited)
   private
     fString: string;
@@ -58,13 +36,6 @@ type
   end;
   
   
-  TStringListModel = class(TListModel, IStringListModel)
-  private
-    // IStringListModel
-    function GetItem(Idx: Integer): IString;
-  end;
-  
-  
   TStringSelection = class(TInterfacedObject, ISelection, IVisited)
   private
     fModel: IStringListModel;
@@ -72,6 +43,7 @@ type
     // ISelection
     procedure AddItem(const Item: IInterface);
     procedure Clear;
+    function GetCount: integer;
     procedure RemoveItem(const Item: IInterface);
     procedure SelectModel;
     // IVisited
@@ -81,6 +53,98 @@ type
   end;
   
   
+  TCommand = class(TInterfacedObject, ICommand, IVisited)
+  private
+    fSelection: ISelection;
+    procedure BindSelection(const Selection: ISelection);
+  protected
+    // IVisited
+    procedure Accept(const Visitor: IVisitor); virtual;
+    // ICommand
+    function Execute: Boolean; virtual; abstract;
+    function GetEnabled: Boolean; virtual; abstract;
+    function GetText: string; virtual; abstract;
+  end;
+  
+  
+  TCommandSet = class(TInterfacedObject, ICommandSet, IObserver, ISubject, IVisited)
+  private
+    fItems: IInterfaceList;
+    fSubject: ISubject;
+    function GetCount: integer;
+    // IVisited
+    procedure Accept(const Visitor: IVisitor);
+  protected
+    property Count: integer read GetCount;
+    property Items: IInterfaceList read fItems;
+    // IObserver
+    procedure Update(Subject: IInterface);
+    // ISubject
+    property Subject: ISubject read fSubject implements ISubject;
+  public
+    constructor Create; virtual;
+  end;
+  
+  
+  TMVPModel = class(TInterfacedObject, IMVPModel, ISubject)
+  private
+    fCommandSet: ICommandSet;
+    fCurrentSelection: ISelection;
+    fSubject: ISubject;
+    // IMVPModel
+    function GetCommandSet: ICommandSet;
+    function GetCurrentSelection: ISelection;
+  protected
+    property CommandSet: ICommandSet read GetCommandSet;
+    property CurrentSelection: ISelection read GetCurrentSelection;
+    // 3 methods to be called by the constructor
+    procedure BindSelection; virtual;
+    procedure CreateCommandSet(var ACommandSet: ICommandSet); virtual; abstract;
+    procedure CreateSelection(var ASelection: ISelection); virtual; abstract;
+    // ISubject
+    property Subject: ISubject read fSubject implements ISubject;
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+  end;
+  
+
+  TListModel = class(TMVPModel, IListModel)
+  private
+    fItems: IInterfaceList;
+  protected
+    property Items: IInterfaceList read fItems;
+    // IListModel
+    function GetCount: Integer; virtual;
+    function GetItem(Idx: Integer): IInterface; virtual;
+    procedure Add(const Item: IInterface); virtual;
+    procedure Clear; virtual;
+    function IndexOf(const Item: IInterface): Integer; virtual;
+    procedure Insert(const Item, Before: IInterface); virtual;
+    procedure Move(const Item, Before: IInterface); virtual;
+    procedure Remove(const Item: IInterface); virtual;
+  public
+    destructor Destroy; override;
+  end;
+
+
+  TStringListModel = class(TListModel, IStringListModel, IVisited)
+  private
+    // IStringListModel
+    function IStringListModel.GetItem = StringListModelGetItem;
+    function StringListModelGetItem(Idx: Integer): IString;
+    // IVisited
+    procedure Accept(const Visitor: IVisitor); virtual;
+  protected
+    // IMVPModel
+    procedure CreateCommandSet(var ACommandSet: ICommandSet); override;
+    procedure CreateSelection(var ASelection: ISelection); override;
+  public
+    destructor Destroy; override;
+  end;
+
+
+
 
 implementation
 
@@ -149,50 +213,79 @@ begin
   Result := fItems[Idx];
 end;
 
-procedure TListModel.Add(Item: IInterface);
+procedure TListModel.Add(const Item: IInterface);
 begin
-  fSubject.BeginUpdate;
+  Subject.BeginUpdate;
+  if fItems = nil then
+    fItems := TInterfaceList.Create;
+//  fItems.Add(Item as IInterface);
   fItems.Add(Item);
-  fSubject.EndUpdate;
+  Subject.EndUpdate;
 end;
 
 procedure TListModel.Clear;
 begin
-  fSubject.BeginUpdate;
+  Subject.BeginUpdate;
   fItems.Clear;
-  fSubject.EndUpdate;
+  Subject.EndUpdate;
 end;
 
-procedure TListModel.Insert(Item, Before: IInterface);
+function TListModel.IndexOf(const Item: IInterface): Integer;
 begin
-  fSubject.BeginUpdate;
-  fItems.Insert(fItems.IndexOf(Before), Item);
-  fSubject.EndUpdate;
+  if fItems <> nil then
+//    Result := fItems.IndexOf(Item as IInterface)
+    Result := fItems.IndexOf(Item)
+  else
+    Result := -1;
 end;
 
-procedure TListModel.Move(Item, Before: IInterface);
+procedure TListModel.Insert(const Item, Before: IInterface);
 var
-  IndexOfBefore: integer;
+  InsertIdx: integer;
 begin
-  fSubject.BeginUpdate;
-  IndexOfBefore := fItems.IndexOf(Before);
-  if IndexOfBefore < 0 then
-    IndexOfBefore := 0;
-  fItems.Delete(fItems.IndexOf(Item));
-  fItems.Insert(IndexOfBefore, Item);
-  fSubject.EndUpdate;
+  if fItems = nil then
+    fItems := TInterfaceList.Create;
+  if fItems.IndexOf(Item) < 0 then
+  begin
+    Subject.BeginUpdate;
+    InsertIdx := fItems.IndexOf(Before);
+    if InsertIdx < 0 then
+      InsertIdx := 0;
+    fItems.Insert(InsertIdx, Item);
+    Subject.EndUpdate;
+  end;
 end;
 
-procedure TListModel.Remove(Item: IInterface);
+procedure TListModel.Move(const Item, Before: IInterface);
+var
+  IdxItem: integer;
+  IdxBefore: integer;
+  MoveItem: IInterface;
 begin
-  fSubject.BeginUpdate;
-  fItems.Delete(fItems.IndexOf(Item));
-  fSubject.EndUpdate;
+  if fItems <> nil then
+  begin
+    IdxItem := fItems.IndexOf(Item);
+    if IdxItem >= 0 then
+    begin
+      Subject.BeginUpdate;
+      MoveItem := fItems[IdxItem];
+      fItems.Delete(IdxItem);
+      IdxBefore := fItems.IndexOf(Before);
+      if IdxBefore >0 then
+        fItems.Insert(IdxBefore, MoveItem);
+      Subject.EndUpdate;
+    end;
+  end;  { if }
 end;
 
-constructor TListModel.Create;
+procedure TListModel.Remove(const Item: IInterface);
 begin
-  inherited Create;
+  if fItems <> nil then
+  begin
+    Subject.BeginUpdate;
+    fItems.Remove(Item);
+    Subject.EndUpdate;
+  end;
 end;
 
 destructor TListModel.Destroy;
@@ -219,11 +312,31 @@ end;
 
 { TStringListModel }
 
-function TStringListModel.GetItem(Idx: Integer): IString;
+function TStringListModel.StringListModelGetItem(Idx: Integer): IString;
 begin
   Result := Items[Idx] as IString;
 end;
 
+procedure TStringListModel.Accept(const Visitor: IVisitor);
+begin
+
+end;
+
+procedure TStringListModel.CreateCommandSet(var ACommandSet: ICommandSet);
+begin
+
+end;
+
+procedure TStringListModel.CreateSelection(var ASelection: ISelection);
+begin
+
+end;
+
+destructor TStringListModel.Destroy;
+begin
+  inherited Destroy;
+end;
+
 { TStringSelection }
 
 procedure TStringSelection.AddItem(const Item: IInterface);
@@ -239,6 +352,11 @@ begin
 
 end;
 
+function TStringSelection.GetCount: integer;
+begin
+  Result := fItems.Count;
+end;
+
 procedure TStringSelection.RemoveItem(const Item: IInterface);
 begin
   if fItems <> nil then
@@ -272,5 +390,77 @@ begin
   fModel := Model;
 end;
 
+{ TCommand }
+
+procedure TCommand.BindSelection(const Selection: ISelection);
+begin
+  fSelection := Selection;
+end;
+
+procedure TCommand.Accept(const Visitor: IVisitor);
+begin
+  (Visitor as ICommandVisitor).VisitComand(self);
+end;
+
+{ TCommandSet }
+
+function TCommandSet.GetCount: integer;
+begin
+  if fItems <> nil then
+    Result := fItems.Count
+  else
+    Result := 0;
+end;
+
+procedure TCommandSet.Accept(const Visitor: IVisitor);
+var
+  i: integer;
+begin
+  for i := 0 to fItems.Count-1 do
+    (fItems[i] as IVisited).Accept(Visitor);
+end;
+
+procedure TCommandSet.Update(Subject: IInterface);
+begin
+  // do nothing yet
+end;
+
+constructor TCommandSet.Create;
+begin
+  inherited Create;
+  fItems := TInterfaceList.Create;
+end;
+
+{ TMVPModel }
+
+function TMVPModel.GetCommandSet: ICommandSet;
+begin
+  Result := fCommandSet;
+end;
+
+function TMVPModel.GetCurrentSelection: ISelection;
+begin
+  Result := fCurrentSelection;
+end;
+
+procedure TMVPModel.BindSelection;
+begin
+  (fCurrentSelection as ISubject).Attach(fCommandSet as IObserver);
+end;
+
+constructor TMVPModel.Create;
+begin
+  inherited Create;
+  fSubject := TSubject.Create(self);
+  CreateSelection(fCurrentSelection);
+  CreateCommandSet(fCommandSet);
+  BindSelection;
+end;
+
+destructor TMVPModel.Destroy;
+begin
+  inherited Destroy;
+end;
+
 end.
 
diff --git a/extras/tiopf/mvp/basic_intf.pas b/extras/tiopf/mvp/basic_intf.pas
index efe58d4a..1d1aad80 100644
--- a/extras/tiopf/mvp/basic_intf.pas
+++ b/extras/tiopf/mvp/basic_intf.pas
@@ -7,6 +7,13 @@ interface
 type
   // forward declarations
   ISubject = interface;
+  IMVPView = interface;
+  ICommandMenuItem = interface;
+  IString = interface;
+
+
+  // event types
+  TSelectStringEvent = procedure(const AString: IString) of object;
 
   
   IObserver = interface(IInterface)
@@ -34,23 +41,23 @@ type
   ['{7CF62F51-9412-445C-9E8C-DE94F2B1E280}']
     procedure Accept(const Visitor: IVisitor);
   end;
-  
 
   
   IListModel = interface(IInterface)
   ['{1A772375-1263-4790-8827-F7BEA358674A}']
     function GetCount: Integer;
     function GetItem(Idx: Integer): IInterface;
-    procedure Add(Item: IInterface);
+    procedure Add(const Item: IInterface);
     procedure Clear;
-    procedure Insert(Item, Before: IInterface);
-    procedure Move(Item, Before: IInterface);
-    procedure Remove(Item: IInterface);
+    function IndexOf(const Item: IInterface): Integer;
+    procedure Insert(const Item, Before: IInterface);
+    procedure Move(const Item, Before: IInterface);
+    procedure Remove(const Item: IInterface);
     property Count: Integer read GetCount;
     property Item[Idx: Integer]: IInterface read GetItem;
   end;
-{
-  
+
+(*
   IController = interface(IInterface)
   ['{4A99C01A-D025-4562-8E94-3A0C873CE894}']
     function GetModel: IModel;
@@ -60,7 +67,7 @@ type
     property Model: IModel read GetModel write SetModel;
     property View: IView read GetView write SetView;
   end;
-}
+*)
 
   IString = interface(IInterface)
   ['{E76984A4-1287-4353-8370-A7332B9FB1CB}']
@@ -70,9 +77,9 @@ type
   end;
   
   
-  IStringListModel = interface(IInterface)
+  IStringListModel = interface(IListModel)
   ['{769804CD-89E4-43C7-B8EF-783BFE27214E}']
-    function GetItem(Idx: Integer): IString;
+    function GetItem(Idx: Integer): IString; overload;
     property Item[Idx: Integer]: IString read GetItem;
   end;
   
@@ -81,8 +88,9 @@ type
   ['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}']
     procedure AddItem(const Item: IInterface);
     procedure Clear;
+    function GetCount: integer;
     procedure RemoveItem(const Item: IInterface);
-    procedure SelectModel;
+    property Count: integer read GetCount;
   end;
   
   
@@ -90,7 +98,9 @@ type
   ['{B333C7E1-B124-4D08-A640-DC02F36264C7}']
     procedure BindSelection(const Selection: ISelection);
     function Execute: Boolean;
+    function GetEnabled: Boolean;
     function GetText: string;
+    property Enabled: Boolean read GetEnabled;
     property Text: string read GetText;
   end;
   
@@ -100,6 +110,88 @@ type
     // empty interface
   end;
   
+  
+  ICommandVisitor = interface(IVisitor)
+  ['{628B3A4A-30D1-48D3-8B46-090F08AD2AC8}']
+    procedure VisitComand(const Command: ICommand);
+  end;
+  
+  
+  ICommandMenu = interface(IInterface)
+  ['{3C666D8F-6BED-454B-8BFE-28422943B300}']
+    function AddItem(const Caption: string; Enabled: Boolean): ICommandMenuItem;
+  end;
+  
+  
+  ICommandMenuItem = interface(IInterface)
+  ['{7DFCF2BD-70DA-4DAC-B8D5-C6FB882267CF}']
+    function GetCaption: string;
+    function GetChecked: Boolean;
+    function GetCommand: ICommand;
+    procedure SetCaption(const AValue: string);
+    procedure SetChecked(const AValue: Boolean);
+    procedure SetCommand(const AValue: ICommand);
+    property Caption: string read GetCaption write SetCaption;
+    property Checked: Boolean read GetChecked write SetChecked;
+    property Command: ICommand read GetCommand write SetCommand;
+  end;
+  
+
+  IStringVisitor = interface(IVisitor)
+  ['{DA12355F-0727-41B3-9080-DDAF20797FC5}']
+    procedure VisitString(const Str: IString);
+  end;
+  
+  
+  IMVPModel = interface(IInterface)
+  ['{85223140-B263-4413-89E3-BFA37E9D3112}']
+    function GetCommandSet: ICommandSet;
+    function GetCurrentSelection: ISelection;
+    property CommandSet: ICommandSet read GetCommandSet;
+    property CurrentSelection: ISelection read GetCurrentSelection;
+  end;
+  
+
+  IMVPPresenter = interface(IInterface)
+  ['{5B8477DA-A006-4DE1-B304-9512BFAD7507}']
+    function GetCommandMenu: ICommandMenu;
+    function GetModel: IMVPModel;
+    function GetView: IMVPView;
+    procedure SetCommandMenu(const AValue: ICommandMenu);
+    procedure SetModel(const AValue: IMVPModel);
+    procedure SetView(const AValue: IMVPView);
+    property CommandMenu: ICommandMenu read GetCommandMenu write SetCommandMenu;
+    property Model: IMVPModel read GetModel write SetModel;
+    property View: IMVPView read GetView write SetView;
+  end;
+  
+  
+  IMVPView = interface(IInterface)
+  ['{2C575FE7-BACD-46EC-9D72-AEDA44836B20}']
+    procedure AdoptCommandMenu(const Value: ICommandMenu);
+    procedure OrphanCommandMenu(const Value: ICommandMenu);
+  end;
+  
+  
+  IStringListView = interface(IMVPView)
+  ['{D834710A-9C1A-42D1-A29B-7F9F8FB46426}']
+    function GetOnSelectString: TSelectStringEvent;
+    procedure SetOnSelectString(const AValue: TSelectStringEvent);
+    property OnSelectString: TSelectStringEvent read GetOnSelectString write SetOnSelectString;
+  end;
+
+
+  IStringMoveVisitor = interface(IStringVisitor)
+  ['{DB89C96F-DA90-43ED-A621-51B70E6C600E}']
+    function GetCanDemote: Boolean;
+    function GetCanPromote: Boolean;
+    property CanDemote: Boolean read GetCanDemote;
+    property CanPromote: Boolean read GetCanPromote;
+  end;
+  
+  
+  
+  
 
 implementation
 
diff --git a/extras/tiopf/mvp/fpgui_intf.pas b/extras/tiopf/mvp/fpgui_intf.pas
new file mode 100644
index 00000000..f6e9e4ca
--- /dev/null
+++ b/extras/tiopf/mvp/fpgui_intf.pas
@@ -0,0 +1,22 @@
+unit fpgui_intf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  gui_menu, basic_intf;
+  
+type
+
+  IPopupCommandMenu = interface(IInterface)
+  ['{812C1940-A8BD-4BB4-AE8D-37A912D44A6D}']
+    function GetMenu: TfpgPopupMenu;
+    procedure SetMenu(const AValue: TfpgPopupMenu);
+    property Menu: TfpgPopupMenu read GetMenu write SetMenu;
+  end;
+
+implementation
+
+end.
+
diff --git a/extras/tiopf/mvp/gg_mvp.lpk b/extras/tiopf/mvp/gg_mvp.lpk
index 74080b5c..3c335171 100644
--- a/extras/tiopf/mvp/gg_mvp.lpk
+++ b/extras/tiopf/mvp/gg_mvp.lpk
@@ -5,7 +5,7 @@
     <CompilerOptions>
       <Version Value="5"/>
       <SearchPaths>
-        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
       <CodeGeneration>
         <Generate Value="Faster"/>
@@ -14,7 +14,7 @@
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
-    <Files Count="3">
+    <Files Count="4">
       <Item1>
         <Filename Value="basic_intf.pas"/>
         <UnitName Value="basic_intf"/>
@@ -27,6 +27,10 @@
         <Filename Value="view_impl.pas"/>
         <UnitName Value="view_impl"/>
       </Item3>
+      <Item4>
+        <Filename Value="fpgui_intf.pas"/>
+        <UnitName Value="fpgui_intf"/>
+      </Item4>
     </Files>
     <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">
diff --git a/extras/tiopf/mvp/gg_mvp.pas b/extras/tiopf/mvp/gg_mvp.pas
index 8a19fe85..c8981b1a 100644
--- a/extras/tiopf/mvp/gg_mvp.pas
+++ b/extras/tiopf/mvp/gg_mvp.pas
@@ -7,7 +7,7 @@ unit gg_mvp;
 interface
 
 uses
-  basic_intf, basic_impl, view_impl, LazarusPackageIntf; 
+  basic_intf, basic_impl, view_impl, fpgui_intf, LazarusPackageIntf; 
 
 implementation