1-----------------------------------------------------------------------
2--               GtkAda - Ada95 binding for Gtk+/Gnome               --
3--                                                                   --
4--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
5--                 Copyright (C) 2000-2013, AdaCore                  --
6--                                                                   --
7-- This library is free software; you can redistribute it and/or     --
8-- modify it under the terms of the GNU General Public               --
9-- License as published by the Free Software Foundation; either      --
10-- version 2 of the License, or (at your option) any later version.  --
11--                                                                   --
12-- This library is distributed in the hope that it will be useful,   --
13-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
14-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
15-- General Public License for more details.                          --
16--                                                                   --
17-- You should have received a copy of the GNU General Public         --
18-- License along with this library; if not, write to the             --
19-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
20-- Boston, MA 02111-1307, USA.                                       --
21--                                                                   --
22-- As a special exception, if other files instantiate generics from  --
23-- this unit, or you link this unit with other files to produce an   --
24-- executable, this  unit  does not  by itself cause  the resulting  --
25-- executable to be covered by the GNU General Public License. This  --
26-- exception does not however invalidate any other reasons why the   --
27-- executable file  might be covered by the  GNU Public License.     --
28-----------------------------------------------------------------------
29
30with System;
31with Interfaces.C.Strings;
32with Gdk.Window; use Gdk.Window;
33
34with Glib.Type_Conversion_Hooks;
35
36package body Gtk.Text is
37
38   package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator
39     (Get_Type'Access, Gtk_Text_Record);
40   pragma Warnings (Off, Type_Conversion);
41
42   ---------------------
43   -- Backward_Delete --
44   ---------------------
45
46   function Backward_Delete (Text : access Gtk_Text_Record; Nchars : in Guint)
47      return Boolean
48   is
49      function Internal (Text : in System.Address; Nchars : in Guint)
50         return Gint;
51      pragma Import (C, Internal, "gtk_text_backward_delete");
52
53   begin
54      return Internal (Get_Object (Text), Nchars) /= 0;
55   end Backward_Delete;
56
57   --------------------
58   -- Forward_Delete --
59   --------------------
60
61   function Forward_Delete
62     (Text   : access Gtk_Text_Record;
63      Nchars : in Guint)
64      return Boolean
65   is
66      function Internal
67        (Text   : in System.Address;
68         Nchars : in Guint)
69         return Gint;
70      pragma Import (C, Internal, "gtk_text_forward_delete");
71
72   begin
73      return Internal (Get_Object (Text), Nchars) /= 0;
74   end Forward_Delete;
75
76   ------------
77   -- Freeze --
78   ------------
79
80   procedure Freeze (Text : access Gtk_Text_Record) is
81      procedure Internal (Text : in System.Address);
82      pragma Import (C, Internal, "gtk_text_freeze");
83
84   begin
85      Internal (Get_Object (Text));
86   end Freeze;
87
88   ----------------------
89   -- Get_Gap_Position --
90   ----------------------
91
92   function Get_Gap_Position (Text : access Gtk_Text_Record) return Guint is
93      function Internal (Widget : in System.Address) return Guint;
94      pragma Import (C, Internal, "ada_text_get_gap_position");
95
96   begin
97      return Internal (Get_Object (Text));
98   end Get_Gap_Position;
99
100   ------------------
101   -- Get_Gap_Size --
102   ------------------
103
104   function Get_Gap_Size (Text : access Gtk_Text_Record) return Guint is
105      function Internal (Widget : in System.Address) return Guint;
106      pragma Import (C, Internal, "ada_text_get_gap_size");
107
108   begin
109      return Internal (Get_Object (Text));
110   end Get_Gap_Size;
111
112   --------------
113   -- Get_Hadj --
114   --------------
115
116   function Get_Hadj (Text : access Gtk_Text_Record)
117     return Gtk.Adjustment.Gtk_Adjustment
118   is
119      function Internal (Widget : in System.Address)
120        return System.Address;
121      pragma Import (C, Internal, "ada_text_get_hadj");
122      Stub : Gtk.Adjustment.Gtk_Adjustment_Record;
123
124   begin
125      return Gtk.Adjustment.Gtk_Adjustment
126        (Get_User_Data (Internal (Get_Object (Text)), Stub));
127   end Get_Hadj;
128
129   ----------------
130   -- Get_Length --
131   ----------------
132
133   function Get_Length (Text : access Gtk_Text_Record) return Guint is
134      function Internal (Text : in System.Address) return Guint;
135      pragma Import (C, Internal, "gtk_text_get_length");
136
137   begin
138      return Internal (Get_Object (Text));
139   end Get_Length;
140
141   ---------------
142   -- Get_Point --
143   ---------------
144
145   function Get_Point (Text : access Gtk_Text_Record) return Guint is
146      function Internal (Text : in System.Address) return Guint;
147      pragma Import (C, Internal, "gtk_text_get_point");
148
149   begin
150      return Internal (Get_Object (Text));
151   end Get_Point;
152
153   --------------
154   -- Get_Text --
155   --------------
156
157   function Get_Text (Text : access Gtk_Text_Record) return UTF8_String is
158      function Internal (Text : in System.Address)
159        return Interfaces.C.Strings.chars_ptr;
160      pragma Import (C, Internal, "ada_text_get_text");
161
162   begin
163      return Interfaces.C.Strings.Value (Internal (Get_Object (Text)));
164   end Get_Text;
165
166   -------------------
167   -- Get_Text_Area --
168   -------------------
169
170   function Get_Text_Area (Text : access Gtk_Text_Record)
171     return Gdk.Gdk_Window
172   is
173      function Internal (Text : in System.Address) return Gdk.Gdk_Window;
174      pragma Import (C, Internal, "ada_text_get_text_area");
175   begin
176      return Internal (Get_Object (Text));
177   end Get_Text_Area;
178
179   ------------------
180   -- Get_Text_End --
181   ------------------
182
183   function Get_Text_End (Text : access Gtk_Text_Record) return Guint is
184      function Internal (Widget : in System.Address) return Guint;
185      pragma Import (C, Internal, "ada_text_get_text_end");
186
187   begin
188      return Internal (Get_Object (Text));
189   end Get_Text_End;
190
191   -------------
192   -- Gtk_New --
193   -------------
194
195   procedure Gtk_New
196     (Text : out Gtk_Text;
197      Hadj : in Adjustment.Gtk_Adjustment := null;
198      Vadj : in Adjustment.Gtk_Adjustment := null) is
199   begin
200      Text := new Gtk_Text_Record;
201      Initialize (Text, Hadj, Vadj);
202   end Gtk_New;
203
204   --------------
205   -- Get_Vadj --
206   --------------
207
208   function Get_Vadj (Text : access Gtk_Text_Record)
209     return Gtk.Adjustment.Gtk_Adjustment
210   is
211      function Internal (Widget : in System.Address) return System.Address;
212      pragma Import (C, Internal, "ada_text_get_vadj");
213      Stub : Gtk.Adjustment.Gtk_Adjustment_Record;
214
215   begin
216      return Gtk.Adjustment.Gtk_Adjustment
217        (Get_User_Data (Internal (Get_Object (Text)), Stub));
218   end Get_Vadj;
219
220   ----------------
221   -- Initialize --
222   ----------------
223
224   procedure Initialize
225     (Text : access Gtk_Text_Record'Class;
226      Hadj : in Adjustment.Gtk_Adjustment := null;
227      Vadj : in Adjustment.Gtk_Adjustment := null)
228   is
229      function Internal
230        (Hadj   : in System.Address;
231         Vadj   : in System.Address) return System.Address;
232      pragma Import (C, Internal, "gtk_text_new");
233
234      H, V : System.Address;
235
236      use type Gtk.Adjustment.Gtk_Adjustment;
237
238   begin
239      if Hadj = null then
240         H := System.Null_Address;
241      else
242         H := Get_Object (Hadj);
243      end if;
244
245      if Vadj = null then
246         V := System.Null_Address;
247      else
248         V := Get_Object (Vadj);
249      end if;
250
251      Set_Object (Text, Internal (H, V));
252   end Initialize;
253
254   ------------
255   -- Insert --
256   ------------
257
258   procedure Insert
259     (Text   : access Gtk_Text_Record;
260      Font   : in Gdk.Font.Gdk_Font := Gdk.Font.Null_Font;
261      Fore   : in Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
262      Back   : in Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
263      Chars  : in UTF8_String := "";
264      Length : in Gint := -1)
265   is
266      procedure Internal
267        (Text   : in System.Address;
268         Font   : in Gdk.Font.Gdk_Font;
269         Fore   : in System.Address;
270         Back   : in System.Address;
271         Chars  : in UTF8_String;
272         Length : in Gint);
273      pragma Import (C, Internal, "gtk_text_insert");
274      use type Gdk.Color.Gdk_Color;
275
276      Fore_Col : aliased Gdk.Color.Gdk_Color := Fore;
277      Back_Col : aliased Gdk.Color.Gdk_Color := Back;
278      Fore_A : System.Address := Fore_Col'Address;
279      Back_A : System.Address := Back_Col'Address;
280
281   begin
282      if Fore = Gdk.Color.Null_Color then
283         Fore_A := System.Null_Address;
284      end if;
285
286      if Back = Gdk.Color.Null_Color then
287         Back_A := System.Null_Address;
288      end if;
289
290      Internal
291        (Get_Object (Text), Font, Fore_A, Back_A, Chars & ASCII.NUL, Length);
292   end Insert;
293
294   ---------------------
295   -- Set_Adjustments --
296   ---------------------
297
298   procedure Set_Adjustments
299     (Text : access Gtk_Text_Record;
300      Hadj : Gtk.Adjustment.Gtk_Adjustment;
301      Vadj : Gtk.Adjustment.Gtk_Adjustment)
302   is
303      procedure Internal
304        (Text : in System.Address;
305         Hadj : in System.Address;
306         Vadj : in System.Address);
307      pragma Import (C, Internal, "gtk_text_set_adjustments");
308      use type Gtk.Adjustment.Gtk_Adjustment;
309      Ha, Va : System.Address := System.Null_Address;
310   begin
311      if Hadj /= null then
312         Ha := Get_Object (Hadj);
313      end if;
314      if Vadj /= null then
315         Va := Get_Object (Vadj);
316      end if;
317      Internal (Get_Object (Text), Ha, Va);
318   end Set_Adjustments;
319
320   ------------------
321   -- Set_Editable --
322   ------------------
323
324   procedure Set_Editable
325     (Text     : access Gtk_Text_Record;
326      Editable : in Boolean := True)
327   is
328      procedure Internal
329        (Text     : in System.Address;
330         Editable : in Gint);
331      pragma Import (C, Internal, "gtk_text_set_editable");
332
333   begin
334      Internal (Get_Object (Text), Boolean'Pos (Editable));
335   end Set_Editable;
336
337   ---------------
338   -- Set_Point --
339   ---------------
340
341   procedure Set_Point (Text  : access Gtk_Text_Record; Index : in Guint) is
342      procedure Internal
343        (Text  : in System.Address;
344         Index : in Guint);
345      pragma Import (C, Internal, "gtk_text_set_point");
346
347   begin
348      Internal (Get_Object (Text), Index);
349   end Set_Point;
350
351   -------------------
352   -- Set_Line_Wrap --
353   -------------------
354
355   procedure Set_Line_Wrap
356     (Text      : access Gtk_Text_Record;
357      Line_Wrap : in Boolean := True)
358   is
359      procedure Internal
360        (Text      : in System.Address;
361         Line_Wrap : in Gint);
362      pragma Import (C, Internal, "gtk_text_set_line_wrap");
363
364   begin
365      Internal (Get_Object (Text), Boolean'Pos (Line_Wrap));
366   end Set_Line_Wrap;
367
368   -------------------
369   -- Set_Word_Wrap --
370   -------------------
371
372   procedure Set_Word_Wrap
373     (Text      : access Gtk_Text_Record;
374      Word_Wrap : in Boolean := True)
375   is
376      procedure Internal
377        (Text      : in System.Address;
378         Word_Wrap : in Gint);
379      pragma Import (C, Internal, "gtk_text_set_word_wrap");
380
381   begin
382      Internal (Get_Object (Text), Boolean'Pos (Word_Wrap));
383   end Set_Word_Wrap;
384
385   ----------
386   -- Thaw --
387   ----------
388
389   procedure Thaw (Text : access Gtk_Text_Record) is
390      procedure Internal (Text : in System.Address);
391      pragma Import (C, Internal, "gtk_text_thaw");
392
393   begin
394      Internal (Get_Object (Text));
395   end Thaw;
396
397end Gtk.Text;
398