1. ------------------------------------------------------------------------------ 
  2. --               GtkAda - Ada95 binding for the Gimp Toolkit                -- 
  3. --                                                                          -- 
  4. --                     Copyright (C) 2006-2014, AdaCore                     -- 
  5. --                                                                          -- 
  6. -- This library is free software;  you can redistribute it and/or modify it -- 
  7. -- under terms of the  GNU General Public License  as published by the Free -- 
  8. -- Software  Foundation;  either version 3,  or (at your  option) any later -- 
  9. -- version. This library is distributed in the hope that it will be useful, -- 
  10. -- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- -- 
  11. -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            -- 
  12. --                                                                          -- 
  13. -- As a special exception under Section 7 of GPL version 3, you are granted -- 
  14. -- additional permissions described in the GCC Runtime Library Exception,   -- 
  15. -- version 3.1, as published by the Free Software Foundation.               -- 
  16. --                                                                          -- 
  17. -- You should have received a copy of the GNU General Public License and    -- 
  18. -- a copy of the GCC Runtime Library Exception along with this program;     -- 
  19. -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    -- 
  20. -- <http://www.gnu.org/licenses/>.                                          -- 
  21. --                                                                          -- 
  22. ------------------------------------------------------------------------------ 
  23.  
  24. --  This is a unit purely internal to GtkAda, to ease binding and avoid code 
  25. --  duplication. 
  26. --  Do not use in your own applications, since the interface might change from 
  27. --  release to release. 
  28. --  See also Gtkada.Types 
  29.  
  30. pragma Ada_2005; 
  31.  
  32. with Ada.Exceptions; 
  33. with Glib; 
  34. with Glib.Object; 
  35. with Glib.Types; 
  36. with Glib.Values; 
  37. with Gtkada.C; 
  38. with GNAT.Strings; 
  39. with Interfaces.C.Strings; 
  40. with System; 
  41.  
  42. package Gtkada.Bindings is 
  43.    package ICS renames Interfaces.C.Strings; 
  44.  
  45.    generic 
  46.       type T is private; 
  47.       Null_T : T; 
  48.       with function "=" (T1, T2 : T) return Boolean is <>; 
  49.    function Generic_To_Address_Or_Null 
  50.      (Val : System.Address) return System.Address; 
  51.    --  Return either a Null_Address or a pointer to Val, depending on 
  52.    --  whether Val is the null value for the type. 
  53.    --  In all cases, Val is supposed to be an access to T. 
  54.    --  In Ada2012, these could be replaced with expression functions instead. 
  55.  
  56.    function Value_And_Free 
  57.      (Str : Interfaces.C.Strings.chars_ptr) return String; 
  58.    --  Returns the value stored in Str, and free the memory occupied by Str. 
  59.  
  60.    function Value_Allowing_Null 
  61.      (Str : Interfaces.C.Strings.chars_ptr) return String; 
  62.    --  Return the value stored in Str, and an empty string if Str is null. 
  63.  
  64.    ------------- 
  65.    -- Strings -- 
  66.    ------------- 
  67.  
  68.    function String_Or_Null (S : String) return ICS.chars_ptr; 
  69.    --  Return Null_Ptr if S is the empty string, or a newly allocated string 
  70.    --  otherwise. This is intended mostly for the binding itself. 
  71.  
  72.    type chars_ptr_array_access 
  73.      is access ICS.chars_ptr_array (Interfaces.C.size_t); 
  74.    pragma Convention (C, chars_ptr_array_access); 
  75.    --  Suitable for a C function that returns a gchar** 
  76.  
  77.    procedure g_strfreev (Str_Array : chars_ptr_array_access); 
  78.    --  Thin binding to C function of the same name.  Frees a null-terminated 
  79.    --  array of strings, and the array itself.  If called on a null value, 
  80.    --  simply return. 
  81.  
  82.    function To_String_List 
  83.      (C : ICS.chars_ptr_array) return GNAT.Strings.String_List; 
  84.    --  Converts C into a String_List. Returned value must be freed by caller, 
  85.    --  as well as C. C is NULL terminated. 
  86.  
  87.    function To_String_List_And_Free 
  88.      (C : chars_ptr_array_access) return GNAT.Strings.String_List; 
  89.    --  Converts C into a String_List, and frees C. 
  90.    --  Returned value must be freed by caller. 
  91.  
  92.    function To_String_List 
  93.      (C : ICS.chars_ptr_array; N : Glib.Gint) 
  94.       return GNAT.Strings.String_List; 
  95.    --  Converts C into a String_List. N is the number of elements in C. 
  96.    --  Returned value must be freed by caller, as well as C. 
  97.  
  98.    function From_String_List 
  99.      (C : GNAT.Strings.String_List) return ICS.chars_ptr_array; 
  100.    --  Converts C into a chars_ptr_array. Returned value must be freed by 
  101.    --  caller, as well as C. 
  102.  
  103.    function To_Chars_Ptr 
  104.      (C : chars_ptr_array_access) return ICS.chars_ptr_array; 
  105.    --  Return a bounded array that contains the same strings as C (so you 
  106.    --  shouldn't free C). 'Last applies to the result, whereas it doesn't to C. 
  107.  
  108.    ------------ 
  109.    -- Arrays -- 
  110.    ------------ 
  111.    --  See Gtkada.C for more information. 
  112.    --  The packages that are commented out are instanciated in various, 
  113.    --  possibly duplicated places. This is because of elaboration circularity 
  114.    --  issues. 
  115.  
  116.    package Gint_Arrays is new Gtkada.C.Unbounded_Arrays 
  117.      (Glib.Gint, 0, Natural, Glib.Gint_Array); 
  118.    package Pspec_Arrays is new Gtkada.C.Unbounded_Arrays 
  119.      (Glib.Param_Spec, null, Natural, Glib.Param_Spec_Array); 
  120.    package GType_Arrays is new Gtkada.C.Unbounded_Arrays 
  121.      (Glib.GType, Glib.GType_None, Glib.Guint, Glib.GType_Array); 
  122.  
  123.    function To_Gint_Array_Zero_Terminated 
  124.      (Arr : Gint_Arrays.Unbounded_Array_Access) 
  125.       return Glib.Gint_Array; 
  126.    --  Converts Arr, stopping at the first 0 encountered 
  127.  
  128.    ------------- 
  129.    -- Signals -- 
  130.    ------------- 
  131.  
  132.    type GClosure is new Glib.C_Proxy; 
  133.  
  134.    type C_Marshaller is access procedure 
  135.      (Closure         : GClosure; 
  136.       Return_Value    : Glib.Values.GValue;  --  Will contain returned value 
  137.       N_Params        : Glib.Guint;          --  Number of entries in Params 
  138.       Params          : Glib.Values.C_GValues; 
  139.       Invocation_Hint : System.Address; 
  140.       Marsh_Data      : System.Address); 
  141.    pragma Convention (C, C_Marshaller); 
  142.    --  A function called directly from gtk+ when dispatching signals to 
  143.    --  handlers. This procedure is in charge of converting the parameters from 
  144.    --  the array of GValues in Params to suitable formats for calling the 
  145.    --  proper Ada handler given by the user. This handler is encoded in the 
  146.    --  user_data, which has an actual type specific to each of the generic 
  147.    --  packages below. 
  148.    --  Marsh_Data is the data passed via Set_Meta_Marshal, null otherwise. 
  149.    --  This is meant for internal GtkAda use only. 
  150.  
  151.    function CClosure_New 
  152.      (Callback  : System.Address; 
  153.       User_Data : System.Address; 
  154.       Destroy   : System.Address) return GClosure; 
  155.    pragma Import (C, CClosure_New, "g_cclosure_new"); 
  156.  
  157.    procedure Set_Marshal (Closure : GClosure; Marshaller : C_Marshaller); 
  158.    pragma Import (C, Set_Marshal, "g_closure_set_marshal"); 
  159.  
  160.    procedure Set_Meta_Marshal 
  161.      (Closure    : GClosure; 
  162.       Marsh_Data : System.Address; 
  163.       Marshaller : C_Marshaller); 
  164.    pragma Import (C, Set_Meta_Marshal, "g_closure_set_meta_marshal"); 
  165.  
  166.    function Get_Data (Closure : GClosure) return System.Address; 
  167.    pragma Import (C, Get_Data, "ada_gclosure_get_data"); 
  168.  
  169.    function Get_Callback (C : GClosure) return System.Address; 
  170.    pragma Import (C, Get_Callback, "ada_cclosure_get_callback"); 
  171.    --  Return the user handler set in the closure. This is the procedure that 
  172.    --  should process the signal. 
  173.  
  174.    procedure Watch_Closure (Object : System.Address; Closure : GClosure); 
  175.    pragma Import (C, Watch_Closure, "g_object_watch_closure"); 
  176.    --  The closure will be destroyed when Object is destroyed. 
  177.  
  178.    procedure Unchecked_Do_Signal_Connect 
  179.      (Object              : not null access Glib.Object.GObject_Record'Class; 
  180.       C_Name              : Glib.Signal_Name; 
  181.       Marshaller          : C_Marshaller; 
  182.       Handler             : System.Address; 
  183.       Destroy             : System.Address := System.Null_Address; 
  184.       After               : Boolean := False; 
  185.       Slot_Object         : access Glib.Object.GObject_Record'Class := null); 
  186.    procedure Unchecked_Do_Signal_Connect 
  187.      (Object              : Glib.Types.GType_Interface; 
  188.       C_Name              : Glib.Signal_Name; 
  189.       Marshaller          : C_Marshaller; 
  190.       Handler             : System.Address; 
  191.       Destroy             : System.Address := System.Null_Address; 
  192.       After               : Boolean := False; 
  193.       Slot_Object         : access Glib.Object.GObject_Record'Class := null); 
  194.    --  Same as above, but this removes a number of check, like whether the 
  195.    --  signal exists, and whether the user has properly passed a procedure or 
  196.    --  function depending on the signal type. 
  197.    -- 
  198.    --  * C_Name must be NUL-terminated. 
  199.  
  200.    procedure Set_Value (Value : Glib.Values.GValue; Val : System.Address); 
  201.    pragma Import (C, Set_Value, "ada_gvalue_set"); 
  202.    --  Function used internally to specify the value returned by a callback. 
  203.    --  Val will be dereferenced as appropriate, depending on the type expected 
  204.    --  by Value. 
  205.  
  206.    type Exception_Handler is not null access procedure 
  207.       (Occurrence : Ada.Exceptions.Exception_Occurrence); 
  208.  
  209.    procedure Set_On_Exception (Handler : Exception_Handler); 
  210.    --  See user documentation in Gtk.Handlers.Set_On_Exception 
  211.  
  212.    procedure Process_Exception (E : Ada.Exceptions.Exception_Occurrence); 
  213.    --  Process the exception through the handler set by Set_On_Exception. 
  214.    --  This procedure never raises an exception. 
  215.  
  216. private 
  217.    pragma Import (C, g_strfreev, "g_strfreev"); 
  218. end Gtkada.Bindings;