1-----------------------------------------------------------------------
2--               GtkAda - Ada95 binding for Gtk+/Gnome               --
3--                                                                   --
4--                 Copyright (C) 2000-2013, AdaCore                  --
5--                                                                   --
6-- This library is free software; you can redistribute it and/or     --
7-- modify it under the terms of the GNU General Public               --
8-- License as published by the Free Software Foundation; either      --
9-- version 2 of the License, or (at your option) any later version.  --
10--                                                                   --
11-- This library is distributed in the hope that it will be useful,   --
12-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
14-- General Public License for more details.                          --
15--                                                                   --
16-- You should have received a copy of the GNU General Public         --
17-- License along with this library; if not, write to the             --
18-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
19-- Boston, MA 02111-1307, USA.                                       --
20--                                                                   --
21-- As a special exception, if other files instantiate generics from  --
22-- this unit, or you link this unit with other files to produce an   --
23-- executable, this  unit  does not  by itself cause  the resulting  --
24-- executable to be covered by the GNU General Public License. This  --
25-- exception does not however invalidate any other reasons why the   --
26-- executable file  might be covered by the  GNU Public License.     --
27-----------------------------------------------------------------------
28
29with System;
30with Interfaces.C.Strings;
31
32with Glib.Type_Conversion_Hooks;
33
34package body Gtk.Tooltips is
35
36   package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator
37     (Get_Type'Access, Gtk_Tooltips_Record);
38   pragma Warnings (Off, Type_Conversion);
39
40   ------------
41   -- Enable --
42   ------------
43
44   procedure Enable (Tooltips : access Gtk_Tooltips_Record) is
45      procedure Internal (Tooltips : System.Address);
46      pragma Import (C, Internal, "gtk_tooltips_enable");
47
48   begin
49      Internal (Get_Object (Tooltips));
50   end Enable;
51
52   -------------
53   -- Disable --
54   -------------
55
56   procedure Disable (Tooltips : access Gtk_Tooltips_Record) is
57      procedure Internal (Tooltips : System.Address);
58      pragma Import (C, Internal, "gtk_tooltips_disable");
59
60   begin
61      Internal (Get_Object (Tooltips));
62   end Disable;
63
64   -------------
65   -- Gtk_New --
66   -------------
67
68   procedure Gtk_New (Widget : out Gtk_Tooltips) is
69   begin
70      Widget := new Gtk_Tooltips_Record;
71      Gtk.Tooltips.Initialize (Widget);
72   end Gtk_New;
73
74   ----------------
75   -- Initialize --
76   ----------------
77
78   procedure Initialize (Widget : access Gtk_Tooltips_Record'Class) is
79      function Internal return System.Address;
80      pragma Import (C, Internal, "gtk_tooltips_new");
81
82   begin
83      Set_Object (Widget, Internal);
84   end Initialize;
85
86   ------------------
87   -- Force_Window --
88   ------------------
89
90   procedure Force_Window (Widget : access Gtk_Tooltips_Record) is
91      procedure Internal (Widget : System.Address);
92      pragma Import (C, Internal, "gtk_tooltips_force_window");
93
94   begin
95      Internal (Get_Object (Widget));
96   end Force_Window;
97
98   ---------------
99   -- Set_Delay --
100   ---------------
101
102   procedure Set_Delay
103     (Tooltips : access Gtk_Tooltips_Record;
104      Duration : Guint := 500)
105   is
106      procedure Internal (Tooltips : System.Address; Duration : Guint);
107      pragma Import (C, Internal, "gtk_tooltips_set_delay");
108
109   begin
110      Internal (Get_Object (Tooltips), Duration);
111   end Set_Delay;
112
113   -------------
114   -- Set_Tip --
115   -------------
116
117   procedure Set_Tip
118     (Tooltips    : access Gtk_Tooltips_Record;
119      Widget      : access Gtk.Widget.Gtk_Widget_Record'Class;
120      Tip_Text    : UTF8_String;
121      Tip_Private : UTF8_String := "")
122   is
123      procedure Internal
124        (Tooltips    : System.Address;
125         Widget      : System.Address;
126         Tip_Text    : UTF8_String;
127         Tip_Private : UTF8_String);
128      pragma Import (C, Internal, "gtk_tooltips_set_tip");
129
130   begin
131      Internal (Get_Object (Tooltips), Get_Object (Widget),
132                Tip_Text & ASCII.NUL,
133                Tip_Private & ASCII.NUL);
134   end Set_Tip;
135
136   --------------
137   -- Get_Data --
138   --------------
139
140   function Get_Data
141     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class) return Tooltips_Data
142   is
143      type C_Data is record
144         Tooltips : System.Address;
145         Widget   : System.Address;
146         Text     : Interfaces.C.Strings.chars_ptr;
147         Privat   : Interfaces.C.Strings.chars_ptr;
148      end record;
149      pragma Convention (C, C_Data);
150      --  keep in sync with the C structure.
151
152      type C_Data_Access is access C_Data;
153      pragma Convention (C, C_Data_Access);
154
155      function Internal (Widget : System.Address) return C_Data_Access;
156      pragma Import (C, Internal, "gtk_tooltips_data_get");
157
158      Ptr  : constant C_Data_Access := Internal (Get_Object (Widget));
159      T    : constant String := Interfaces.C.Strings.Value (Ptr.Text);
160      P    : constant String := Interfaces.C.Strings.Value (Ptr.Privat);
161      Data : Tooltips_Data (Text_Length    => T'Length,
162                            Private_Length => P'Length);
163      Stub : Gtk_Tooltips_Record;
164
165   begin
166      Data.Tooltips     := Gtk_Tooltips (Get_User_Data (Ptr.Tooltips, Stub));
167      Data.Widget       := Gtk.Widget.Gtk_Widget (Widget);
168      Data.Text         := T;
169      Data.Text_Private := P;
170      return Data;
171   end Get_Data;
172
173   ----------------
174   -- Set_Markup --
175   ----------------
176
177   procedure Set_Markup
178     (Tooltips : access Gtk_Tooltips_Record;
179      Text     : UTF8_String)
180   is
181      procedure Internal
182        (Tooltips : System.Address;
183         Text     : UTF8_String);
184      procedure Internal
185        (Tooltips : System.Address;
186         Text     : System.Address);
187      pragma Import (C, Internal, "gtk_tooltip_set_markup");
188
189   begin
190      if Text /= "" then
191         Internal (Get_Object (Tooltips), Text & ASCII.NUL);
192
193      else
194         Internal (Get_Object (Tooltips), System.Null_Address);
195      end if;
196   end Set_Markup;
197
198   -------------------------
199   -- Set_Icon_From_Stock --
200   -------------------------
201
202   procedure Set_Icon_From_Stock
203     (Tooltips : access Gtk_Tooltips_Record;
204      Stock_Id : String;
205      Size     : Gtk.Enums.Gtk_Icon_Size)
206   is
207      procedure Internal
208        (Tooltips : System.Address;
209         Stock_Id : UTF8_String;
210         Size     : Gtk.Enums.Gtk_Icon_Size);
211      procedure Internal
212        (Tooltips : System.Address;
213         Stock_Id : System.Address;
214         Size     : Gtk.Enums.Gtk_Icon_Size);
215      pragma Import (C, Internal, "gtk_tooltip_set_icon_from_stock");
216
217   begin
218      if Stock_Id /= "" then
219         Internal (Get_Object (Tooltips), Stock_Id & ASCII.NUL, Size);
220
221      else
222         Internal (Get_Object (Tooltips), System.Null_Address, Size);
223      end if;
224   end Set_Icon_From_Stock;
225
226end Gtk.Tooltips;
227