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