1. with Actions; 
  2.  
  3. private with Ada.Containers.Doubly_Linked_Lists; 
  4.  
  5. pragma Warnings( Off, Actions ); 
  6. pragma Elaborate_All( Actions ); 
  7.  
  8. package Widgets.Buttons.Groups is 
  9.  
  10.     type Button_Group_Action is new Action with private; 
  11.     type A_Button_Group_Action is access all Button_Group_Action'Class; 
  12.  
  13.     Group_Cleared : constant Action_Id; 
  14.     Group_Set     : constant Action_Id; 
  15.  
  16.     type A_Button_Group_Listener is 
  17.         access procedure( action : A_Button_Group_Action ); 
  18.  
  19.     ---------------------------------------------------------------------------- 
  20.  
  21.     type Button_Group is new Object and Button_Listener with private; 
  22.     type A_Button_Group is access all Button_Group'Class; 
  23.  
  24.     -- Creates a new, empty button group. 
  25.     function Create_Button_Group return A_Button_Group; 
  26.     pragma Postcondition( Create_Button_Group'Result /= null ); 
  27.  
  28.     -- Adds a button to the group's membership. 
  29.     procedure Add( this : access Button_Group; button : not null A_Button ); 
  30.  
  31.     -- Adds a button group listener to be notified of actions. Listeners can be 
  32.     -- added multiple times. 
  33.     procedure Add_Listener( this     : access Button_Group; 
  34.                             listener : not null A_Button_Group_Listener ); 
  35.  
  36.     -- Removes all buttons from the group's membership. 
  37.     procedure Clear( this : access Button_Group ); 
  38.  
  39.     -- Removes a button group listener from the listener list. If 'listener' 
  40.     -- isn't already listening then nothing happens. 
  41.     procedure Remove_Listener( this     : access Button_Group; 
  42.                                listener : not null A_Button_Group_Listener ); 
  43.  
  44.     -- Changes whether or not the active button in the group is allowed to be 
  45.     -- unselected. If 'keep' is set True then the active button on a tool group, 
  46.     -- once pressed, can't be unpressed. 
  47.     procedure Set_Keep_Selected( this : access Button_Group; keep : Boolean ); 
  48.  
  49.     -- Unpresses the active button in the group, if there is one. This will have 
  50.     -- no effect if the 'keep selected' option has been set unless 'force' is 
  51.     -- set True. 
  52.     procedure Unset( this  : access Button_Group; 
  53.                      force : Boolean := False ); 
  54.  
  55.     -- Deletes the button group. 
  56.     procedure Delete( this : in out A_Button_Group ); 
  57.     pragma Postcondition( this = null ); 
  58.  
  59. private 
  60.  
  61.     package Action_Listeners is new Ada.Containers.Doubly_Linked_Lists( A_Button_Group_Listener, "=" ); 
  62.     use Action_Listeners; 
  63.  
  64.     package Button_Collection is new Ada.Containers.Doubly_Linked_Lists( A_Button, "=" ); 
  65.     use Button_Collection; 
  66.  
  67.     ---------------------------------------------------------------------------- 
  68.  
  69.     type Button_Group_Action is new Action with null record; 
  70.  
  71.     Group_Cleared : constant Action_Id := To_Action_Id( "button_group.cleared" ); 
  72.     Group_Set     : constant Action_Id := To_Action_Id( "button_group.set" ); 
  73.  
  74.     procedure Delete( this : in out A_Button_Group_Action ); 
  75.     pragma Postcondition( this = null ); 
  76.  
  77.     ---------------------------------------------------------------------------- 
  78.  
  79.     type Button_Group is new Object and Button_Listener with 
  80.         record 
  81.             buttons       : Button_Collection.List; 
  82.             pressed       : A_Button := null; 
  83.             keep_selected : Boolean := True;  -- force a button to remain selected 
  84.             listeners     : Action_Listeners.List; 
  85.         end record; 
  86.  
  87.     procedure Delete( this : in out Button_Group ); 
  88.  
  89.     procedure Dispatch_Action( this   : access Button_Group; 
  90.                                id     : Action_Id; 
  91.                                source : not null A_Widget ); 
  92.  
  93.     procedure Handle_Action( this   : access Button_Group; 
  94.                              action : A_Button_Action ); 
  95.  
  96.     -- action has an action_id (hashed string) 
  97.     -- button_action extends action 
  98.     -- determine the type of button action by looking at the action.id 
  99.     -- for something like input_action, get the text from the input_action passed to the handler 
  100.     -- widgets store list of generic action listeners 
  101.     --   specific widget types allow adding specific action listeners 
  102.     --   recast from generic collection in widget class to specific listeners when dispatching action 
  103.  
  104.     function To_String( this : access Button_Group ) return String; 
  105.  
  106. end Widgets.Buttons.Groups;