1----------------------------------------------------------------------- 2-- GtkAda - Ada95 binding for the Gimp Toolkit -- 3-- -- 4-- Copyright (C) 2008-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 Interfaces.C.Strings; 30with System; 31 32with Glib.Object; 33 34package body Gtkada.Abstract_Tree_Model is 35 36 use type Gtk.Tree_Model.Gtk_Tree_Iter; 37 38 type Gtk_Tree_Iter_Access is access all Gtk.Tree_Model.Gtk_Tree_Iter; 39 pragma Convention (C, Gtk_Tree_Iter_Access); 40 41 type GInterface_Info is record 42 interface_init : System.Address := System.Null_Address; 43 interface_finalize : System.Address := System.Null_Address; 44 interface_data : System.Address := System.Null_Address; 45 end record; 46 pragma Convention (C, GInterface_Info); 47 48 type GTypeInterface is record 49 g_type : Glib.GType; 50 g_instance_type : Glib.GType; 51 end record; 52 pragma Convention (C, GTypeInterface); 53 54 type GtkTreeModelInterface is record 55 g_type : GTypeInterface; 56 row_changed : System.Address := System.Null_Address; 57 row_inserted : System.Address := System.Null_Address; 58 row_has_child_toggled : System.Address := System.Null_Address; 59 row_deleted : System.Address := System.Null_Address; 60 rows_reordered : System.Address := System.Null_Address; 61 get_flags : System.Address := System.Null_Address; 62 get_n_columns : System.Address := System.Null_Address; 63 get_column_type : System.Address := System.Null_Address; 64 get_iter : System.Address := System.Null_Address; 65 get_path : System.Address := System.Null_Address; 66 get_value : System.Address := System.Null_Address; 67 iter_next : System.Address := System.Null_Address; 68 iter_children : System.Address := System.Null_Address; 69 iter_has_child : System.Address := System.Null_Address; 70 iter_n_children : System.Address := System.Null_Address; 71 iter_nth_child : System.Address := System.Null_Address; 72 iter_parent : System.Address := System.Null_Address; 73 ref_node : System.Address := System.Null_Address; 74 unref_node : System.Address := System.Null_Address; 75 end record; 76 pragma Convention (C, GtkTreeModelInterface); 77 78 procedure Tree_Model_Interface_Init (Iface : in out GtkTreeModelInterface); 79 pragma Convention (C, Tree_Model_Interface_Init); 80 81 function Dispatch_Get_Flags 82 (Tree_Model : System.Address) return Gtk.Tree_Model.Tree_Model_Flags; 83 pragma Convention (C, Dispatch_Get_Flags); 84 85 function Dispatch_Get_N_Columns 86 (Tree_Model : System.Address) return Glib.Gint; 87 pragma Convention (C, Dispatch_Get_N_Columns); 88 89 function Dispatch_Get_Column_Type 90 (Tree_Model : System.Address; 91 Index : Glib.Gint) return Glib.GType; 92 pragma Convention (C, Dispatch_Get_Column_Type); 93 94 function Dispatch_Get_Iter 95 (Tree_Model : System.Address; 96 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 97 Path : Gtk.Tree_Model.Gtk_Tree_Path) return Glib.Gboolean; 98 pragma Convention (C, Dispatch_Get_Iter); 99 100 function Dispatch_Get_Path 101 (Tree_Model : System.Address; 102 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 103 return Gtk.Tree_Model.Gtk_Tree_Path; 104 pragma Convention (C, Dispatch_Get_Path); 105 106 procedure Dispatch_Get_Value 107 (Tree_Model : System.Address; 108 Iter : Gtk.Tree_Model.Gtk_Tree_Iter; 109 Column : Glib.Gint; 110 Value : out Glib.Values.GValue); 111 pragma Convention (C, Dispatch_Get_Value); 112 113 function Dispatch_Iter_Next 114 (Tree_Model : System.Address; 115 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter) return Glib.Gboolean; 116 pragma Convention (C, Dispatch_Iter_Next); 117 118 function Dispatch_Iter_Children 119 (Tree_Model : System.Address; 120 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 121 Parent : Gtk_Tree_Iter_Access) 122 return Glib.Gboolean; 123 pragma Convention (C, Dispatch_Iter_Children); 124 125 function Dispatch_Iter_Has_Child 126 (Tree_Model : System.Address; 127 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 128 return Glib.Gboolean; 129 pragma Convention (C, Dispatch_Iter_Has_Child); 130 131 function Dispatch_Iter_N_Children 132 (Tree_Model : System.Address; 133 Iter : Gtk_Tree_Iter_Access) 134 return Glib.Gint; 135 pragma Convention (C, Dispatch_Iter_N_Children); 136 137 function Dispatch_Iter_Nth_Child 138 (Tree_Model : System.Address; 139 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 140 Parent : Gtk_Tree_Iter_Access; 141 N : Glib.Gint) return Glib.Gboolean; 142 pragma Convention (C, Dispatch_Iter_Nth_Child); 143 144 function Dispatch_Iter_Parent 145 (Tree_Model : System.Address; 146 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 147 Child : Gtk.Tree_Model.Gtk_Tree_Iter) 148 return Glib.Gboolean; 149 pragma Convention (C, Dispatch_Iter_Parent); 150 151 procedure Dispatch_Ref_Node 152 (Tree_Model : System.Address; 153 Iter : Gtk.Tree_Model.Gtk_Tree_Iter); 154 pragma Convention (C, Dispatch_Ref_Node); 155 156 procedure Dispatch_Unref_Node 157 (Tree_Model : System.Address; 158 Iter : Gtk.Tree_Model.Gtk_Tree_Iter); 159 pragma Convention (C, Dispatch_Unref_Node); 160 161 Class_Record : Glib.Object.GObject_Class := Glib.Object.Uninitialized_Class; 162 Info : constant GInterface_Info := 163 (interface_init => Tree_Model_Interface_Init'Address, 164 others => System.Null_Address); 165 166 ------------------------------ 167 -- Dispatch_Get_Column_Type -- 168 ------------------------------ 169 170 function Dispatch_Get_Column_Type 171 (Tree_Model : System.Address; 172 Index : Glib.Gint) 173 return Glib.GType 174 is 175 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 176 177 begin 178 return 179 Gtk.Tree_Model.Get_Column_Type 180 (Gtk.Tree_Model.Gtk_Tree_Model 181 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 182 Index); 183 end Dispatch_Get_Column_Type; 184 185 ------------------------ 186 -- Dispatch_Get_Flags -- 187 ------------------------ 188 189 function Dispatch_Get_Flags 190 (Tree_Model : System.Address) 191 return Gtk.Tree_Model.Tree_Model_Flags 192 is 193 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 194 195 begin 196 return 197 Gtk.Tree_Model.Get_Flags 198 (Gtk.Tree_Model.Gtk_Tree_Model 199 (Glib.Object.Get_User_Data (Tree_Model, Stub))); 200 end Dispatch_Get_Flags; 201 202 ----------------------- 203 -- Dispatch_Get_Iter -- 204 ----------------------- 205 206 function Dispatch_Get_Iter 207 (Tree_Model : System.Address; 208 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 209 Path : Gtk.Tree_Model.Gtk_Tree_Path) return Glib.Gboolean 210 is 211 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 212 213 begin 214 Iter.all := 215 Gtk.Tree_Model.Get_Iter 216 (Gtk.Tree_Model.Gtk_Tree_Model 217 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 218 Path); 219 220 if Iter.all = Gtk.Tree_Model.Null_Iter then 221 return 0; 222 223 else 224 return 1; 225 end if; 226 end Dispatch_Get_Iter; 227 228 ----------------------- 229 -- Dispatch_Get_Path -- 230 ----------------------- 231 232 function Dispatch_Get_Path 233 (Tree_Model : System.Address; 234 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 235 return Gtk.Tree_Model.Gtk_Tree_Path 236 is 237 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 238 239 begin 240 return 241 Gtk.Tree_Model.Get_Path 242 (Gtk.Tree_Model.Gtk_Tree_Model 243 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 244 Iter); 245 end Dispatch_Get_Path; 246 247 ---------------------------- 248 -- Dispatch_Get_N_Columns -- 249 ---------------------------- 250 251 function Dispatch_Get_N_Columns 252 (Tree_Model : System.Address) 253 return Glib.Gint 254 is 255 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 256 257 begin 258 return 259 Gtk.Tree_Model.Get_N_Columns 260 (Gtk.Tree_Model.Gtk_Tree_Model 261 (Glib.Object.Get_User_Data (Tree_Model, Stub))); 262 end Dispatch_Get_N_Columns; 263 264 ------------------------ 265 -- Dispatch_Get_Value -- 266 ------------------------ 267 268 procedure Dispatch_Get_Value 269 (Tree_Model : System.Address; 270 Iter : Gtk.Tree_Model.Gtk_Tree_Iter; 271 Column : Glib.Gint; 272 Value : out Glib.Values.GValue) 273 is 274 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 275 276 begin 277 Gtk.Tree_Model.Get_Value 278 (Gtk.Tree_Model.Gtk_Tree_Model 279 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 280 Iter, 281 Column, 282 Value); 283 end Dispatch_Get_Value; 284 285 ---------------------------- 286 -- Dispatch_Iter_Children -- 287 ---------------------------- 288 289 function Dispatch_Iter_Children 290 (Tree_Model : System.Address; 291 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 292 Parent : Gtk_Tree_Iter_Access) 293 return Glib.Gboolean 294 is 295 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 296 Real_Parent : Gtk.Tree_Model.Gtk_Tree_Iter; 297 begin 298 -- Gtk should normally never pass null to that function. Unfortunately, 299 -- When using e.g. PyGtk, Parent may be null, probably due to a bug. 300 -- Using a null parent and passing Null_Iter in this case is a 301 -- workaround to that problem. 302 if Parent /= null then 303 Real_Parent := Parent.all; 304 else 305 Real_Parent := Gtk.Tree_Model.Null_Iter; 306 end if; 307 308 Iter.all := 309 Gtk.Tree_Model.Children 310 (Gtk.Tree_Model.Gtk_Tree_Model 311 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 312 Real_Parent); 313 314 if Iter.all = Gtk.Tree_Model.Null_Iter then 315 return 0; 316 317 else 318 return 1; 319 end if; 320 end Dispatch_Iter_Children; 321 322 ----------------------------- 323 -- Dispatch_Iter_Has_Child -- 324 ----------------------------- 325 326 function Dispatch_Iter_Has_Child 327 (Tree_Model : System.Address; 328 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 329 return Glib.Gboolean 330 is 331 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 332 333 begin 334 if Gtk.Tree_Model.Has_Child 335 (Gtk.Tree_Model.Gtk_Tree_Model 336 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 337 Iter) 338 then 339 return 1; 340 341 else 342 return 0; 343 end if; 344 end Dispatch_Iter_Has_Child; 345 346 ------------------------------ 347 -- Dispatch_Iter_N_Children -- 348 ------------------------------ 349 350 function Dispatch_Iter_N_Children 351 (Tree_Model : System.Address; 352 Iter : Gtk_Tree_Iter_Access) 353 return Glib.Gint 354 is 355 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 356 357 begin 358 if Iter = null then 359 return 360 Gtk.Tree_Model.N_Children 361 (Gtk.Tree_Model.Gtk_Tree_Model 362 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 363 Gtk.Tree_Model.Null_Iter); 364 365 else 366 return 367 Gtk.Tree_Model.N_Children 368 (Gtk.Tree_Model.Gtk_Tree_Model 369 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 370 Iter.all); 371 end if; 372 end Dispatch_Iter_N_Children; 373 374 ------------------------ 375 -- Dispatch_Iter_Next -- 376 ------------------------ 377 378 function Dispatch_Iter_Next 379 (Tree_Model : System.Address; 380 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter) return Glib.Gboolean 381 is 382 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 383 384 begin 385 Gtk.Tree_Model.Next 386 (Gtk.Tree_Model.Gtk_Tree_Model 387 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 388 Iter.all); 389 390 if Iter.all = Gtk.Tree_Model.Null_Iter then 391 return 0; 392 393 else 394 return 1; 395 end if; 396 end Dispatch_Iter_Next; 397 398 ----------------------------- 399 -- Dispatch_Iter_Nth_Child -- 400 ----------------------------- 401 402 function Dispatch_Iter_Nth_Child 403 (Tree_Model : System.Address; 404 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 405 Parent : Gtk_Tree_Iter_Access; 406 N : Glib.Gint) return Glib.Gboolean 407 is 408 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 409 410 begin 411 -- Parent can be null, GtkAda assume it can't. 412 413 if Parent = null then 414 Iter.all := 415 Gtk.Tree_Model.Nth_Child 416 (Gtk.Tree_Model.Gtk_Tree_Model 417 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 418 Gtk.Tree_Model.Null_Iter, 419 N); 420 421 else 422 Iter.all := 423 Gtk.Tree_Model.Nth_Child 424 (Gtk.Tree_Model.Gtk_Tree_Model 425 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 426 Parent.all, 427 N); 428 end if; 429 430 if Iter.all = Gtk.Tree_Model.Null_Iter then 431 return 0; 432 433 else 434 return 1; 435 end if; 436 end Dispatch_Iter_Nth_Child; 437 438 -------------------------- 439 -- Dispatch_Iter_Parent -- 440 -------------------------- 441 442 function Dispatch_Iter_Parent 443 (Tree_Model : System.Address; 444 Iter : access Gtk.Tree_Model.Gtk_Tree_Iter; 445 Child : Gtk.Tree_Model.Gtk_Tree_Iter) 446 return Glib.Gboolean 447 is 448 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 449 450 begin 451 Iter.all := 452 Gtk.Tree_Model.Parent 453 (Gtk.Tree_Model.Gtk_Tree_Model 454 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 455 Child); 456 457 if Iter.all = Gtk.Tree_Model.Null_Iter then 458 return 0; 459 460 else 461 return 1; 462 end if; 463 end Dispatch_Iter_Parent; 464 465 ----------------------- 466 -- Dispatch_Ref_Node -- 467 ----------------------- 468 469 procedure Dispatch_Ref_Node 470 (Tree_Model : System.Address; 471 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 472 is 473 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 474 475 begin 476 Gtk.Tree_Model.Ref_Node 477 (Gtk.Tree_Model.Gtk_Tree_Model 478 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 479 Iter); 480 end Dispatch_Ref_Node; 481 482 ------------------------- 483 -- Dispatch_Unref_Node -- 484 ------------------------- 485 486 procedure Dispatch_Unref_Node 487 (Tree_Model : System.Address; 488 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 489 is 490 Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record; 491 492 begin 493 Gtk.Tree_Model.Unref_Node 494 (Gtk.Tree_Model.Gtk_Tree_Model 495 (Glib.Object.Get_User_Data (Tree_Model, Stub)), 496 Iter); 497 end Dispatch_Unref_Node; 498 499 --------------- 500 -- Get_Flags -- 501 --------------- 502 503 function Get_Flags 504 (Self : access Gtk_Abstract_Tree_Model_Record) 505 return Gtk.Tree_Model.Tree_Model_Flags 506 is 507 pragma Unreferenced (Self); 508 -- This parameter is used for call dispatching. 509 510 begin 511 return 0; 512 end Get_Flags; 513 514 ---------------- 515 -- Initialize -- 516 ---------------- 517 518 procedure Initialize (Self : access Gtk_Abstract_Tree_Model_Record'Class) is 519 use type Glib.Object.GObject_Class; 520 Empty : Interfaces.C.Strings.chars_ptr_array (1 .. 0); 521 522 procedure Init_Interface 523 (Class : Glib.GType; 524 Iface : Glib.GType; 525 Info : GInterface_Info); 526 pragma Import (C, Init_Interface, "g_type_add_interface_static"); 527 528 Initialized : constant Boolean := 529 Class_Record /= Glib.Object.Uninitialized_Class; 530 531 begin 532 Glib.Object.Initialize (Self); 533 534 Glib.Object.Initialize_Class_Record 535 (Self, 536 Empty, 537 Class_Record, 538 "GtkAdaAbstractTreeModel"); 539 540 if not Initialized then 541 Init_Interface 542 (Glib.Object.Type_From_Class (Class_Record), 543 Gtk.Tree_Model.Get_Type, 544 Info); 545 end if; 546 end Initialize; 547 548 -------------- 549 -- Ref_Node -- 550 -------------- 551 552 procedure Ref_Node 553 (Self : access Gtk_Abstract_Tree_Model_Record; 554 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 555 is 556 begin 557 null; 558 end Ref_Node; 559 560 ------------------------------- 561 -- Tree_Model_Interface_Init -- 562 ------------------------------- 563 564 procedure Tree_Model_Interface_Init 565 (Iface : in out GtkTreeModelInterface) 566 is 567 begin 568 Iface.get_flags := Dispatch_Get_Flags'Address; 569 Iface.get_n_columns := Dispatch_Get_N_Columns'Address; 570 Iface.get_column_type := Dispatch_Get_Column_Type'Address; 571 Iface.get_iter := Dispatch_Get_Iter'Address; 572 Iface.get_path := Dispatch_Get_Path'Address; 573 Iface.get_value := Dispatch_Get_Value'Address; 574 Iface.iter_next := Dispatch_Iter_Next'Address; 575 Iface.iter_children := Dispatch_Iter_Children'Address; 576 Iface.iter_has_child := Dispatch_Iter_Has_Child'Address; 577 Iface.iter_n_children := Dispatch_Iter_N_Children'Address; 578 Iface.iter_nth_child := Dispatch_Iter_Nth_Child'Address; 579 Iface.iter_parent := Dispatch_Iter_Parent'Address; 580 Iface.ref_node := Dispatch_Ref_Node'Address; 581 Iface.unref_node := Dispatch_Unref_Node'Address; 582 end Tree_Model_Interface_Init; 583 584 ---------------- 585 -- Unref_Node -- 586 ---------------- 587 588 procedure Unref_Node 589 (Self : access Gtk_Abstract_Tree_Model_Record; 590 Iter : Gtk.Tree_Model.Gtk_Tree_Iter) 591 is 592 begin 593 null; 594 end Unref_Node; 595 596end Gtkada.Abstract_Tree_Model; 597