1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. -- The Simple_Button_Listener class provides a mechanism for registering any 
  10. -- method of a class, matching a certain prototype, as a button action handler. 
  11. -- The two handler prototypes are: a simple procedure in a target class, or a 
  12. -- procedure that also accepts a Button_Action as an argument. 
  13. -- 
  14. -- Instantiate this package with the class and class-wide access type of an 
  15. -- object that will handle button actions. 
  16. generic 
  17.     type Target (<>) is tagged limited private; 
  18. package Widgets.Buttons.Simple_Listeners is 
  19.  
  20.     type A_Handler1 is access 
  21.         procedure( object : not null access Target'Class ); 
  22.  
  23.     type A_Handler2 is access 
  24.         procedure( object : not null access Target'Class; 
  25.                    action : A_Button_Action ); 
  26.  
  27.     -- Invokes the 'handler' method of 'obj' for button actions matching 'id'. 
  28.     function Listener( id      : Action_Id; 
  29.                        obj     : access Target'Class; 
  30.                        handler : not null A_Handler1 ) return A_Button_Listener; 
  31.     pragma Postcondition( Listener'Result /= null ); 
  32.  
  33.     -- Invokes the 'handler' method of 'obj' for button actions matching 'id'. 
  34.     function Listener( id      : Action_Id; 
  35.                        obj     : access Target'Class; 
  36.                        handler : not null A_Handler2 ) return A_Button_Listener; 
  37.     pragma Postcondition( Listener'Result /= null ); 
  38.  
  39.     -- Invokes the 'handler' method of 'obj' for Click button actions. 
  40.     function Listener( obj     : access Target'Class; 
  41.                        handler : not null A_Handler1 ) return A_Button_Listener; 
  42.     pragma Postcondition( Listener'Result /= null ); 
  43.  
  44.     -- Invokes the 'handler' method of 'obj' for Click button actions. 
  45.     function Listener( obj     : access Target'Class; 
  46.                        handler : not null A_Handler2 ) return A_Button_Listener; 
  47.     pragma Postcondition( Listener'Result /= null ); 
  48.  
  49. private 
  50.  
  51.     type Simple_Button_Listener is new Simple_Action_Listener and 
  52.                                        Button_Listener with 
  53.         record 
  54.             id       : Action_Id; 
  55.             object   : access Target'Class := null; 
  56.             handler1 : A_Handler1 := null; 
  57.             handler2 : A_Handler2 := null; 
  58.         end record; 
  59.  
  60.     -- Invokes the handler procedure of the simple button listener's target. 
  61.     procedure Handle_Action( this   : access Simple_Button_Listener; 
  62.                              action : A_Button_Action ); 
  63.  
  64. end Widgets.Buttons.Simple_Listeners;