1. ------------------------------------------------------------------------------ 
  2. --                  GtkAda - Ada95 binding for Gtk+/Gnome                   -- 
  3. --                                                                          -- 
  4. --      Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet       -- 
  5. --                     Copyright (C) 1998-2014, AdaCore                     -- 
  6. --                                                                          -- 
  7. -- This library is free software;  you can redistribute it and/or modify it -- 
  8. -- under terms of the  GNU General Public License  as published by the Free -- 
  9. -- Software  Foundation;  either version 3,  or (at your  option) any later -- 
  10. -- version. This library is distributed in the hope that it will be useful, -- 
  11. -- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- -- 
  12. -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            -- 
  13. --                                                                          -- 
  14. -- As a special exception under Section 7 of GPL version 3, you are granted -- 
  15. -- additional permissions described in the GCC Runtime Library Exception,   -- 
  16. -- version 3.1, as published by the Free Software Foundation.               -- 
  17. --                                                                          -- 
  18. -- You should have received a copy of the GNU General Public License and    -- 
  19. -- a copy of the GCC Runtime Library Exception along with this program;     -- 
  20. -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    -- 
  21. -- <http://www.gnu.org/licenses/>.                                          -- 
  22. --                                                                          -- 
  23. ------------------------------------------------------------------------------ 
  24.  
  25. --  <description> 
  26. -- 
  27. --  The aim of this package is to provide some services to connect a 
  28. --  handler to a signal emitted by a Gtk Object. To understand the 
  29. --  services provided by this package, some definitions are necessary: 
  30. -- 
  31. --    Signal: A signal is a kind of message that an object wants to 
  32. --    broadcast. All GObjects can emit signals. These messages are 
  33. --    associated to certain events happening during the life of an 
  34. --    object. For instance, when a user clicks on a button, the 
  35. --    "clicked" signal is emitted by the button. 
  36. -- 
  37. --    Handler (or callback): A handler is a function or procedure that 
  38. --    the user "connects" to a signal for a particular object. 
  39. --    Connecting a handler to a signal means associating this handler to 
  40. --    the signal.  When the signal is emitted, all connected handlers 
  41. --    are called back. Usually, the role of those callbacks is to do 
  42. --    some processing triggered by a user action. For instance, when 
  43. --    "clicked" signal is emitted by the "OK" button of a dialog, the 
  44. --    connected handler can be used to close the dialog or recompute 
  45. --    some value. 
  46. -- 
  47. --    In GtkAda, the handlers are defined in a form as general as 
  48. --    possible. The first argument is always an access to the object it 
  49. --    has been connected to. The second object is a table of values 
  50. --    (See Glib.Values for more details about this table). It is the 
  51. --    responsibility of this handler to extract the values from it, and 
  52. --    to convert them to the correct Ada type. 
  53. -- 
  54. --    Because such handlers are not very convenient to use, this package 
  55. --    also provides some services to connect a marshaller instead. It 
  56. --    will then do the extraction work before calling the more 
  57. --    programmer-friendly handler, as defined in Gtk.Marshallers (see 
  58. --    Gtk.Marshallers for more details). 
  59. -- 
  60. --  The subdivision of this package is identical to Gtk.Marshallers; it 
  61. --  is made of four generic sub-packages, each representing one of the 
  62. --  four possible kinds of handlers: they can return a value or not, and 
  63. --  they can have some user specific data associated to them or not. 
  64. --  Selecting the right package depends on the profile of the handler. 
  65. --  For example, the handler for the "delete_event" signal of a 
  66. --  Gtk_Window has a return value, and has an extra parameter (a Gint). 
  67. --  All handlers also have a user_data field by default, but its usage 
  68. --  is optional. To connect a handler to this signal, if the user_data 
  69. --  field is not used, the Return_Callback generic should be 
  70. --  instantiated. On the other hand, if the user_data field is 
  71. --  necessary, then the User_Return_Callback generic should be used. 
  72. -- 
  73. --  Note also that the real handler in Gtk+ should expect at least as 
  74. --  many arguments as in the marshaller you are using. If your 
  75. --  marshaller has one argument, the C handler must have at least one 
  76. --  argument too. 
  77. -- 
  78. --  The common generic parameter to all sub-packages is the widget type, 
  79. --  which is the basic widget manipulated. This can be 
  80. --  Glib.Object.GObject_Record type if you want to reduce the number of 
  81. --  instantiations, but the conversion to the original type will have to be 
  82. --  done inside the handler. 
  83. -- 
  84. --  All sub-packages are organized in the same way. 
  85. -- 
  86. --    First, the type "Handler" is defined. It represents the general 
  87. --    form of the callbacks supported by the sub-package. 
  88. -- 
  89. --    The corresponding sub-package of Gtk.Marshallers is instantiated. 
  90. -- 
  91. --    A series of "Connect" procedures and functions is given. All cases 
  92. --    are covered: the functions return the Handler_Id of the newly 
  93. --    created association, while the procedures just connect the 
  94. --    handler, dropping the Handler_Id; some services allow the user to 
  95. --    connect a Handler while some others allow the usage of 
  96. --    Marshallers, which are more convenient. Note that more than one 
  97. --    handler may be connected to a signal; the handlers will then be 
  98. --    invoked in the order of connection. 
  99. -- 
  100. --    Some "Connect_Object" services are also provided. Those services 
  101. --    never have a user_data. They accept an additional parameter called 
  102. --    Slot_Object. When the callback in invoked, the Gtk Object emitting 
  103. --    the signal is substituted by this Slot_Object. 
  104. --    These callbacks are always automatically disconnected as soon as one 
  105. --    of the two widgets involved is destroyed. 
  106. -- 
  107. --    There are several methods to connect a handler. For each method, 
  108. --    although the option of connecting a Handler is provided, the 
  109. --    recommended way is to use Marshallers. Each connect service is 
  110. --    documented below, in the first sub-package. 
  111. -- 
  112. --    A series of "To_Marshaller" functions are provided. They return 
  113. --    some marshallers for the most commonly used types in order to ease 
  114. --    the usage of this package. Most of the time, it will not be 
  115. --    necessary to use some other marshallers. 
  116. --    For instance, if a signal is documented as receiving a single argument, 
  117. --    the widget (for instance the "clicked" signal for a Gtk_Button), you 
  118. --    will connect to it with: 
  119. --        with Gtkada.Handlers; 
  120. --        procedure On_Clicked (Button : access Gtk_Widget_Record'Class); 
  121. --        ... 
  122. --           Widget_Callback.Connect (Button, "clicked", On_Clicked'Access); 
  123. -- 
  124. --    The simple form above also applies for most handlers that take one 
  125. --    additional argument, for instance the "button_press_event" in 
  126. --    gtk-widget.ads. Just declare your subprogram with the appropriate profile 
  127. --    and connect it, as in: 
  128. --        with Gtkada.Handlers; 
  129. --        procedure On_Button (Widget : access Gtk_Widget_Record'Class; 
  130. --                             Event  : Gdk_Event); 
  131. --        ... 
  132. --           Widget_Callback.Connect (Widget, "button_press_event", 
  133. --                                    On_Button'Access); 
  134. -- 
  135. --    More complex forms of handlers exists however in GtkAda, for which no 
  136. --    predefined marshaller exists. In this case, you have to use the general 
  137. --    form of callbacks. For instance, the "select_row" signal of Gtk.Clist. 
  138. --        with Gtkada.Handlers; 
  139. --        with Gtk.Arguments; 
  140. --        procedure On_Select (Clist : access Gtk_Widget_Record'Class; 
  141. --                             Args  : Glib.Values.GValues) 
  142. --        is 
  143. --           Row : constant Gint := To_Gint (Args, 1); 
  144. --           Column : constant Gint := To_Gint (Args, 2); 
  145. --           Event  : constant Gdk_Event := To_Event (Args, 3); 
  146. --        begin 
  147. --           ... 
  148. --        end On_Select; 
  149. --        ... 
  150. --            Widget_Callback.Connect (Clist, "select_row", On_Select'Access); 
  151. -- 
  152. --    As for the "To_Marshaller" functions, a series of "Emit_By_Name" 
  153. --    procedures are also provided for the same most common types, to 
  154. --    allow the user to easily emit signals. These procedures are mainly 
  155. --    intended for people building new GObjects. 
  156. -- 
  157. --  At the end of this package, some general services related to the 
  158. --  management of signals and handlers are also provided. Each one of 
  159. --  them is documented individually below. 
  160. -- 
  161. --  IMPORTANT NOTE: These packages must be instantiated at library-level 
  162. -- 
  163. --  </description> 
  164. --  <c_version>2.8.17</c_version> 
  165. --  <group>Signal handling</group> 
  166.  
  167. with Cairo; 
  168. with Glib.Values; 
  169. with Gdk.Event; 
  170. with Glib.Object; 
  171. with Gtkada.Bindings;   use Gtkada.Bindings; 
  172. with Gtk.Marshallers; 
  173. pragma Elaborate_All (Gtk.Marshallers); 
  174.  
  175. with Gtk.Tree_Model; 
  176. with Gtk.Widget; 
  177.  
  178. with Unchecked_Conversion; 
  179.  
  180. package Gtk.Handlers is 
  181.  
  182.    --  <doc_ignore> 
  183.  
  184.    pragma Elaborate_Body; 
  185.  
  186.    Null_Handler_Id : constant Gulong := 0; 
  187.  
  188.    type Handler_Id is record 
  189.       Id      : Gulong := Null_Handler_Id; 
  190.       Closure : GClosure; 
  191.    end record; 
  192.    --  This uniquely identifies a connection widget<->signal. 
  193.    --  Closure is an internal data, that you should not use. 
  194.  
  195.    function To_Address (Path : Gtk.Tree_Model.Gtk_Tree_Path) 
  196.       return System.Address; 
  197.  
  198.    procedure Set_On_Exception (Handler : Gtkada.Bindings.Exception_Handler) 
  199.      renames Gtkada.Bindings.Set_On_Exception; 
  200.    --  Set the handler that catch all exceptions occurring in a a callback. An 
  201.    --  exception should never be propagated to C to avoid undefined behavior. 
  202.    --  By default, unhandled exceptions are printed to stderr. 
  203.    --  This function can be used to provide your own global exception handler, 
  204.    --  which presumably will simply log the exception in application-specific 
  205.    --  manner. 
  206.  
  207.    --------------------------------------------------------- 
  208.    --  These handlers should return a value 
  209.    --  They do not have a User_Data 
  210.    --------------------------------------------------------- 
  211.  
  212.    generic 
  213.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  214.       type Return_Type is (<>); 
  215.    package Return_Callback is 
  216.  
  217.       type Handler is access function 
  218.         (Widget : access Widget_Type'Class; 
  219.          Params : Glib.Values.GValues) return Return_Type; 
  220.  
  221.       type Simple_Handler is access function 
  222.         (Widget : access Widget_Type'Class) return Return_Type; 
  223.  
  224.       package Marshallers is new Gtk.Marshallers.Return_Marshallers 
  225.         (Widget_Type, Return_Type); 
  226.  
  227.       --  Connecting a handler to an object 
  228.  
  229.       --  In all the Connect services below, the following arguments 
  230.       --  will be used: 
  231.       --    o Widget, Name: This represents the association (Gtk Object, 
  232.       --      Glib.Signal_Name) to which the handler is to be connected. 
  233.       --    o After: If this boolean is set to True, then the handler 
  234.       --      will be connected after all the default handlers. By 
  235.       --      default, it is set to False. 
  236.  
  237.       procedure Connect 
  238.         (Widget : access Widget_Type'Class; 
  239.          Name   : Glib.Signal_Name; 
  240.          Marsh  : Marshallers.Marshaller; 
  241.          After  : Boolean := False); 
  242.       --  Connects a Marshaller. The Handler_Id is dropped. 
  243.  
  244.       procedure Object_Connect 
  245.         (Widget      : access Glib.Object.GObject_Record'Class; 
  246.          Name        : Glib.Signal_Name; 
  247.          Marsh       : Marshallers.Marshaller; 
  248.          Slot_Object : access Widget_Type'Class; 
  249.          After       : Boolean := False); 
  250.       --  Connect a Marshaller. The Handler_Id is dropped. 
  251.       --  This is automatically disconnected as soon as either Widget or 
  252.       --  Slot_Object is destroyed. 
  253.       --  Slot_Object *must* be of type Gtk_Object or one of its children. 
  254.  
  255.       procedure Connect 
  256.         (Widget : access Widget_Type'Class; 
  257.          Name   : Glib.Signal_Name; 
  258.          Cb     : Simple_Handler; 
  259.          After  : Boolean := False); 
  260.       procedure Object_Connect 
  261.         (Widget      : access Glib.Object.GObject_Record'Class; 
  262.          Name        : Glib.Signal_Name; 
  263.          Cb          : Simple_Handler; 
  264.          Slot_Object : access Widget_Type'Class; 
  265.          After       : Boolean := False); 
  266.       --  Same as above, except with a simple handle with no parameter. This 
  267.       --  is the same as using a To_Marshaller call to the above two 
  268.       --  procedures, except it is shorter to write. 
  269.  
  270.       procedure Connect 
  271.         (Widget : access Widget_Type'Class; 
  272.          Name   : Glib.Signal_Name; 
  273.          Cb     : Handler; 
  274.          After  : Boolean := False); 
  275.       procedure Object_Connect 
  276.         (Widget      : access Glib.Object.GObject_Record'Class; 
  277.          Name        : Glib.Signal_Name; 
  278.          Cb          : Handler; 
  279.          Slot_Object : access Widget_Type'Class; 
  280.          After       : Boolean := False); 
  281.       --  Connect a Handler. The Handler_Id is dropped. 
  282.       --  This is automatically disconnected as soon as either Widget or 
  283.       --  Slot_Object is destroyed. 
  284.       --  Slot_Object *must* be of type Gtk_Object or one of its children. 
  285.  
  286.       pragma Inline (Connect); 
  287.       pragma Inline (Object_Connect); 
  288.  
  289.       function Connect 
  290.         (Widget : access Widget_Type'Class; 
  291.          Name   : Glib.Signal_Name; 
  292.          Marsh  : Marshallers.Marshaller; 
  293.          After  : Boolean := False) return Handler_Id; 
  294.       --  Connects a Marshaller. Returns the Handler_Id. 
  295.  
  296.       function Object_Connect 
  297.         (Widget      : access Glib.Object.GObject_Record'Class; 
  298.          Name        : Glib.Signal_Name; 
  299.          Marsh       : Marshallers.Marshaller; 
  300.          Slot_Object : access Widget_Type'Class; 
  301.          After       : Boolean := False) return Handler_Id; 
  302.       --  Connect a Marshaller. Return the Handler_Id. 
  303.       --  This is automatically disconnected as soon as either Widget or 
  304.       --  Slot_Object is destroyed. 
  305.       --  Slot_Object *must* be of type Gtk_Object or one of its children. 
  306.  
  307.       function Connect 
  308.         (Widget : access Widget_Type'Class; 
  309.          Name   : Glib.Signal_Name; 
  310.          Cb     : Handler; 
  311.          After  : Boolean := False) return Handler_Id; 
  312.       --  Connects a Handler. Returns the Handler_Id. 
  313.  
  314.       function Object_Connect 
  315.         (Widget      : access Glib.Object.GObject_Record'Class; 
  316.          Name        : Glib.Signal_Name; 
  317.          Cb          : Handler; 
  318.          Slot_Object : access Widget_Type'Class; 
  319.          After       : Boolean := False) return Handler_Id; 
  320.       --  Connect a Handler. Returns the Handler_Id. 
  321.       --  This is automatically disconnected as soon as either Widget or 
  322.       --  Slot_Object is destroyed. 
  323.       --  Slot_Object *must* be of type Gtk_Object or one of its children. 
  324.  
  325.       --  Some convenient functions to create marshallers 
  326.  
  327.       package Gint_Marshaller is new Marshallers.Generic_Marshaller 
  328.         (Gint, Glib.Values.Get_Int); 
  329.       package Guint_Marshaller is new Marshallers.Generic_Marshaller 
  330.         (Guint, Glib.Values.Get_Uint); 
  331.       package Event_Marshaller is new Marshallers.Generic_Marshaller 
  332.         (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 
  333.       package Context_Marshaller is new Marshallers.Generic_Marshaller 
  334.         (Cairo.Cairo_Context, Cairo.Get_Context); 
  335.       package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 
  336.         (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 
  337.  
  338.       function To_Marshaller 
  339.         (Cb : Gint_Marshaller.Handler) 
  340.          return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 
  341.  
  342.       function To_Marshaller 
  343.         (Cb : Context_Marshaller.Handler) 
  344.          return Marshallers.Marshaller 
  345.          renames Context_Marshaller.To_Marshaller; 
  346.  
  347.       function To_Marshaller 
  348.         (Cb : Guint_Marshaller.Handler) 
  349.          return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 
  350.  
  351.       function To_Marshaller 
  352.         (Cb : Event_Marshaller.Handler) 
  353.          return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 
  354.  
  355.       function To_Marshaller 
  356.         (Cb : Widget_Marshaller.Handler) 
  357.          return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 
  358.  
  359.       function To_Marshaller 
  360.         (Cb : Marshallers.Void_Marshaller.Handler) 
  361.          return Marshallers.Marshaller 
  362.          renames Marshallers.Void_Marshaller.To_Marshaller; 
  363.  
  364.       --  Emitting a signal 
  365.  
  366.       function Emit_By_Name 
  367.         (Object : access Widget_Type'Class; 
  368.          Name   : Glib.Signal_Name; 
  369.          Param  : Gint) 
  370.          return Return_Type renames Gint_Marshaller.Emit_By_Name; 
  371.  
  372.       function Emit_By_Name 
  373.         (Object : access Widget_Type'Class; 
  374.          Name   : Glib.Signal_Name; 
  375.          Param  : Guint) 
  376.          return Return_Type renames Guint_Marshaller.Emit_By_Name; 
  377.  
  378.       function Emit_By_Name 
  379.         (Object : access Widget_Type'Class; 
  380.          Name   : Glib.Signal_Name; 
  381.          Param  : Gdk.Event.Gdk_Event) return Return_Type; 
  382.  
  383.       function Emit_By_Name 
  384.         (Object : access Widget_Type'Class; 
  385.          Name   : Glib.Signal_Name; 
  386.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  387.          return Return_Type renames Widget_Marshaller.Emit_By_Name; 
  388.  
  389.       function Emit_By_Name 
  390.         (Object : access Widget_Type'Class; 
  391.          Name   : Glib.Signal_Name) 
  392.          return Return_Type renames Marshallers.Void_Marshaller.Emit_By_Name; 
  393.  
  394.    private 
  395.       --  <doc_ignore> 
  396.       type Acc is access all Widget_Type'Class; 
  397.       --  This type has to be declared at library level, otherwise 
  398.       --  Program_Error might be raised when trying to cast from the 
  399.       --  parameter of Marshaller to another type. 
  400.  
  401.       type Data_Type_Record is record 
  402.          Func   : Handler; 
  403.          --  User's callback 
  404.  
  405.          Proxy  : Marshallers.Handler_Proxy := null; 
  406.          --  Handler_Proxy to use 
  407.  
  408.          Object : Acc := null; 
  409.          --  Slot Object for Object_Connect 
  410.       end record; 
  411.       type Data_Type_Access is access all Data_Type_Record; 
  412.       pragma Convention (C, Data_Type_Access); 
  413.       --  Data passed to the C handler 
  414.  
  415.       function Convert is new Unchecked_Conversion 
  416.         (Data_Type_Access, System.Address); 
  417.       function Convert is new Unchecked_Conversion 
  418.         (System.Address, Data_Type_Access); 
  419.  
  420.       procedure Free_Data (Data : Data_Type_Access); 
  421.       pragma Convention (C, Free_Data); 
  422.       --  Free the memory associated with the callback's data 
  423.  
  424.       procedure First_Marshaller 
  425.         (Closure         : GClosure; 
  426.          Return_Value    : Glib.Values.GValue; 
  427.          N_Params        : Guint; 
  428.          Params          : Glib.Values.C_GValues; 
  429.          Invocation_Hint : System.Address; 
  430.          User_Data       : System.Address); 
  431.       pragma Convention (C, First_Marshaller); 
  432.       First_M : constant C_Marshaller := First_Marshaller'Access; 
  433.       --  First level marshaller. This is the function that is actually 
  434.       --  called by gtk+. It then calls the Ada functions as required. 
  435.       -- 
  436.       --  If you get an error here while compiling, this is because you are not 
  437.       --  instantiating this package at library-level. 
  438.       -- 
  439.       --  </doc_ignore> 
  440.  
  441.    end Return_Callback; 
  442.  
  443.    --------------------------------------------------------- 
  444.    --  These handlers should return a value 
  445.    --  They require a User_Data 
  446.    --  See also the package User_Callback_With_Setup 
  447.    --------------------------------------------------------- 
  448.  
  449.    generic 
  450.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  451.       type Return_Type is (<>); 
  452.       type User_Type (<>) is private; 
  453.    package User_Return_Callback is 
  454.  
  455.       type Handler is access function 
  456.         (Widget    : access Widget_Type'Class; 
  457.          Params    : Glib.Values.GValues; 
  458.          User_Data : User_Type) return Return_Type; 
  459.       type Simple_Handler is access function 
  460.         (Widget    : access Widget_Type'Class; 
  461.          User_Data : User_Type) return Return_Type; 
  462.  
  463.       package Marshallers is new Gtk.Marshallers.User_Return_Marshallers 
  464.         (Widget_Type, Return_Type, User_Type); 
  465.  
  466.       --  Connecting a handler to an object 
  467.  
  468.       procedure Connect 
  469.         (Widget    : access Widget_Type'Class; 
  470.          Name      : Glib.Signal_Name; 
  471.          Marsh     : Marshallers.Marshaller; 
  472.          User_Data : User_Type; 
  473.          After     : Boolean := False); 
  474.       procedure Object_Connect 
  475.         (Widget      : access Glib.Object.GObject_Record'Class; 
  476.          Name        : Glib.Signal_Name; 
  477.          Marsh       : Marshallers.Marshaller; 
  478.          Slot_Object : access Widget_Type'Class; 
  479.          User_Data   : User_Type; 
  480.          After       : Boolean := False); 
  481.  
  482.       procedure Connect 
  483.         (Widget    : access Widget_Type'Class; 
  484.          Name      : Glib.Signal_Name; 
  485.          Cb        : Simple_Handler; 
  486.          User_Data : User_Type; 
  487.          After     : Boolean := False); 
  488.       procedure Object_Connect 
  489.         (Widget      : access Glib.Object.GObject_Record'Class; 
  490.          Name        : Glib.Signal_Name; 
  491.          Cb          : Simple_Handler; 
  492.          Slot_Object : access Widget_Type'Class; 
  493.          User_Data   : User_Type; 
  494.          After       : Boolean := False); 
  495.  
  496.       procedure Connect 
  497.         (Widget    : access Widget_Type'Class; 
  498.          Name      : Glib.Signal_Name; 
  499.          Cb        : Handler; 
  500.          User_Data : User_Type; 
  501.          After     : Boolean := False); 
  502.       procedure Object_Connect 
  503.         (Widget      : access Glib.Object.GObject_Record'Class; 
  504.          Name        : Glib.Signal_Name; 
  505.          Cb          : Handler; 
  506.          Slot_Object : access Widget_Type'Class; 
  507.          User_Data   : User_Type; 
  508.          After       : Boolean := False); 
  509.  
  510.       pragma Inline (Connect); 
  511.  
  512.       function Connect 
  513.         (Widget    : access Widget_Type'Class; 
  514.          Name      : Glib.Signal_Name; 
  515.          Marsh     : Marshallers.Marshaller; 
  516.          User_Data : User_Type; 
  517.          After     : Boolean := False) return Handler_Id; 
  518.  
  519.       function Object_Connect 
  520.         (Widget      : access Glib.Object.GObject_Record'Class; 
  521.          Name        : Glib.Signal_Name; 
  522.          Marsh       : Marshallers.Marshaller; 
  523.          Slot_Object : access Widget_Type'Class; 
  524.          User_Data   : User_Type; 
  525.          After       : Boolean := False) return Handler_Id; 
  526.  
  527.       function Connect 
  528.         (Widget    : access Widget_Type'Class; 
  529.          Name      : Glib.Signal_Name; 
  530.          Cb        : Handler; 
  531.          User_Data : User_Type; 
  532.          After     : Boolean := False) return Handler_Id; 
  533.  
  534.       function Object_Connect 
  535.         (Widget      : access Glib.Object.GObject_Record'Class; 
  536.          Name        : Glib.Signal_Name; 
  537.          Cb          : Handler; 
  538.          Slot_Object : access Widget_Type'Class; 
  539.          User_Data   : User_Type; 
  540.          After       : Boolean := False) return Handler_Id; 
  541.  
  542.       --  Some convenient functions to create marshallers 
  543.  
  544.       package Gint_Marshaller is new Marshallers.Generic_Marshaller 
  545.         (Gint, Glib.Values.Get_Int); 
  546.       package Guint_Marshaller is new Marshallers.Generic_Marshaller 
  547.         (Guint, Glib.Values.Get_Uint); 
  548.       package Event_Marshaller is new Marshallers.Generic_Marshaller 
  549.         (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 
  550.       package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 
  551.         (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 
  552.  
  553.       function To_Marshaller 
  554.         (Cb : Gint_Marshaller.Handler) 
  555.          return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 
  556.  
  557.       function To_Marshaller 
  558.         (Cb : Guint_Marshaller.Handler) 
  559.          return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 
  560.  
  561.       function To_Marshaller 
  562.         (Cb : Event_Marshaller.Handler) 
  563.          return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 
  564.  
  565.       function To_Marshaller 
  566.         (Cb : Widget_Marshaller.Handler) 
  567.          return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 
  568.  
  569.       function To_Marshaller 
  570.         (Cb : Marshallers.Void_Marshaller.Handler) 
  571.          return Marshallers.Marshaller 
  572.          renames Marshallers.Void_Marshaller.To_Marshaller; 
  573.  
  574.       --  Emitting a signal 
  575.  
  576.       function Emit_By_Name 
  577.         (Object : access Widget_Type'Class; 
  578.          Name   : Glib.Signal_Name; 
  579.          Param  : Gint) 
  580.          return Return_Type renames Gint_Marshaller.Emit_By_Name; 
  581.  
  582.       function Emit_By_Name 
  583.         (Object : access Widget_Type'Class; 
  584.          Name   : Glib.Signal_Name; 
  585.          Param  : Guint) 
  586.          return Return_Type renames Guint_Marshaller.Emit_By_Name; 
  587.  
  588.       function Emit_By_Name 
  589.         (Object : access Widget_Type'Class; 
  590.          Name   : Glib.Signal_Name; 
  591.          Param  : Gdk.Event.Gdk_Event) return Return_Type; 
  592.  
  593.       function Emit_By_Name 
  594.         (Object : access Widget_Type'Class; 
  595.          Name   : Glib.Signal_Name; 
  596.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  597.          return Return_Type renames Widget_Marshaller.Emit_By_Name; 
  598.  
  599.       function Emit_By_Name 
  600.         (Object : access Widget_Type'Class; 
  601.          Name   : Glib.Signal_Name) 
  602.          return Return_Type renames Marshallers.Void_Marshaller.Emit_By_Name; 
  603.  
  604.    private 
  605.       --  <doc_ignore> 
  606.       type Acc is access all Widget_Type'Class; 
  607.       --  This type has to be declared at library level, otherwise 
  608.       --  Program_Error might be raised when trying to cast from the 
  609.       --  parameter of Marshaller to another type. 
  610.  
  611.       type User_Access is access User_Type; 
  612.       type Data_Type_Record is record 
  613.          Func   : Handler; 
  614.          --  User's callback 
  615.  
  616.          Proxy  : Marshallers.Handler_Proxy := null; 
  617.          --  Handler_Proxy to use 
  618.  
  619.          User   : User_Access := null; 
  620.          Object : Acc := null; 
  621.          --  Slot Object for Object_Connect 
  622.       end record; 
  623.       type Data_Type_Access is access all Data_Type_Record; 
  624.       pragma Convention (C, Data_Type_Access); 
  625.       --  Data passed to the C handler 
  626.  
  627.       function Convert is new Unchecked_Conversion 
  628.         (Data_Type_Access, System.Address); 
  629.       function Convert is new Unchecked_Conversion 
  630.         (System.Address, Data_Type_Access); 
  631.  
  632.       procedure Free_Data (Data : Data_Type_Access); 
  633.       pragma Convention (C, Free_Data); 
  634.       --  Free the memory associated with the callback's data 
  635.  
  636.       procedure First_Marshaller 
  637.         (Closure         : GClosure; 
  638.          Return_Value    : Glib.Values.GValue; 
  639.          N_Params        : Guint; 
  640.          Params          : Glib.Values.C_GValues; 
  641.          Invocation_Hint : System.Address; 
  642.          User_Data       : System.Address); 
  643.       pragma Convention (C, First_Marshaller); 
  644.       First_M : constant C_Marshaller := First_Marshaller'Access; 
  645.       --  First level marshaller. This is the function that is actually 
  646.       --  called by gtk+. It then calls the Ada functions as required. 
  647.       --  </doc_ignore> 
  648.  
  649.    end User_Return_Callback; 
  650.  
  651.    ------------------------------------- 
  652.    -- User_Return_Callback_With_Setup -- 
  653.    ------------------------------------- 
  654.    --  This package is basically the same as User_Return_Callback, except that 
  655.    --  an extra function (Setup) is called after a handler has been 
  656.    --  connected. Typical usage is to automatically call Add_Watch (see below) 
  657.    --  in case the User_Type is (or contains) widgets. 
  658.  
  659.    generic 
  660.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  661.       type Return_Type is (<>); 
  662.       type User_Type (<>) is private; 
  663.       with procedure Setup (User_Data : User_Type; Id : Handler_Id); 
  664.    package User_Return_Callback_With_Setup is 
  665.  
  666.       package Internal_Cb is new User_Return_Callback 
  667.         (Widget_Type, Return_Type, User_Type); 
  668.  
  669.       subtype Handler is Internal_Cb.Handler; 
  670.       subtype Simple_Handler is Internal_Cb.Simple_Handler; 
  671.       package Marshallers renames Internal_Cb.Marshallers; 
  672.  
  673.       --  Connecting a handler to an object 
  674.  
  675.       procedure Connect 
  676.         (Widget    : access Widget_Type'Class; 
  677.          Name      : Glib.Signal_Name; 
  678.          Marsh     : Marshallers.Marshaller; 
  679.          User_Data : User_Type; 
  680.          After     : Boolean := False); 
  681.       procedure Object_Connect 
  682.         (Widget      : access Glib.Object.GObject_Record'Class; 
  683.          Name        : Glib.Signal_Name; 
  684.          Marsh       : Marshallers.Marshaller; 
  685.          Slot_Object : access Widget_Type'Class; 
  686.          User_Data   : User_Type; 
  687.          After       : Boolean := False); 
  688.  
  689.       procedure Connect 
  690.         (Widget    : access Widget_Type'Class; 
  691.          Name      : Glib.Signal_Name; 
  692.          Cb        : Handler; 
  693.          User_Data : User_Type; 
  694.          After     : Boolean := False); 
  695.       procedure Object_Connect 
  696.         (Widget      : access Glib.Object.GObject_Record'Class; 
  697.          Name        : Glib.Signal_Name; 
  698.          Cb          : Handler; 
  699.          Slot_Object : access Widget_Type'Class; 
  700.          User_Data   : User_Type; 
  701.          After       : Boolean := False); 
  702.  
  703.       procedure Connect 
  704.         (Widget    : access Widget_Type'Class; 
  705.          Name      : Glib.Signal_Name; 
  706.          Cb        : Simple_Handler; 
  707.          User_Data : User_Type; 
  708.          After     : Boolean := False); 
  709.       procedure Object_Connect 
  710.         (Widget      : access Glib.Object.GObject_Record'Class; 
  711.          Name        : Glib.Signal_Name; 
  712.          Cb          : Simple_Handler; 
  713.          Slot_Object : access Widget_Type'Class; 
  714.          User_Data   : User_Type; 
  715.          After       : Boolean := False); 
  716.  
  717.       pragma Inline (Connect); 
  718.  
  719.       function Connect 
  720.         (Widget    : access Widget_Type'Class; 
  721.          Name      : Glib.Signal_Name; 
  722.          Marsh     : Marshallers.Marshaller; 
  723.          User_Data : User_Type; 
  724.          After     : Boolean := False) return Handler_Id; 
  725.  
  726.       function Object_Connect 
  727.         (Widget      : access Glib.Object.GObject_Record'Class; 
  728.          Name        : Glib.Signal_Name; 
  729.          Marsh       : Marshallers.Marshaller; 
  730.          Slot_Object : access Widget_Type'Class; 
  731.          User_Data   : User_Type; 
  732.          After       : Boolean := False) return Handler_Id; 
  733.  
  734.       function Connect 
  735.         (Widget    : access Widget_Type'Class; 
  736.          Name      : Glib.Signal_Name; 
  737.          Cb        : Handler; 
  738.          User_Data : User_Type; 
  739.          After     : Boolean := False) return Handler_Id; 
  740.  
  741.       function Object_Connect 
  742.         (Widget      : access Glib.Object.GObject_Record'Class; 
  743.          Name        : Glib.Signal_Name; 
  744.          Cb          : Handler; 
  745.          Slot_Object : access Widget_Type'Class; 
  746.          User_Data   : User_Type; 
  747.          After       : Boolean := False) return Handler_Id; 
  748.  
  749.       --  Some convenient functions to create marshallers 
  750.  
  751.       package Gint_Marshaller renames Internal_Cb.Gint_Marshaller; 
  752.       package Guint_Marshaller renames Internal_Cb.Guint_Marshaller; 
  753.       package Event_Marshaller renames Internal_Cb.Event_Marshaller; 
  754.       package Widget_Marshaller renames Internal_Cb.Widget_Marshaller; 
  755.  
  756.       function To_Marshaller 
  757.         (Cb : Gint_Marshaller.Handler) 
  758.          return Internal_Cb.Marshallers.Marshaller 
  759.          renames Internal_Cb.To_Marshaller; 
  760.       function To_Marshaller 
  761.         (Cb : Guint_Marshaller.Handler) 
  762.          return Internal_Cb.Marshallers.Marshaller 
  763.          renames Internal_Cb.To_Marshaller; 
  764.       function To_Marshaller 
  765.         (Cb : Event_Marshaller.Handler) 
  766.          return Internal_Cb.Marshallers.Marshaller 
  767.          renames Internal_Cb.To_Marshaller; 
  768.       function To_Marshaller 
  769.         (Cb : Widget_Marshaller.Handler) 
  770.          return Internal_Cb.Marshallers.Marshaller 
  771.          renames Internal_Cb.To_Marshaller; 
  772.       function To_Marshaller 
  773.         (Cb : Internal_Cb.Marshallers.Void_Marshaller.Handler) 
  774.          return Internal_Cb.Marshallers.Marshaller 
  775.          renames Internal_Cb.To_Marshaller; 
  776.  
  777.       --  Emitting a signal 
  778.  
  779.       function Emit_By_Name 
  780.         (Object : access Widget_Type'Class; 
  781.          Name   : Glib.Signal_Name; 
  782.          Param  : Gint) return Return_Type renames Internal_Cb.Emit_By_Name; 
  783.  
  784.       function Emit_By_Name 
  785.         (Object : access Widget_Type'Class; 
  786.          Name   : Glib.Signal_Name; 
  787.          Param  : Guint) return Return_Type renames Internal_Cb.Emit_By_Name; 
  788.  
  789.       function Emit_By_Name 
  790.         (Object : access Widget_Type'Class; 
  791.          Name   : Glib.Signal_Name; 
  792.          Param  : Gdk.Event.Gdk_Event) return Return_Type 
  793.          renames Internal_Cb.Emit_By_Name; 
  794.  
  795.       function Emit_By_Name 
  796.         (Object : access Widget_Type'Class; 
  797.          Name   : Glib.Signal_Name; 
  798.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  799.          return Return_Type renames Internal_Cb.Emit_By_Name; 
  800.  
  801.       function Emit_By_Name 
  802.         (Object : access Widget_Type'Class; 
  803.          Name   : Glib.Signal_Name) 
  804.          return Return_Type renames Internal_Cb.Emit_By_Name; 
  805.  
  806.    end User_Return_Callback_With_Setup; 
  807.  
  808.    --------------------------------------------------------- 
  809.    --  These handlers do not return a value 
  810.    --  They do not have a User_Data 
  811.    --------------------------------------------------------- 
  812.  
  813.    generic 
  814.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  815.    package Callback is 
  816.  
  817.       type Handler is access procedure 
  818.         (Widget : access Widget_Type'Class; 
  819.          Params : Glib.Values.GValues); 
  820.       type Simple_Handler is access procedure 
  821.         (Widget : access Widget_Type'Class); 
  822.  
  823.       package Marshallers is new 
  824.         Gtk.Marshallers.Void_Marshallers (Widget_Type); 
  825.  
  826.       --  Connecting a handler to an object 
  827.  
  828.       procedure Connect 
  829.         (Widget : access Widget_Type'Class; 
  830.          Name   : Glib.Signal_Name; 
  831.          Marsh  : Marshallers.Marshaller; 
  832.          After  : Boolean := False); 
  833.       procedure Object_Connect 
  834.         (Widget      : access Glib.Object.GObject_Record'Class; 
  835.          Name        : Glib.Signal_Name; 
  836.          Marsh       : Marshallers.Marshaller; 
  837.          Slot_Object : access Widget_Type'Class; 
  838.          After       : Boolean := False); 
  839.  
  840.       procedure Connect 
  841.         (Widget : access Widget_Type'Class; 
  842.          Name   : Glib.Signal_Name; 
  843.          Cb     : Handler; 
  844.          After  : Boolean := False); 
  845.       procedure Object_Connect 
  846.         (Widget      : access Glib.Object.GObject_Record'Class; 
  847.          Name        : Glib.Signal_Name; 
  848.          Cb          : Handler; 
  849.          Slot_Object : access Widget_Type'Class; 
  850.          After       : Boolean := False); 
  851.  
  852.       procedure Connect 
  853.         (Widget : access Widget_Type'Class; 
  854.          Name   : Glib.Signal_Name; 
  855.          Cb     : Simple_Handler; 
  856.          After  : Boolean := False); 
  857.       procedure Object_Connect 
  858.         (Widget      : access Glib.Object.GObject_Record'Class; 
  859.          Name        : Glib.Signal_Name; 
  860.          Cb          : Simple_Handler; 
  861.          Slot_Object : access Widget_Type'Class; 
  862.          After       : Boolean := False); 
  863.  
  864.       pragma Inline (Connect); 
  865.       pragma Inline (Object_Connect); 
  866.  
  867.       function Connect 
  868.         (Widget : access Widget_Type'Class; 
  869.          Name   : Glib.Signal_Name; 
  870.          Marsh  : Marshallers.Marshaller; 
  871.          After  : Boolean := False) return Handler_Id; 
  872.  
  873.       function Object_Connect 
  874.         (Widget      : access Glib.Object.GObject_Record'Class; 
  875.          Name        : Glib.Signal_Name; 
  876.          Marsh       : Marshallers.Marshaller; 
  877.          Slot_Object : access Widget_Type'Class; 
  878.          After       : Boolean := False) return Handler_Id; 
  879.  
  880.       function Connect 
  881.         (Widget : access Widget_Type'Class; 
  882.          Name   : Glib.Signal_Name; 
  883.          Cb     : Handler; 
  884.          After  : Boolean := False) return Handler_Id; 
  885.  
  886.       function Object_Connect 
  887.         (Widget      : access Glib.Object.GObject_Record'Class; 
  888.          Name        : Glib.Signal_Name; 
  889.          Cb          : Handler; 
  890.          Slot_Object : access Widget_Type'Class; 
  891.          After       : Boolean := False) return Handler_Id; 
  892.  
  893.       --  Some convenient functions to create marshallers 
  894.  
  895.       package Gint_Marshaller is new Marshallers.Generic_Marshaller 
  896.         (Gint, Glib.Values.Get_Int); 
  897.       package Guint_Marshaller is new Marshallers.Generic_Marshaller 
  898.         (Guint, Glib.Values.Get_Uint); 
  899.       package Event_Marshaller is new Marshallers.Generic_Marshaller 
  900.         (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 
  901.       package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 
  902.         (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 
  903.       package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller 
  904.         (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 
  905.       package Tree_Iter_Tree_Path_Marshaller is 
  906.          new Marshallers.Generic_Marshaller_2 
  907.                (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter, 
  908.                 Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 
  909.       package Tree_Path_Tree_Iter_Marshaller is 
  910.          new Marshallers.Generic_Marshaller_2 
  911.                (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path, 
  912.                 Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter); 
  913.  
  914.       function To_Marshaller 
  915.         (Cb : Gint_Marshaller.Handler) 
  916.          return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 
  917.  
  918.       function To_Marshaller 
  919.         (Cb : Guint_Marshaller.Handler) 
  920.          return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 
  921.  
  922.       function To_Marshaller 
  923.         (Cb : Event_Marshaller.Handler) 
  924.          return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 
  925.  
  926.       function To_Marshaller 
  927.         (Cb : Widget_Marshaller.Handler) 
  928.          return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 
  929.  
  930.       function To_Marshaller 
  931.         (Cb : Marshallers.Void_Marshaller.Handler) 
  932.          return Marshallers.Marshaller 
  933.          renames Marshallers.Void_Marshaller.To_Marshaller; 
  934.  
  935.       function To_Marshaller 
  936.         (Cb : Tree_Path_Marshaller.Handler) 
  937.          return Marshallers.Marshaller 
  938.          renames Tree_Path_Marshaller.To_Marshaller; 
  939.  
  940.       function To_Marshaller 
  941.         (Cb : Tree_Iter_Tree_Path_Marshaller.Handler) 
  942.          return Marshallers.Marshaller 
  943.          renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller; 
  944.  
  945.       function To_Marshaller 
  946.         (Cb : Tree_Path_Tree_Iter_Marshaller.Handler) 
  947.          return Marshallers.Marshaller 
  948.          renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller; 
  949.  
  950.       --  Emitting a signal 
  951.  
  952.       procedure Emit_By_Name 
  953.         (Object : access Widget_Type'Class; 
  954.          Name   : Glib.Signal_Name; 
  955.          Param  : Gint) renames Gint_Marshaller.Emit_By_Name; 
  956.  
  957.       procedure Emit_By_Name 
  958.         (Object : access Widget_Type'Class; 
  959.          Name   : Glib.Signal_Name; 
  960.          Param  : Guint) renames Guint_Marshaller.Emit_By_Name; 
  961.  
  962.       procedure Emit_By_Name 
  963.          (Object : access Widget_Type'Class; 
  964.           Name   : Glib.Signal_Name; 
  965.           Param  : Gdk.Event.Gdk_Event); 
  966.  
  967.       procedure Emit_By_Name 
  968.         (Object : access Widget_Type'Class; 
  969.          Name   : Glib.Signal_Name; 
  970.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  971.          renames Widget_Marshaller.Emit_By_Name; 
  972.  
  973.       procedure Emit_By_Name 
  974.         (Object : access Widget_Type'Class; 
  975.          Name   : Glib.Signal_Name) 
  976.          renames Marshallers.Void_Marshaller.Emit_By_Name; 
  977.  
  978.       procedure Emit_By_Name is 
  979.         new Tree_Path_Marshaller.Emit_By_Name_Generic 
  980.               (To_Address); 
  981.  
  982.       procedure Emit_By_Name is 
  983.         new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic 
  984.               (Gtk.Tree_Model.To_Address, 
  985.                To_Address); 
  986.  
  987.       procedure Emit_By_Name is 
  988.         new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic 
  989.               (To_Address, 
  990.                Gtk.Tree_Model.To_Address); 
  991.  
  992.    private 
  993.       --  <doc_ignore> 
  994.       type Acc is access all Widget_Type'Class; 
  995.       --  This type has to be declared at library level, otherwise 
  996.       --  Program_Error might be raised when trying to cast from the 
  997.       --  parameter of Marshaller to another type. 
  998.  
  999.       type Data_Type_Record is record 
  1000.          Func   : Handler;             --  User's callback 
  1001.          Proxy  : Marshallers.Handler_Proxy := null;  --  Handler_Proxy to use 
  1002.          Object : Acc := null;         --  Slot Object for Object_Connect 
  1003.       end record; 
  1004.       type Data_Type_Access is access all Data_Type_Record; 
  1005.       pragma Convention (C, Data_Type_Access); 
  1006.       --  Data passed to the C handler 
  1007.  
  1008.       function Convert is new Unchecked_Conversion 
  1009.         (Data_Type_Access, System.Address); 
  1010.       function Convert is new Unchecked_Conversion 
  1011.         (System.Address, Data_Type_Access); 
  1012.  
  1013.       procedure Free_Data (Data : Data_Type_Access); 
  1014.       pragma Convention (C, Free_Data); 
  1015.       --  Free the memory associated with the callback's data 
  1016.  
  1017.       procedure First_Marshaller 
  1018.         (Closure         : GClosure; 
  1019.          Return_Value    : Glib.Values.GValue; 
  1020.          N_Params        : Guint; 
  1021.          Params          : Glib.Values.C_GValues; 
  1022.          Invocation_Hint : System.Address; 
  1023.          User_Data       : System.Address); 
  1024.       pragma Convention (C, First_Marshaller); 
  1025.       First_M : constant C_Marshaller := First_Marshaller'Access; 
  1026.       --  First level marshaller. This is the function that is actually 
  1027.       --  called by gtk+. It then calls the Ada functions as required. 
  1028.       --  </doc_ignore> 
  1029.  
  1030.    end Callback; 
  1031.  
  1032.    --------------------------------------------------------- 
  1033.    --  These handlers do not return a value 
  1034.    --  They require a User_Data 
  1035.    --  See also the package User_Callback_With_Setup 
  1036.    --------------------------------------------------------- 
  1037.  
  1038.    generic 
  1039.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  1040.       type User_Type (<>) is private; 
  1041.    package User_Callback is 
  1042.  
  1043.       type Handler is access procedure 
  1044.         (Widget    : access Widget_Type'Class; 
  1045.          Params    : Glib.Values.GValues; 
  1046.          User_Data : User_Type); 
  1047.       type Simple_Handler is access procedure 
  1048.         (Widget    : access Widget_Type'Class; 
  1049.          User_Data : User_Type); 
  1050.  
  1051.       package Marshallers is new 
  1052.         Gtk.Marshallers.User_Void_Marshallers (Widget_Type, User_Type); 
  1053.  
  1054.       --  Connecting a handler to an object 
  1055.  
  1056.       procedure Connect 
  1057.         (Widget    : access Widget_Type'Class; 
  1058.          Name      : Glib.Signal_Name; 
  1059.          Marsh     : Marshallers.Marshaller; 
  1060.          User_Data : User_Type; 
  1061.          After     : Boolean := False); 
  1062.       procedure Object_Connect 
  1063.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1064.          Name        : Glib.Signal_Name; 
  1065.          Marsh       : Marshallers.Marshaller; 
  1066.          Slot_Object : access Widget_Type'Class; 
  1067.          User_Data   : User_Type; 
  1068.          After       : Boolean := False); 
  1069.  
  1070.       procedure Connect 
  1071.         (Widget    : access Widget_Type'Class; 
  1072.          Name      : Glib.Signal_Name; 
  1073.          Cb        : Handler; 
  1074.          User_Data : User_Type; 
  1075.          After     : Boolean := False); 
  1076.       procedure Object_Connect 
  1077.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1078.          Name        : Glib.Signal_Name; 
  1079.          Cb          : Handler; 
  1080.          Slot_Object : access Widget_Type'Class; 
  1081.          User_Data   : User_Type; 
  1082.          After       : Boolean := False); 
  1083.  
  1084.       procedure Connect 
  1085.         (Widget    : access Widget_Type'Class; 
  1086.          Name      : Glib.Signal_Name; 
  1087.          Cb        : Simple_Handler; 
  1088.          User_Data : User_Type; 
  1089.          After     : Boolean := False); 
  1090.       procedure Object_Connect 
  1091.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1092.          Name        : Glib.Signal_Name; 
  1093.          Cb          : Simple_Handler; 
  1094.          Slot_Object : access Widget_Type'Class; 
  1095.          User_Data   : User_Type; 
  1096.          After       : Boolean := False); 
  1097.  
  1098.       pragma Inline (Connect); 
  1099.  
  1100.       function Connect 
  1101.         (Widget    : access Widget_Type'Class; 
  1102.          Name      : Glib.Signal_Name; 
  1103.          Marsh     : Marshallers.Marshaller; 
  1104.          User_Data : User_Type; 
  1105.          After     : Boolean := False) return Handler_Id; 
  1106.  
  1107.       function Object_Connect 
  1108.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1109.          Name        : Glib.Signal_Name; 
  1110.          Marsh       : Marshallers.Marshaller; 
  1111.          Slot_Object : access Widget_Type'Class; 
  1112.          User_Data   : User_Type; 
  1113.          After       : Boolean := False) return Handler_Id; 
  1114.  
  1115.       function Connect 
  1116.         (Widget    : access Widget_Type'Class; 
  1117.          Name      : Glib.Signal_Name; 
  1118.          Cb        : Handler; 
  1119.          User_Data : User_Type; 
  1120.          After     : Boolean := False) return Handler_Id; 
  1121.  
  1122.       function Object_Connect 
  1123.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1124.          Name        : Glib.Signal_Name; 
  1125.          Cb          : Handler; 
  1126.          Slot_Object : access Widget_Type'Class; 
  1127.          User_Data   : User_Type; 
  1128.          After       : Boolean := False) return Handler_Id; 
  1129.  
  1130.       --  Some convenient functions to create marshallers 
  1131.  
  1132.       package Gint_Marshaller is new Marshallers.Generic_Marshaller 
  1133.         (Gint, Glib.Values.Get_Int); 
  1134.       package Guint_Marshaller is new Marshallers.Generic_Marshaller 
  1135.         (Guint, Glib.Values.Get_Uint); 
  1136.       package Event_Marshaller is new Marshallers.Generic_Marshaller 
  1137.         (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 
  1138.       package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 
  1139.         (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 
  1140.       package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller 
  1141.         (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 
  1142.       package Tree_Iter_Tree_Path_Marshaller is 
  1143.          new Marshallers.Generic_Marshaller_2 
  1144.                (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter, 
  1145.                 Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 
  1146.       package Tree_Path_Tree_Iter_Marshaller is 
  1147.          new Marshallers.Generic_Marshaller_2 
  1148.                (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path, 
  1149.                 Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter); 
  1150.  
  1151.       function To_Marshaller 
  1152.         (Cb : Gint_Marshaller.Handler) 
  1153.          return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 
  1154.  
  1155.       function To_Marshaller 
  1156.         (Cb : Guint_Marshaller.Handler) 
  1157.          return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 
  1158.  
  1159.       function To_Marshaller 
  1160.         (Cb : Event_Marshaller.Handler) 
  1161.          return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 
  1162.  
  1163.       function To_Marshaller 
  1164.         (Cb : Widget_Marshaller.Handler) 
  1165.          return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 
  1166.  
  1167.       function To_Marshaller 
  1168.         (Cb : Marshallers.Void_Marshaller.Handler) 
  1169.          return Marshallers.Marshaller 
  1170.          renames Marshallers.Void_Marshaller.To_Marshaller; 
  1171.  
  1172.       function To_Marshaller 
  1173.         (Cb : Tree_Path_Marshaller.Handler) 
  1174.          return Marshallers.Marshaller 
  1175.          renames Tree_Path_Marshaller.To_Marshaller; 
  1176.  
  1177.       function To_Marshaller 
  1178.         (Cb : Tree_Iter_Tree_Path_Marshaller.Handler) 
  1179.          return Marshallers.Marshaller 
  1180.          renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller; 
  1181.  
  1182.       function To_Marshaller 
  1183.         (Cb : Tree_Path_Tree_Iter_Marshaller.Handler) 
  1184.          return Marshallers.Marshaller 
  1185.          renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller; 
  1186.  
  1187.       --  Emitting a signal 
  1188.  
  1189.       procedure Emit_By_Name 
  1190.         (Object : access Widget_Type'Class; 
  1191.          Name   : Glib.Signal_Name; 
  1192.          Param  : Gint) renames Gint_Marshaller.Emit_By_Name; 
  1193.  
  1194.       procedure Emit_By_Name 
  1195.         (Object : access Widget_Type'Class; 
  1196.          Name   : Glib.Signal_Name; 
  1197.          Param  : Guint) renames Guint_Marshaller.Emit_By_Name; 
  1198.  
  1199.       procedure Emit_By_Name 
  1200.         (Object : access Widget_Type'Class; 
  1201.          Name   : Glib.Signal_Name; 
  1202.          Param  : Gdk.Event.Gdk_Event); 
  1203.  
  1204.       procedure Emit_By_Name 
  1205.         (Object : access Widget_Type'Class; 
  1206.          Name   : Glib.Signal_Name; 
  1207.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  1208.          renames Widget_Marshaller.Emit_By_Name; 
  1209.  
  1210.       procedure Emit_By_Name 
  1211.         (Object : access Widget_Type'Class; 
  1212.          Name   : Glib.Signal_Name) 
  1213.          renames Marshallers.Void_Marshaller.Emit_By_Name; 
  1214.  
  1215.       procedure Emit_By_Name is 
  1216.         new Tree_Path_Marshaller.Emit_By_Name_Generic 
  1217.               (To_Address); 
  1218.  
  1219.       procedure Emit_By_Name is 
  1220.         new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic 
  1221.               (Gtk.Tree_Model.To_Address, 
  1222.                To_Address); 
  1223.  
  1224.       procedure Emit_By_Name is 
  1225.         new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic 
  1226.               (To_Address, 
  1227.                Gtk.Tree_Model.To_Address); 
  1228.  
  1229.    private 
  1230.       --  <doc_ignore> 
  1231.       type Acc is access all Widget_Type'Class; 
  1232.       --  This type has to be declared at library level, otherwise 
  1233.       --  Program_Error might be raised when trying to cast from the 
  1234.       --  parameter of Marshaller to another type. 
  1235.  
  1236.       type User_Access is access User_Type; 
  1237.       type Data_Type_Record is record 
  1238.          Func   : Handler; 
  1239.          --  User's callback 
  1240.  
  1241.          Proxy  : Marshallers.Handler_Proxy := null; 
  1242.          --  Handler_Proxy to use 
  1243.  
  1244.          User   : User_Access := null; 
  1245.          Object : Acc := null; 
  1246.          --  Slot_Object for Object_Connect 
  1247.       end record; 
  1248.       type Data_Type_Access is access all Data_Type_Record; 
  1249.       pragma Convention (C, Data_Type_Access); 
  1250.       --  Data passed to the C handler 
  1251.  
  1252.       function Convert is new Unchecked_Conversion 
  1253.         (Data_Type_Access, System.Address); 
  1254.       function Convert is new Unchecked_Conversion 
  1255.         (System.Address, Data_Type_Access); 
  1256.  
  1257.       procedure Free_Data (Data : Data_Type_Access); 
  1258.       pragma Convention (C, Free_Data); 
  1259.       --  Free the memory associated with the callback's data 
  1260.  
  1261.       procedure First_Marshaller 
  1262.         (Closure         : GClosure; 
  1263.          Return_Value    : Glib.Values.GValue; 
  1264.          N_Params        : Guint; 
  1265.          Params          : Glib.Values.C_GValues; 
  1266.          Invocation_Hint : System.Address; 
  1267.          User_Data       : System.Address); 
  1268.       pragma Convention (C, First_Marshaller); 
  1269.       First_M : constant C_Marshaller := First_Marshaller'Access; 
  1270.       --  First level marshaller. This is the function that is actually 
  1271.       --  called by gtk+. It then calls the Ada functions as required. 
  1272.       --  </doc_ignore> 
  1273.  
  1274.    end User_Callback; 
  1275.  
  1276.    ------------------------------ 
  1277.    -- User_Callback_With_Setup -- 
  1278.    ------------------------------ 
  1279.    --  This package is basically the same as User_Callback, except that an 
  1280.    --  extra function (Setup) is called after a handler has been 
  1281.    --  connected. Typical usage is to automatically call Add_Watch (see below) 
  1282.    --  in case the User_Type is (or contains) widgets. 
  1283.  
  1284.    generic 
  1285.       type Widget_Type is new Glib.Object.GObject_Record with private; 
  1286.       type User_Type (<>) is private; 
  1287.       with procedure Setup (User_Data : User_Type; Id : Handler_Id); 
  1288.    package User_Callback_With_Setup is 
  1289.  
  1290.       package Internal_Cb is new User_Callback (Widget_Type, User_Type); 
  1291.       package Marshallers renames Internal_Cb.Marshallers; 
  1292.  
  1293.       subtype Handler is Internal_Cb.Handler; 
  1294.       subtype Simple_Handler is Internal_Cb.Simple_Handler; 
  1295.  
  1296.       --  Connecting a handler to an object 
  1297.  
  1298.       procedure Connect 
  1299.         (Widget    : access Widget_Type'Class; 
  1300.          Name      : Glib.Signal_Name; 
  1301.          Marsh     : Marshallers.Marshaller; 
  1302.          User_Data : User_Type; 
  1303.          After     : Boolean := False); 
  1304.       procedure Object_Connect 
  1305.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1306.          Name        : Glib.Signal_Name; 
  1307.          Marsh       : Marshallers.Marshaller; 
  1308.          Slot_Object : access Widget_Type'Class; 
  1309.          User_Data   : User_Type; 
  1310.          After       : Boolean := False); 
  1311.  
  1312.       procedure Connect 
  1313.         (Widget    : access Widget_Type'Class; 
  1314.          Name      : Glib.Signal_Name; 
  1315.          Cb        : Handler; 
  1316.          User_Data : User_Type; 
  1317.          After     : Boolean := False); 
  1318.       procedure Object_Connect 
  1319.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1320.          Name        : Glib.Signal_Name; 
  1321.          Cb          : Handler; 
  1322.          Slot_Object : access Widget_Type'Class; 
  1323.          User_Data   : User_Type; 
  1324.          After       : Boolean := False); 
  1325.  
  1326.       procedure Connect 
  1327.         (Widget    : access Widget_Type'Class; 
  1328.          Name      : Glib.Signal_Name; 
  1329.          Cb        : Simple_Handler; 
  1330.          User_Data : User_Type; 
  1331.          After     : Boolean := False); 
  1332.       procedure Object_Connect 
  1333.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1334.          Name        : Glib.Signal_Name; 
  1335.          Cb          : Simple_Handler; 
  1336.          Slot_Object : access Widget_Type'Class; 
  1337.          User_Data   : User_Type; 
  1338.          After       : Boolean := False); 
  1339.  
  1340.       pragma Inline (Connect); 
  1341.  
  1342.       function Connect 
  1343.         (Widget    : access Widget_Type'Class; 
  1344.          Name      : Glib.Signal_Name; 
  1345.          Marsh     : Marshallers.Marshaller; 
  1346.          User_Data : User_Type; 
  1347.          After     : Boolean := False) return Handler_Id; 
  1348.  
  1349.       function Object_Connect 
  1350.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1351.          Name        : Glib.Signal_Name; 
  1352.          Marsh       : Marshallers.Marshaller; 
  1353.          Slot_Object : access Widget_Type'Class; 
  1354.          User_Data   : User_Type; 
  1355.          After       : Boolean := False) return Handler_Id; 
  1356.  
  1357.       function Connect 
  1358.         (Widget    : access Widget_Type'Class; 
  1359.          Name      : Glib.Signal_Name; 
  1360.          Cb        : Handler; 
  1361.          User_Data : User_Type; 
  1362.          After     : Boolean := False) return Handler_Id; 
  1363.  
  1364.       function Object_Connect 
  1365.         (Widget      : access Glib.Object.GObject_Record'Class; 
  1366.          Name        : Glib.Signal_Name; 
  1367.          Cb          : Handler; 
  1368.          Slot_Object : access Widget_Type'Class; 
  1369.          User_Data   : User_Type; 
  1370.          After       : Boolean := False) return Handler_Id; 
  1371.  
  1372.       --  Some convenient functions to create marshallers 
  1373.  
  1374.       package Gint_Marshaller renames Internal_Cb.Gint_Marshaller; 
  1375.       package Guint_Marshaller renames Internal_Cb.Guint_Marshaller; 
  1376.       package Event_Marshaller renames Internal_Cb.Event_Marshaller; 
  1377.       package Widget_Marshaller renames Internal_Cb.Widget_Marshaller; 
  1378.  
  1379.       function To_Marshaller 
  1380.         (Cb : Gint_Marshaller.Handler) 
  1381.          return Internal_Cb.Marshallers.Marshaller 
  1382.          renames Internal_Cb.To_Marshaller; 
  1383.       function To_Marshaller 
  1384.         (Cb : Guint_Marshaller.Handler) 
  1385.          return Internal_Cb.Marshallers.Marshaller 
  1386.          renames Internal_Cb.To_Marshaller; 
  1387.       function To_Marshaller 
  1388.         (Cb : Event_Marshaller.Handler) 
  1389.          return Internal_Cb.Marshallers.Marshaller 
  1390.          renames Internal_Cb.To_Marshaller; 
  1391.       function To_Marshaller 
  1392.         (Cb : Widget_Marshaller.Handler) 
  1393.          return Internal_Cb.Marshallers.Marshaller 
  1394.          renames Internal_Cb.To_Marshaller; 
  1395.       function To_Marshaller 
  1396.         (Cb : Internal_Cb.Marshallers.Void_Marshaller.Handler) 
  1397.          return Internal_Cb.Marshallers.Marshaller 
  1398.          renames Internal_Cb.To_Marshaller; 
  1399.  
  1400.       --  Emitting a signal 
  1401.  
  1402.       procedure Emit_By_Name 
  1403.         (Object : access Widget_Type'Class; 
  1404.          Name   : Glib.Signal_Name; 
  1405.          Param  : Gint) renames Internal_Cb.Emit_By_Name; 
  1406.  
  1407.       procedure Emit_By_Name 
  1408.         (Object : access Widget_Type'Class; 
  1409.          Name   : Glib.Signal_Name; 
  1410.          Param  : Guint) renames Internal_Cb.Emit_By_Name; 
  1411.  
  1412.       procedure Emit_By_Name 
  1413.         (Object : access Widget_Type'Class; 
  1414.          Name   : Glib.Signal_Name; 
  1415.          Param  : Gdk.Event.Gdk_Event) renames Internal_Cb.Emit_By_Name; 
  1416.  
  1417.       procedure Emit_By_Name 
  1418.         (Object : access Widget_Type'Class; 
  1419.          Name   : Glib.Signal_Name; 
  1420.          Param  : access Gtk.Widget.Gtk_Widget_Record'Class) 
  1421.          renames Internal_Cb.Emit_By_Name; 
  1422.  
  1423.       procedure Emit_By_Name 
  1424.         (Object : access Widget_Type'Class; 
  1425.          Name   : Glib.Signal_Name) renames Internal_Cb.Emit_By_Name; 
  1426.  
  1427.    end User_Callback_With_Setup; 
  1428.  
  1429.    ------------------------------------------------------------------ 
  1430.    --  General functions 
  1431.    ------------------------------------------------------------------ 
  1432.  
  1433.    procedure Add_Watch 
  1434.      (Id : Handler_Id; Object : access Glib.Object.GObject_Record'Class); 
  1435.    --  Make sure that when Object is destroyed, the handler Id is also 
  1436.    --  destroyed. This function should mostly be used in cases where you use a 
  1437.    --  User_Data that is Object. If you don't destroy the callback at the same 
  1438.    --  time, then the next time the callback is called it will try to access 
  1439.    --  some invalid memory (Object being destroyed), and you will likely get a 
  1440.    --  Storage_Error. 
  1441.  
  1442.    procedure Disconnect 
  1443.      (Object : access Glib.Object.GObject_Record'Class; 
  1444.       Id     : in out Handler_Id); 
  1445.    --  Disconnect the handler identified by the given Handler_Id. 
  1446.  
  1447.    procedure Emit_Stop_By_Name 
  1448.      (Object : access Glib.Object.GObject_Record'Class; 
  1449.       Name   : Glib.Signal_Name); 
  1450.    --  During a signal emission, invoking this procedure will halt the 
  1451.    --  emission. 
  1452.  
  1453.    procedure Handler_Block 
  1454.      (Obj : access Glib.Object.GObject_Record'Class; 
  1455.       Id  : Handler_Id); 
  1456.    --  Blocks temporily the signal. For each call to this procedure, 
  1457.    --  a call to Handler_Unblock must be performed in order to really 
  1458.    --  unblock the signal. 
  1459.  
  1460.    procedure Handlers_Destroy 
  1461.      (Obj : access Glib.Object.GObject_Record'Class); 
  1462.    --  Destroys all the handlers associated to the given object. 
  1463.  
  1464.    procedure Handler_Unblock 
  1465.      (Obj : access Glib.Object.GObject_Record'Class; 
  1466.       Id  : Handler_Id); 
  1467.    --  See Handler_Block. 
  1468.  
  1469.    -------------- 
  1470.    -- Internal -- 
  1471.    -------------- 
  1472.    --  The following subprograms are used internally by GtkAda, and should not 
  1473.    --  be used directly from applications. 
  1474.  
  1475.    function Do_Signal_Connect 
  1476.      (Object              : Glib.Object.GObject; 
  1477.       Name                : Glib.Signal_Name; 
  1478.       Marshaller          : C_Marshaller; 
  1479.       Handler             : System.Address; 
  1480.       Func_Data           : System.Address; 
  1481.       Destroy             : System.Address; 
  1482.       After               : Boolean; 
  1483.       Slot_Object         : System.Address := System.Null_Address; 
  1484.       Expect_Return_Value : Boolean) return Handler_Id; 
  1485.    --  Internal function used to connect the signal. 
  1486.    --  * Object is the object that will emit the signal. 
  1487.    --  * Marshaller is the C convention subprogram that will be called directly 
  1488.    --    by gtk+, and is in charge of translating the arguments into a form 
  1489.    --    suitable for calling the user's Handler callback. This subprogram 
  1490.    --    does not check the profile of the Handler and whether the Marshaller 
  1491.    --    will call it with the proper format, so is potentially dangerous. 
  1492.    --  * Func_Data is an extra parameter passed to Handler by the Marshaller. 
  1493.    --    It might be ignored, depending on the Marshaller. 
  1494.    --  * Destroy is called when the handler is destroyed, for instance because 
  1495.    --    the object itself is destroyed. 
  1496.    --  * After indicates whether the handler is called after or before the 
  1497.    --    default handler set by gtk+ for this signal. 
  1498.    --  * Slot_Object is the object passed to the handler, if any. When this 
  1499.    --    object is destroyed, the handler should be automatically disconnected. 
  1500.    --    This object is not automatically connected to the handler, only the 
  1501.    --    watch to destroy the handler is set in place. 
  1502.    --  * Expect_Return_Value should be true if the user is connecting a 
  1503.    --    function to the signal, False if he is connecting a procedure. This is 
  1504.    --    used to check that the user has used the proper form of handler. 
  1505.  
  1506.    --  </doc_ignore> 
  1507.  
  1508. end Gtk.Handlers; 
  1509.  
  1510. --  <example> 
  1511. --  --  This example connects the "delete_event" signal to a widget. 
  1512. --  --  The handlers for this signal get an extra argument which is 
  1513. --  --  the Gdk_Event that generated the signal. 
  1514. -- 
  1515. --  with Gtk.Handlers;    use Gtk.Handlers; 
  1516. --  with Gtk.Marshallers; use Gtk.Marshallers; 
  1517. -- 
  1518. --  function My_Cb (Widget : access Gtk_Widget_Record'Class; 
  1519. --                  Event  : Gdk.Event.Gdk_Event) 
  1520. --                  return Gint; 
  1521. --  --  your own function 
  1522. -- 
  1523. --  package Return_Widget_Cb is new Gtk.Handlers.Return_Callback 
  1524. --     (Gtk.Widget.Gtk_Widget_Record, Gint); 
  1525. -- 
  1526. --  Return_Widget_Cb.Connect (W, "delete_event", 
  1527. --     Return_Widget_Cb.To_Marshaller (My_Cb'Access)); 
  1528. -- 
  1529. --  </example>