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 30-- <description> 31-- 32-- The aim of this package is to provide some services to connect a 33-- handler to a signal emitted by a Gtk Object. To understand the 34-- services provided by this package, some definitions are necessary: 35-- 36-- Signal: A signal is a kind of message that an object wants to 37-- broadcast. All GObjects can emit signals. These messages are 38-- associated to certain events happening during the life of an 39-- object. For instance, when a user clicks on a button, the 40-- "clicked" signal is emitted by the button. 41-- 42-- Handler (or callback): A handler is a function or procedure that 43-- the user "connects" to a signal for a particular object. 44-- Connecting a handler to a signal means associating this handler to 45-- the signal. When the signal is emitted, all connected handlers 46-- are called back. Usually, the role of those callbacks is to do 47-- some processing triggered by a user action. For instance, when 48-- "clicked" signal is emitted by the "OK" button of a dialog, the 49-- connected handler can be used to close the dialog or recompute 50-- some value. 51-- 52-- In GtkAda, the handlers are defined in a form as general as 53-- possible. The first argument is always an access to the object it 54-- has been connected to. The second object is a table of values 55-- (See Glib.Values for more details about this table). It is the 56-- responsibility of this handler to extract the values from it, and 57-- to convert them to the correct Ada type. 58-- 59-- Because such handlers are not very convenient to use, this package 60-- also provides some services to connect a marshaller instead. It 61-- will then do the extraction work before calling the more 62-- programmer-friendly handler, as defined in Gtk.Marshallers (see 63-- Gtk.Marshallers for more details). 64-- 65-- The subdivision of this package is identical to Gtk.Marshallers; it 66-- is made of four generic sub-packages, each representing one of the 67-- four possible kinds of handlers: they can return a value or not, and 68-- they can have some user specific data associated to them or not. 69-- Selecting the right package depends on the profile of the handler. 70-- For example, the handler for the "delete_event" signal of a 71-- Gtk_Window has a return value, and has an extra parameter (a Gint). 72-- All handlers also have a user_data field by default, but its usage 73-- is optional. To connect a handler to this signal, if the user_data 74-- field is not used, the Return_Callback generic should be 75-- instantiated. On the other hand, if the user_data field is 76-- necessary, then the User_Return_Callback generic should be used. 77-- 78-- Note also that the real handler in Gtk+ should expect at least as 79-- many arguments as in the marshaller you are using. If your 80-- marshaller has one argument, the C handler must have at least one 81-- argument too. 82-- 83-- The common generic parameter to all sub-packages is the widget type, 84-- which is the basic widget manipulated. This can be 85-- Glib.Object.GObject_Record type if you want to reduce the number of 86-- instantiations, but the conversion to the original type will have to be 87-- done inside the handler. 88-- 89-- All sub-packages are organized in the same way. 90-- 91-- First, the type "Handler" is defined. It represents the general 92-- form of the callbacks supported by the sub-package. 93-- 94-- The corresponding sub-package of Gtk.Marshallers is instantiated. 95-- 96-- A series of "Connect" procedures and functions is given. All cases 97-- are covered: the functions return the Handler_Id of the newly 98-- created association, while the procedures just connect the 99-- handler, dropping the Handler_Id; some services allow the user to 100-- connect a Handler while some others allow the usage of 101-- Marshallers, which are more convenient. Note that more than one 102-- handler may be connected to a signal; the handlers will then be 103-- invoked in the order of connection. 104-- 105-- Some "Connect_Object" services are also provided. Those services 106-- never have a user_data. They accept an additional parameter called 107-- Slot_Object. When the callback in invoked, the Gtk Object emitting 108-- the signal is substituted by this Slot_Object. 109-- These callbacks are always automatically disconnected as soon as one 110-- of the two widgets involved is destroyed. 111-- 112-- There are several methods to connect a handler. For each method, 113-- although the option of connecting a Handler is provided, the 114-- recommended way is to use Marshallers. Each connect service is 115-- documented below, in the first sub-package. 116-- 117-- A series of "To_Marshaller" functions are provided. They return 118-- some marshallers for the most commonly used types in order to ease 119-- the usage of this package. Most of the time, it will not be 120-- necessary to use some other marshallers. 121-- For instance, if a signal is documented as receiving a single argument, 122-- the widget (for instance the "clicked" signal for a Gtk_Button), you 123-- will connect to it with: 124-- with Gtkada.Handlers; 125-- procedure On_Clicked (Button : access Gtk_Widget_Record'Class); 126-- ... 127-- Widget_Callback.Connect (Button, "clicked", On_Clicked'Access); 128-- 129-- The simple form above also applies for most handlers that take one 130-- additional argument, for instance the "button_press_event" in 131-- gtk-widget.ads. Just declare your subprogram with the appropriate profile 132-- and connect it, as in: 133-- with Gtkada.Handlers; 134-- procedure On_Button (Widget : access Gtk_Widget_Record'Class; 135-- Event : Gdk_Event); 136-- ... 137-- Widget_Callback.Connect (Widget, "button_press_event", 138-- On_Button'Access); 139-- 140-- More complex forms of handlers exists however in GtkAda, for which no 141-- predefined marshaller exists. In this case, you have to use the general 142-- form of callbacks. For instance, the "select_row" signal of Gtk.Clist. 143-- with Gtkada.Handlers; 144-- with Gtk.Arguments; 145-- procedure On_Select (Clist : access Gtk_Widget_Record'Class; 146-- Args : Glib.Values.GValues) 147-- is 148-- Row : constant Gint := To_Gint (Args, 1); 149-- Column : constant Gint := To_Gint (Args, 2); 150-- Event : constant Gdk_Event := To_Event (Args, 3); 151-- begin 152-- ... 153-- end On_Select; 154-- ... 155-- Widget_Callback.Connect (Clist, "select_row", On_Select'Access); 156-- 157-- As for the "To_Marshaller" functions, a series of "Emit_By_Name" 158-- procedures are also provided for the same most common types, to 159-- allow the user to easily emit signals. These procedures are mainly 160-- intended for people building new GObjects. 161-- 162-- At the end of this package, some general services related to the 163-- management of signals and handlers are also provided. Each one of 164-- them is documented individually below. 165-- 166-- IMPORTANT NOTE: These packages must be instantiated at library-level 167-- 168-- </description> 169-- <c_version>2.8.17</c_version> 170-- <group>Signal handling</group> 171 172with Glib.Values; 173with Gdk.Event; 174with Glib.Object; 175with Gtk.Marshallers; 176pragma Elaborate_All (Gtk.Marshallers); 177 178with Gtk.Notebook; 179with Gtk.Tree_Model; 180with Gtk.Widget; 181 182with Unchecked_Conversion; 183 184package Gtk.Handlers is 185 186 -- <doc_ignore> 187 188 pragma Elaborate_Body; 189 190 type GClosure is new Glib.C_Proxy; 191 192 Null_Handler_Id : constant Gulong := 0; 193 194 type Handler_Id is record 195 Id : Gulong := Null_Handler_Id; 196 Closure : GClosure; 197 end record; 198 -- This uniquely identifies a connection widget<->signal. 199 -- Closure is an internal data, that you should not use. 200 201 --------------------------------------------------------- 202 -- These handlers should return a value 203 -- They do not have a User_Data 204 --------------------------------------------------------- 205 206 generic 207 type Widget_Type is new Glib.Object.GObject_Record with private; 208 type Return_Type is (<>); 209 package Return_Callback is 210 211 type Handler is access function 212 (Widget : access Widget_Type'Class; 213 Params : Glib.Values.GValues) return Return_Type; 214 215 type Simple_Handler is access function 216 (Widget : access Widget_Type'Class) return Return_Type; 217 218 package Marshallers is new Gtk.Marshallers.Return_Marshallers 219 (Widget_Type, Return_Type); 220 221 -- Connecting a handler to an object 222 223 -- In all the Connect services below, the following arguments 224 -- will be used: 225 -- o Widget, Name: This represents the association (Gtk Object, 226 -- Glib.Signal_Name) to which the handler is to be connected. 227 -- o After: If this boolean is set to True, then the handler 228 -- will be connected after all the default handlers. By 229 -- default, it is set to False. 230 231 procedure Connect 232 (Widget : access Widget_Type'Class; 233 Name : Glib.Signal_Name; 234 Marsh : Marshallers.Marshaller; 235 After : Boolean := False); 236 -- Connects a Marshaller. The Handler_Id is dropped. 237 238 procedure Object_Connect 239 (Widget : access Glib.Object.GObject_Record'Class; 240 Name : Glib.Signal_Name; 241 Marsh : Marshallers.Marshaller; 242 Slot_Object : access Widget_Type'Class; 243 After : Boolean := False); 244 -- Connect a Marshaller. The Handler_Id is dropped. 245 -- This is automatically disconnected as soon as either Widget or 246 -- Slot_Object is destroyed. 247 -- Slot_Object *must* be of type Gtk_Object or one of its children. 248 249 procedure Connect 250 (Widget : access Widget_Type'Class; 251 Name : Glib.Signal_Name; 252 Cb : Simple_Handler; 253 After : Boolean := False); 254 procedure Object_Connect 255 (Widget : access Glib.Object.GObject_Record'Class; 256 Name : Glib.Signal_Name; 257 Cb : Simple_Handler; 258 Slot_Object : access Widget_Type'Class; 259 After : Boolean := False); 260 -- Same as above, except with a simple handle with no parameter. This 261 -- is the same as using a To_Marshaller call to the above two 262 -- procedures, except it is shorter to write. 263 264 procedure Connect 265 (Widget : access Widget_Type'Class; 266 Name : Glib.Signal_Name; 267 Cb : Handler; 268 After : Boolean := False); 269 procedure Object_Connect 270 (Widget : access Glib.Object.GObject_Record'Class; 271 Name : Glib.Signal_Name; 272 Cb : Handler; 273 Slot_Object : access Widget_Type'Class; 274 After : Boolean := False); 275 -- Connect a Handler. The Handler_Id is dropped. 276 -- This is automatically disconnected as soon as either Widget or 277 -- Slot_Object is destroyed. 278 -- Slot_Object *must* be of type Gtk_Object or one of its children. 279 280 pragma Inline (Connect); 281 pragma Inline (Object_Connect); 282 283 function Connect 284 (Widget : access Widget_Type'Class; 285 Name : Glib.Signal_Name; 286 Marsh : Marshallers.Marshaller; 287 After : Boolean := False) return Handler_Id; 288 -- Connects a Marshaller. Returns the Handler_Id. 289 290 function Object_Connect 291 (Widget : access Glib.Object.GObject_Record'Class; 292 Name : Glib.Signal_Name; 293 Marsh : Marshallers.Marshaller; 294 Slot_Object : access Widget_Type'Class; 295 After : Boolean := False) return Handler_Id; 296 -- Connect a Marshaller. Return the Handler_Id. 297 -- This is automatically disconnected as soon as either Widget or 298 -- Slot_Object is destroyed. 299 -- Slot_Object *must* be of type Gtk_Object or one of its children. 300 301 function Connect 302 (Widget : access Widget_Type'Class; 303 Name : Glib.Signal_Name; 304 Cb : Handler; 305 After : Boolean := False) return Handler_Id; 306 -- Connects a Handler. Returns the Handler_Id. 307 308 function Object_Connect 309 (Widget : access Glib.Object.GObject_Record'Class; 310 Name : Glib.Signal_Name; 311 Cb : Handler; 312 Slot_Object : access Widget_Type'Class; 313 After : Boolean := False) return Handler_Id; 314 -- Connect a Handler. Returns the Handler_Id. 315 -- This is automatically disconnected as soon as either Widget or 316 -- Slot_Object is destroyed. 317 -- Slot_Object *must* be of type Gtk_Object or one of its children. 318 319 -- Some convenient functions to create marshallers 320 321 package Gint_Marshaller is new Marshallers.Generic_Marshaller 322 (Gint, Glib.Values.Get_Int); 323 package Guint_Marshaller is new Marshallers.Generic_Marshaller 324 (Guint, Glib.Values.Get_Uint); 325 package Event_Marshaller is new Marshallers.Generic_Marshaller 326 (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 327 package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 328 (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 329 package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller 330 (Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page); 331 332 function To_Marshaller 333 (Cb : Gint_Marshaller.Handler) 334 return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 335 336 function To_Marshaller 337 (Cb : Guint_Marshaller.Handler) 338 return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 339 340 function To_Marshaller 341 (Cb : Event_Marshaller.Handler) 342 return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 343 344 function To_Marshaller 345 (Cb : Widget_Marshaller.Handler) 346 return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 347 348 function To_Marshaller 349 (Cb : Marshallers.Void_Marshaller.Handler) 350 return Marshallers.Marshaller 351 renames Marshallers.Void_Marshaller.To_Marshaller; 352 353 function To_Marshaller 354 (Cb : Notebook_Page_Marshaller.Handler) 355 return Marshallers.Marshaller 356 renames Notebook_Page_Marshaller.To_Marshaller; 357 358 -- Emitting a signal 359 360 function Emit_By_Name 361 (Object : access Widget_Type'Class; 362 Name : Glib.Signal_Name; 363 Param : Gint) 364 return Return_Type renames Gint_Marshaller.Emit_By_Name; 365 366 function Emit_By_Name 367 (Object : access Widget_Type'Class; 368 Name : Glib.Signal_Name; 369 Param : Guint) 370 return Return_Type renames Guint_Marshaller.Emit_By_Name; 371 372 function Emit_By_Name 373 (Object : access Widget_Type'Class; 374 Name : Glib.Signal_Name; 375 Param : Gdk.Event.Gdk_Event) return Return_Type; 376 377 function Emit_By_Name 378 (Object : access Widget_Type'Class; 379 Name : Glib.Signal_Name; 380 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 381 return Return_Type renames Widget_Marshaller.Emit_By_Name; 382 383 function Emit_By_Name 384 (Object : access Widget_Type'Class; 385 Name : Glib.Signal_Name) 386 return Return_Type renames Marshallers.Void_Marshaller.Emit_By_Name; 387 388 function Emit_By_Name 389 (Object : access Widget_Type'Class; 390 Name : Glib.Signal_Name; 391 Param : Gtk.Notebook.Gtk_Notebook_Page) 392 return Return_Type renames Notebook_Page_Marshaller.Emit_By_Name; 393 394 private 395 -- <doc_ignore> 396 type Acc is access all Widget_Type'Class; 397 -- This type has to be declared at library level, otherwise 398 -- Program_Error might be raised when trying to cast from the 399 -- parameter of Marshaller to another type. 400 401 type Data_Type_Record is record 402 Func : Handler; 403 -- User's callback 404 405 Proxy : Marshallers.Handler_Proxy := null; 406 -- Handler_Proxy to use 407 408 Object : Acc := null; 409 -- Slot Object for Object_Connect 410 end record; 411 type Data_Type_Access is access all Data_Type_Record; 412 pragma Convention (C, Data_Type_Access); 413 -- Data passed to the C handler 414 415 function Convert is new Unchecked_Conversion 416 (Data_Type_Access, System.Address); 417 function Convert is new Unchecked_Conversion 418 (System.Address, Data_Type_Access); 419 420 procedure Free_Data (Data : Data_Type_Access); 421 pragma Convention (C, Free_Data); 422 -- Free the memory associated with the callback's data 423 424 procedure First_Marshaller 425 (Closure : GClosure; 426 Return_Value : Glib.Values.GValue; 427 N_Params : Guint; 428 Params : System.Address; 429 Invocation_Hint : System.Address; 430 User_Data : System.Address); 431 pragma Convention (C, First_Marshaller); 432 -- First level marshaller. This is the function that is actually 433 -- called by gtk+. It then calls the Ada functions as required. 434 -- </doc_ignore> 435 436 end Return_Callback; 437 438 --------------------------------------------------------- 439 -- These handlers should return a value 440 -- They require a User_Data 441 -- See also the package User_Callback_With_Setup 442 --------------------------------------------------------- 443 444 generic 445 type Widget_Type is new Glib.Object.GObject_Record with private; 446 type Return_Type is (<>); 447 type User_Type (<>) is private; 448 package User_Return_Callback is 449 450 type Handler is access function 451 (Widget : access Widget_Type'Class; 452 Params : Glib.Values.GValues; 453 User_Data : User_Type) return Return_Type; 454 type Simple_Handler is access function 455 (Widget : access Widget_Type'Class; 456 User_Data : User_Type) return Return_Type; 457 458 package Marshallers is new Gtk.Marshallers.User_Return_Marshallers 459 (Widget_Type, Return_Type, User_Type); 460 461 -- Connecting a handler to an object 462 463 procedure Connect 464 (Widget : access Widget_Type'Class; 465 Name : Glib.Signal_Name; 466 Marsh : Marshallers.Marshaller; 467 User_Data : User_Type; 468 After : Boolean := False); 469 procedure Object_Connect 470 (Widget : access Glib.Object.GObject_Record'Class; 471 Name : Glib.Signal_Name; 472 Marsh : Marshallers.Marshaller; 473 Slot_Object : access Widget_Type'Class; 474 User_Data : User_Type; 475 After : Boolean := False); 476 477 procedure Connect 478 (Widget : access Widget_Type'Class; 479 Name : Glib.Signal_Name; 480 Cb : Simple_Handler; 481 User_Data : User_Type; 482 After : Boolean := False); 483 procedure Object_Connect 484 (Widget : access Glib.Object.GObject_Record'Class; 485 Name : Glib.Signal_Name; 486 Cb : Simple_Handler; 487 Slot_Object : access Widget_Type'Class; 488 User_Data : User_Type; 489 After : Boolean := False); 490 491 procedure Connect 492 (Widget : access Widget_Type'Class; 493 Name : Glib.Signal_Name; 494 Cb : Handler; 495 User_Data : User_Type; 496 After : Boolean := False); 497 procedure Object_Connect 498 (Widget : access Glib.Object.GObject_Record'Class; 499 Name : Glib.Signal_Name; 500 Cb : Handler; 501 Slot_Object : access Widget_Type'Class; 502 User_Data : User_Type; 503 After : Boolean := False); 504 505 pragma Inline (Connect); 506 507 function Connect 508 (Widget : access Widget_Type'Class; 509 Name : Glib.Signal_Name; 510 Marsh : Marshallers.Marshaller; 511 User_Data : User_Type; 512 After : Boolean := False) return Handler_Id; 513 514 function Object_Connect 515 (Widget : access Glib.Object.GObject_Record'Class; 516 Name : Glib.Signal_Name; 517 Marsh : Marshallers.Marshaller; 518 Slot_Object : access Widget_Type'Class; 519 User_Data : User_Type; 520 After : Boolean := False) return Handler_Id; 521 522 function Connect 523 (Widget : access Widget_Type'Class; 524 Name : Glib.Signal_Name; 525 Cb : Handler; 526 User_Data : User_Type; 527 After : Boolean := False) return Handler_Id; 528 529 function Object_Connect 530 (Widget : access Glib.Object.GObject_Record'Class; 531 Name : Glib.Signal_Name; 532 Cb : Handler; 533 Slot_Object : access Widget_Type'Class; 534 User_Data : User_Type; 535 After : Boolean := False) return Handler_Id; 536 537 -- Some convenient functions to create marshallers 538 539 package Gint_Marshaller is new Marshallers.Generic_Marshaller 540 (Gint, Glib.Values.Get_Int); 541 package Guint_Marshaller is new Marshallers.Generic_Marshaller 542 (Guint, Glib.Values.Get_Uint); 543 package Event_Marshaller is new Marshallers.Generic_Marshaller 544 (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 545 package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 546 (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 547 package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller 548 (Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page); 549 550 function To_Marshaller 551 (Cb : Gint_Marshaller.Handler) 552 return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 553 554 function To_Marshaller 555 (Cb : Guint_Marshaller.Handler) 556 return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 557 558 function To_Marshaller 559 (Cb : Event_Marshaller.Handler) 560 return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 561 562 function To_Marshaller 563 (Cb : Widget_Marshaller.Handler) 564 return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 565 566 function To_Marshaller 567 (Cb : Marshallers.Void_Marshaller.Handler) 568 return Marshallers.Marshaller 569 renames Marshallers.Void_Marshaller.To_Marshaller; 570 571 function To_Marshaller 572 (Cb : Notebook_Page_Marshaller.Handler) 573 return Marshallers.Marshaller 574 renames Notebook_Page_Marshaller.To_Marshaller; 575 576 -- Emitting a signal 577 578 function Emit_By_Name 579 (Object : access Widget_Type'Class; 580 Name : Glib.Signal_Name; 581 Param : Gint) 582 return Return_Type renames Gint_Marshaller.Emit_By_Name; 583 584 function Emit_By_Name 585 (Object : access Widget_Type'Class; 586 Name : Glib.Signal_Name; 587 Param : Guint) 588 return Return_Type renames Guint_Marshaller.Emit_By_Name; 589 590 function Emit_By_Name 591 (Object : access Widget_Type'Class; 592 Name : Glib.Signal_Name; 593 Param : Gdk.Event.Gdk_Event) return Return_Type; 594 595 function Emit_By_Name 596 (Object : access Widget_Type'Class; 597 Name : Glib.Signal_Name; 598 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 599 return Return_Type renames Widget_Marshaller.Emit_By_Name; 600 601 function Emit_By_Name 602 (Object : access Widget_Type'Class; 603 Name : Glib.Signal_Name) 604 return Return_Type renames Marshallers.Void_Marshaller.Emit_By_Name; 605 606 function Emit_By_Name 607 (Object : access Widget_Type'Class; 608 Name : Glib.Signal_Name; 609 Param : Gtk.Notebook.Gtk_Notebook_Page) 610 return Return_Type renames Notebook_Page_Marshaller.Emit_By_Name; 611 612 private 613 -- <doc_ignore> 614 type Acc is access all Widget_Type'Class; 615 -- This type has to be declared at library level, otherwise 616 -- Program_Error might be raised when trying to cast from the 617 -- parameter of Marshaller to another type. 618 619 type User_Access is access User_Type; 620 type Data_Type_Record is record 621 Func : Handler; 622 -- User's callback 623 624 Proxy : Marshallers.Handler_Proxy := null; 625 -- Handler_Proxy to use 626 627 User : User_Access := null; 628 Object : Acc := null; 629 -- Slot Object for Object_Connect 630 end record; 631 type Data_Type_Access is access all Data_Type_Record; 632 pragma Convention (C, Data_Type_Access); 633 -- Data passed to the C handler 634 635 function Convert is new Unchecked_Conversion 636 (Data_Type_Access, System.Address); 637 function Convert is new Unchecked_Conversion 638 (System.Address, Data_Type_Access); 639 640 procedure Free_Data (Data : Data_Type_Access); 641 pragma Convention (C, Free_Data); 642 -- Free the memory associated with the callback's data 643 644 procedure First_Marshaller 645 (Closure : GClosure; 646 Return_Value : Glib.Values.GValue; 647 N_Params : Guint; 648 Params : System.Address; 649 Invocation_Hint : System.Address; 650 User_Data : System.Address); 651 pragma Convention (C, First_Marshaller); 652 -- First level marshaller. This is the function that is actually 653 -- called by gtk+. It then calls the Ada functions as required. 654 -- </doc_ignore> 655 656 end User_Return_Callback; 657 658 ------------------------------------- 659 -- User_Return_Callback_With_Setup -- 660 ------------------------------------- 661 -- This package is basically the same as User_Return_Callback, except that 662 -- an extra function (Setup) is called after a handler has been 663 -- connected. Typical usage is to automatically call Add_Watch (see below) 664 -- in case the User_Type is (or contains) widgets. 665 666 generic 667 type Widget_Type is new Glib.Object.GObject_Record with private; 668 type Return_Type is (<>); 669 type User_Type (<>) is private; 670 with procedure Setup (User_Data : User_Type; Id : Handler_Id); 671 package User_Return_Callback_With_Setup is 672 673 package Internal_Cb is new User_Return_Callback 674 (Widget_Type, Return_Type, User_Type); 675 676 subtype Handler is Internal_Cb.Handler; 677 subtype Simple_Handler is Internal_Cb.Simple_Handler; 678 package Marshallers renames Internal_Cb.Marshallers; 679 680 -- Connecting a handler to an object 681 682 procedure Connect 683 (Widget : access Widget_Type'Class; 684 Name : Glib.Signal_Name; 685 Marsh : Marshallers.Marshaller; 686 User_Data : User_Type; 687 After : Boolean := False); 688 procedure Object_Connect 689 (Widget : access Glib.Object.GObject_Record'Class; 690 Name : Glib.Signal_Name; 691 Marsh : Marshallers.Marshaller; 692 Slot_Object : access Widget_Type'Class; 693 User_Data : User_Type; 694 After : Boolean := False); 695 696 procedure Connect 697 (Widget : access Widget_Type'Class; 698 Name : Glib.Signal_Name; 699 Cb : Handler; 700 User_Data : User_Type; 701 After : Boolean := False); 702 procedure Object_Connect 703 (Widget : access Glib.Object.GObject_Record'Class; 704 Name : Glib.Signal_Name; 705 Cb : Handler; 706 Slot_Object : access Widget_Type'Class; 707 User_Data : User_Type; 708 After : Boolean := False); 709 710 procedure Connect 711 (Widget : access Widget_Type'Class; 712 Name : Glib.Signal_Name; 713 Cb : Simple_Handler; 714 User_Data : User_Type; 715 After : Boolean := False); 716 procedure Object_Connect 717 (Widget : access Glib.Object.GObject_Record'Class; 718 Name : Glib.Signal_Name; 719 Cb : Simple_Handler; 720 Slot_Object : access Widget_Type'Class; 721 User_Data : User_Type; 722 After : Boolean := False); 723 724 pragma Inline (Connect); 725 726 function Connect 727 (Widget : access Widget_Type'Class; 728 Name : Glib.Signal_Name; 729 Marsh : Marshallers.Marshaller; 730 User_Data : User_Type; 731 After : Boolean := False) return Handler_Id; 732 733 function Object_Connect 734 (Widget : access Glib.Object.GObject_Record'Class; 735 Name : Glib.Signal_Name; 736 Marsh : Marshallers.Marshaller; 737 Slot_Object : access Widget_Type'Class; 738 User_Data : User_Type; 739 After : Boolean := False) return Handler_Id; 740 741 function Connect 742 (Widget : access Widget_Type'Class; 743 Name : Glib.Signal_Name; 744 Cb : Handler; 745 User_Data : User_Type; 746 After : Boolean := False) return Handler_Id; 747 748 function Object_Connect 749 (Widget : access Glib.Object.GObject_Record'Class; 750 Name : Glib.Signal_Name; 751 Cb : Handler; 752 Slot_Object : access Widget_Type'Class; 753 User_Data : User_Type; 754 After : Boolean := False) return Handler_Id; 755 756 -- Some convenient functions to create marshallers 757 758 package Gint_Marshaller renames Internal_Cb.Gint_Marshaller; 759 package Guint_Marshaller renames Internal_Cb.Guint_Marshaller; 760 package Event_Marshaller renames Internal_Cb.Event_Marshaller; 761 package Widget_Marshaller renames Internal_Cb.Widget_Marshaller; 762 package Notebook_Page_Marshaller 763 renames Internal_Cb.Notebook_Page_Marshaller; 764 765 function To_Marshaller 766 (Cb : Gint_Marshaller.Handler) 767 return Internal_Cb.Marshallers.Marshaller 768 renames Internal_Cb.To_Marshaller; 769 function To_Marshaller 770 (Cb : Guint_Marshaller.Handler) 771 return Internal_Cb.Marshallers.Marshaller 772 renames Internal_Cb.To_Marshaller; 773 function To_Marshaller 774 (Cb : Event_Marshaller.Handler) 775 return Internal_Cb.Marshallers.Marshaller 776 renames Internal_Cb.To_Marshaller; 777 function To_Marshaller 778 (Cb : Widget_Marshaller.Handler) 779 return Internal_Cb.Marshallers.Marshaller 780 renames Internal_Cb.To_Marshaller; 781 function To_Marshaller 782 (Cb : Internal_Cb.Marshallers.Void_Marshaller.Handler) 783 return Internal_Cb.Marshallers.Marshaller 784 renames Internal_Cb.To_Marshaller; 785 function To_Marshaller 786 (Cb : Notebook_Page_Marshaller.Handler) 787 return Internal_Cb.Marshallers.Marshaller 788 renames Internal_Cb.To_Marshaller; 789 790 -- Emitting a signal 791 792 function Emit_By_Name 793 (Object : access Widget_Type'Class; 794 Name : Glib.Signal_Name; 795 Param : Gint) return Return_Type renames Internal_Cb.Emit_By_Name; 796 797 function Emit_By_Name 798 (Object : access Widget_Type'Class; 799 Name : Glib.Signal_Name; 800 Param : Guint) return Return_Type renames Internal_Cb.Emit_By_Name; 801 802 function Emit_By_Name 803 (Object : access Widget_Type'Class; 804 Name : Glib.Signal_Name; 805 Param : Gdk.Event.Gdk_Event) return Return_Type 806 renames Internal_Cb.Emit_By_Name; 807 808 function Emit_By_Name 809 (Object : access Widget_Type'Class; 810 Name : Glib.Signal_Name; 811 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 812 return Return_Type renames Internal_Cb.Emit_By_Name; 813 814 function Emit_By_Name 815 (Object : access Widget_Type'Class; 816 Name : Glib.Signal_Name) 817 return Return_Type renames Internal_Cb.Emit_By_Name; 818 819 function Emit_By_Name 820 (Object : access Widget_Type'Class; 821 Name : Glib.Signal_Name; 822 Param : Gtk.Notebook.Gtk_Notebook_Page) 823 return Return_Type renames Internal_Cb.Emit_By_Name; 824 825 end User_Return_Callback_With_Setup; 826 827 --------------------------------------------------------- 828 -- These handlers do not return a value 829 -- They do not have a User_Data 830 --------------------------------------------------------- 831 832 generic 833 type Widget_Type is new Glib.Object.GObject_Record with private; 834 package Callback is 835 836 type Handler is access procedure 837 (Widget : access Widget_Type'Class; 838 Params : Glib.Values.GValues); 839 type Simple_Handler is access procedure 840 (Widget : access Widget_Type'Class); 841 842 package Marshallers is new 843 Gtk.Marshallers.Void_Marshallers (Widget_Type); 844 845 -- Connecting a handler to an object 846 847 procedure Connect 848 (Widget : access Widget_Type'Class; 849 Name : Glib.Signal_Name; 850 Marsh : Marshallers.Marshaller; 851 After : Boolean := False); 852 procedure Object_Connect 853 (Widget : access Glib.Object.GObject_Record'Class; 854 Name : Glib.Signal_Name; 855 Marsh : Marshallers.Marshaller; 856 Slot_Object : access Widget_Type'Class; 857 After : Boolean := False); 858 859 procedure Connect 860 (Widget : access Widget_Type'Class; 861 Name : Glib.Signal_Name; 862 Cb : Handler; 863 After : Boolean := False); 864 procedure Object_Connect 865 (Widget : access Glib.Object.GObject_Record'Class; 866 Name : Glib.Signal_Name; 867 Cb : Handler; 868 Slot_Object : access Widget_Type'Class; 869 After : Boolean := False); 870 871 procedure Connect 872 (Widget : access Widget_Type'Class; 873 Name : Glib.Signal_Name; 874 Cb : Simple_Handler; 875 After : Boolean := False); 876 procedure Object_Connect 877 (Widget : access Glib.Object.GObject_Record'Class; 878 Name : Glib.Signal_Name; 879 Cb : Simple_Handler; 880 Slot_Object : access Widget_Type'Class; 881 After : Boolean := False); 882 883 pragma Inline (Connect); 884 pragma Inline (Object_Connect); 885 886 function Connect 887 (Widget : access Widget_Type'Class; 888 Name : Glib.Signal_Name; 889 Marsh : Marshallers.Marshaller; 890 After : Boolean := False) return Handler_Id; 891 892 function Object_Connect 893 (Widget : access Glib.Object.GObject_Record'Class; 894 Name : Glib.Signal_Name; 895 Marsh : Marshallers.Marshaller; 896 Slot_Object : access Widget_Type'Class; 897 After : Boolean := False) return Handler_Id; 898 899 function Connect 900 (Widget : access Widget_Type'Class; 901 Name : Glib.Signal_Name; 902 Cb : Handler; 903 After : Boolean := False) return Handler_Id; 904 905 function Object_Connect 906 (Widget : access Glib.Object.GObject_Record'Class; 907 Name : Glib.Signal_Name; 908 Cb : Handler; 909 Slot_Object : access Widget_Type'Class; 910 After : Boolean := False) return Handler_Id; 911 912 -- Some convenient functions to create marshallers 913 914 package Gint_Marshaller is new Marshallers.Generic_Marshaller 915 (Gint, Glib.Values.Get_Int); 916 package Guint_Marshaller is new Marshallers.Generic_Marshaller 917 (Guint, Glib.Values.Get_Uint); 918 package Event_Marshaller is new Marshallers.Generic_Marshaller 919 (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 920 package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 921 (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 922 package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller 923 (Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page); 924 package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller 925 (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 926 package Tree_Iter_Tree_Path_Marshaller is 927 new Marshallers.Generic_Marshaller_2 928 (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter, 929 Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 930 package Tree_Path_Tree_Iter_Marshaller is 931 new Marshallers.Generic_Marshaller_2 932 (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path, 933 Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter); 934 935 function To_Marshaller 936 (Cb : Gint_Marshaller.Handler) 937 return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 938 939 function To_Marshaller 940 (Cb : Guint_Marshaller.Handler) 941 return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 942 943 function To_Marshaller 944 (Cb : Event_Marshaller.Handler) 945 return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 946 947 function To_Marshaller 948 (Cb : Widget_Marshaller.Handler) 949 return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 950 951 function To_Marshaller 952 (Cb : Marshallers.Void_Marshaller.Handler) 953 return Marshallers.Marshaller 954 renames Marshallers.Void_Marshaller.To_Marshaller; 955 956 function To_Marshaller 957 (Cb : Notebook_Page_Marshaller.Handler) 958 return Marshallers.Marshaller 959 renames Notebook_Page_Marshaller.To_Marshaller; 960 961 function To_Marshaller 962 (Cb : Tree_Path_Marshaller.Handler) 963 return Marshallers.Marshaller 964 renames Tree_Path_Marshaller.To_Marshaller; 965 966 function To_Marshaller 967 (Cb : Tree_Iter_Tree_Path_Marshaller.Handler) 968 return Marshallers.Marshaller 969 renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller; 970 971 function To_Marshaller 972 (Cb : Tree_Path_Tree_Iter_Marshaller.Handler) 973 return Marshallers.Marshaller 974 renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller; 975 976 -- Emitting a signal 977 978 procedure Emit_By_Name 979 (Object : access Widget_Type'Class; 980 Name : Glib.Signal_Name; 981 Param : Gint) renames Gint_Marshaller.Emit_By_Name; 982 983 procedure Emit_By_Name 984 (Object : access Widget_Type'Class; 985 Name : Glib.Signal_Name; 986 Param : Guint) renames Guint_Marshaller.Emit_By_Name; 987 988 procedure Emit_By_Name 989 (Object : access Widget_Type'Class; 990 Name : Glib.Signal_Name; 991 Param : Gdk.Event.Gdk_Event); 992 993 procedure Emit_By_Name 994 (Object : access Widget_Type'Class; 995 Name : Glib.Signal_Name; 996 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 997 renames Widget_Marshaller.Emit_By_Name; 998 999 procedure Emit_By_Name 1000 (Object : access Widget_Type'Class; 1001 Name : Glib.Signal_Name) 1002 renames Marshallers.Void_Marshaller.Emit_By_Name; 1003 1004 procedure Emit_By_Name 1005 (Object : access Widget_Type'Class; 1006 Name : Glib.Signal_Name; 1007 Param : Gtk.Notebook.Gtk_Notebook_Page) 1008 renames Notebook_Page_Marshaller.Emit_By_Name; 1009 1010 procedure Emit_By_Name is 1011 new Tree_Path_Marshaller.Emit_By_Name_Generic 1012 (Gtk.Tree_Model.To_Address); 1013 1014 procedure Emit_By_Name is 1015 new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic 1016 (Gtk.Tree_Model.To_Address, 1017 Gtk.Tree_Model.To_Address); 1018 1019 procedure Emit_By_Name is 1020 new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic 1021 (Gtk.Tree_Model.To_Address, 1022 Gtk.Tree_Model.To_Address); 1023 1024 private 1025 -- <doc_ignore> 1026 type Acc is access all Widget_Type'Class; 1027 -- This type has to be declared at library level, otherwise 1028 -- Program_Error might be raised when trying to cast from the 1029 -- parameter of Marshaller to another type. 1030 1031 type Data_Type_Record is record 1032 Func : Handler; -- User's callback 1033 Proxy : Marshallers.Handler_Proxy := null; -- Handler_Proxy to use 1034 Object : Acc := null; -- Slot Object for Object_Connect 1035 end record; 1036 type Data_Type_Access is access all Data_Type_Record; 1037 pragma Convention (C, Data_Type_Access); 1038 -- Data passed to the C handler 1039 1040 function Convert is new Unchecked_Conversion 1041 (Data_Type_Access, System.Address); 1042 function Convert is new Unchecked_Conversion 1043 (System.Address, Data_Type_Access); 1044 1045 procedure Free_Data (Data : Data_Type_Access); 1046 pragma Convention (C, Free_Data); 1047 -- Free the memory associated with the callback's data 1048 1049 procedure First_Marshaller 1050 (Closure : GClosure; 1051 Return_Value : Glib.Values.GValue; 1052 N_Params : Guint; 1053 Params : System.Address; 1054 Invocation_Hint : System.Address; 1055 User_Data : System.Address); 1056 pragma Convention (C, First_Marshaller); 1057 -- First level marshaller. This is the function that is actually 1058 -- called by gtk+. It then calls the Ada functions as required. 1059 -- </doc_ignore> 1060 1061 end Callback; 1062 1063 --------------------------------------------------------- 1064 -- These handlers do not return a value 1065 -- They require a User_Data 1066 -- See also the package User_Callback_With_Setup 1067 --------------------------------------------------------- 1068 1069 generic 1070 type Widget_Type is new Glib.Object.GObject_Record with private; 1071 type User_Type (<>) is private; 1072 package User_Callback is 1073 1074 type Handler is access procedure 1075 (Widget : access Widget_Type'Class; 1076 Params : Glib.Values.GValues; 1077 User_Data : User_Type); 1078 type Simple_Handler is access procedure 1079 (Widget : access Widget_Type'Class; 1080 User_Data : User_Type); 1081 1082 package Marshallers is new 1083 Gtk.Marshallers.User_Void_Marshallers (Widget_Type, User_Type); 1084 1085 -- Connecting a handler to an object 1086 1087 procedure Connect 1088 (Widget : access Widget_Type'Class; 1089 Name : Glib.Signal_Name; 1090 Marsh : Marshallers.Marshaller; 1091 User_Data : User_Type; 1092 After : Boolean := False); 1093 procedure Object_Connect 1094 (Widget : access Glib.Object.GObject_Record'Class; 1095 Name : Glib.Signal_Name; 1096 Marsh : Marshallers.Marshaller; 1097 Slot_Object : access Widget_Type'Class; 1098 User_Data : User_Type; 1099 After : Boolean := False); 1100 1101 procedure Connect 1102 (Widget : access Widget_Type'Class; 1103 Name : Glib.Signal_Name; 1104 Cb : Handler; 1105 User_Data : User_Type; 1106 After : Boolean := False); 1107 procedure Object_Connect 1108 (Widget : access Glib.Object.GObject_Record'Class; 1109 Name : Glib.Signal_Name; 1110 Cb : Handler; 1111 Slot_Object : access Widget_Type'Class; 1112 User_Data : User_Type; 1113 After : Boolean := False); 1114 1115 procedure Connect 1116 (Widget : access Widget_Type'Class; 1117 Name : Glib.Signal_Name; 1118 Cb : Simple_Handler; 1119 User_Data : User_Type; 1120 After : Boolean := False); 1121 procedure Object_Connect 1122 (Widget : access Glib.Object.GObject_Record'Class; 1123 Name : Glib.Signal_Name; 1124 Cb : Simple_Handler; 1125 Slot_Object : access Widget_Type'Class; 1126 User_Data : User_Type; 1127 After : Boolean := False); 1128 1129 pragma Inline (Connect); 1130 1131 function Connect 1132 (Widget : access Widget_Type'Class; 1133 Name : Glib.Signal_Name; 1134 Marsh : Marshallers.Marshaller; 1135 User_Data : User_Type; 1136 After : Boolean := False) return Handler_Id; 1137 1138 function Object_Connect 1139 (Widget : access Glib.Object.GObject_Record'Class; 1140 Name : Glib.Signal_Name; 1141 Marsh : Marshallers.Marshaller; 1142 Slot_Object : access Widget_Type'Class; 1143 User_Data : User_Type; 1144 After : Boolean := False) return Handler_Id; 1145 1146 function Connect 1147 (Widget : access Widget_Type'Class; 1148 Name : Glib.Signal_Name; 1149 Cb : Handler; 1150 User_Data : User_Type; 1151 After : Boolean := False) return Handler_Id; 1152 1153 function Object_Connect 1154 (Widget : access Glib.Object.GObject_Record'Class; 1155 Name : Glib.Signal_Name; 1156 Cb : Handler; 1157 Slot_Object : access Widget_Type'Class; 1158 User_Data : User_Type; 1159 After : Boolean := False) return Handler_Id; 1160 1161 -- Some convenient functions to create marshallers 1162 1163 package Gint_Marshaller is new Marshallers.Generic_Marshaller 1164 (Gint, Glib.Values.Get_Int); 1165 package Guint_Marshaller is new Marshallers.Generic_Marshaller 1166 (Guint, Glib.Values.Get_Uint); 1167 package Event_Marshaller is new Marshallers.Generic_Marshaller 1168 (Gdk.Event.Gdk_Event, Gdk.Event.Get_Event); 1169 package Widget_Marshaller is new Marshallers.Generic_Widget_Marshaller 1170 (Gtk.Widget.Gtk_Widget_Record, Gtk.Widget.Gtk_Widget); 1171 package Notebook_Page_Marshaller is new Marshallers.Generic_Marshaller 1172 (Gtk.Notebook.Gtk_Notebook_Page, Gtk.Notebook.Get_Notebook_Page); 1173 package Tree_Path_Marshaller is new Marshallers.Generic_Marshaller 1174 (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 1175 package Tree_Iter_Tree_Path_Marshaller is 1176 new Marshallers.Generic_Marshaller_2 1177 (Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter, 1178 Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path); 1179 package Tree_Path_Tree_Iter_Marshaller is 1180 new Marshallers.Generic_Marshaller_2 1181 (Gtk.Tree_Model.Gtk_Tree_Path, Gtk.Tree_Model.Get_Tree_Path, 1182 Gtk.Tree_Model.Gtk_Tree_Iter, Gtk.Tree_Model.Get_Tree_Iter); 1183 1184 function To_Marshaller 1185 (Cb : Gint_Marshaller.Handler) 1186 return Marshallers.Marshaller renames Gint_Marshaller.To_Marshaller; 1187 1188 function To_Marshaller 1189 (Cb : Guint_Marshaller.Handler) 1190 return Marshallers.Marshaller renames Guint_Marshaller.To_Marshaller; 1191 1192 function To_Marshaller 1193 (Cb : Event_Marshaller.Handler) 1194 return Marshallers.Marshaller renames Event_Marshaller.To_Marshaller; 1195 1196 function To_Marshaller 1197 (Cb : Widget_Marshaller.Handler) 1198 return Marshallers.Marshaller renames Widget_Marshaller.To_Marshaller; 1199 1200 function To_Marshaller 1201 (Cb : Marshallers.Void_Marshaller.Handler) 1202 return Marshallers.Marshaller 1203 renames Marshallers.Void_Marshaller.To_Marshaller; 1204 1205 function To_Marshaller 1206 (Cb : Notebook_Page_Marshaller.Handler) 1207 return Marshallers.Marshaller 1208 renames Notebook_Page_Marshaller.To_Marshaller; 1209 1210 function To_Marshaller 1211 (Cb : Tree_Path_Marshaller.Handler) 1212 return Marshallers.Marshaller 1213 renames Tree_Path_Marshaller.To_Marshaller; 1214 1215 function To_Marshaller 1216 (Cb : Tree_Iter_Tree_Path_Marshaller.Handler) 1217 return Marshallers.Marshaller 1218 renames Tree_Iter_Tree_Path_Marshaller.To_Marshaller; 1219 1220 function To_Marshaller 1221 (Cb : Tree_Path_Tree_Iter_Marshaller.Handler) 1222 return Marshallers.Marshaller 1223 renames Tree_Path_Tree_Iter_Marshaller.To_Marshaller; 1224 1225 -- Emitting a signal 1226 1227 procedure Emit_By_Name 1228 (Object : access Widget_Type'Class; 1229 Name : Glib.Signal_Name; 1230 Param : Gint) renames Gint_Marshaller.Emit_By_Name; 1231 1232 procedure Emit_By_Name 1233 (Object : access Widget_Type'Class; 1234 Name : Glib.Signal_Name; 1235 Param : Guint) renames Guint_Marshaller.Emit_By_Name; 1236 1237 procedure Emit_By_Name 1238 (Object : access Widget_Type'Class; 1239 Name : Glib.Signal_Name; 1240 Param : Gdk.Event.Gdk_Event); 1241 1242 procedure Emit_By_Name 1243 (Object : access Widget_Type'Class; 1244 Name : Glib.Signal_Name; 1245 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 1246 renames Widget_Marshaller.Emit_By_Name; 1247 1248 procedure Emit_By_Name 1249 (Object : access Widget_Type'Class; 1250 Name : Glib.Signal_Name) 1251 renames Marshallers.Void_Marshaller.Emit_By_Name; 1252 1253 procedure Emit_By_Name 1254 (Object : access Widget_Type'Class; 1255 Name : Glib.Signal_Name; 1256 Param : Gtk.Notebook.Gtk_Notebook_Page) 1257 renames Notebook_Page_Marshaller.Emit_By_Name; 1258 1259 procedure Emit_By_Name is 1260 new Tree_Path_Marshaller.Emit_By_Name_Generic 1261 (Gtk.Tree_Model.To_Address); 1262 1263 procedure Emit_By_Name is 1264 new Tree_Iter_Tree_Path_Marshaller.Emit_By_Name_Generic 1265 (Gtk.Tree_Model.To_Address, 1266 Gtk.Tree_Model.To_Address); 1267 1268 procedure Emit_By_Name is 1269 new Tree_Path_Tree_Iter_Marshaller.Emit_By_Name_Generic 1270 (Gtk.Tree_Model.To_Address, 1271 Gtk.Tree_Model.To_Address); 1272 1273 private 1274 -- <doc_ignore> 1275 type Acc is access all Widget_Type'Class; 1276 -- This type has to be declared at library level, otherwise 1277 -- Program_Error might be raised when trying to cast from the 1278 -- parameter of Marshaller to another type. 1279 1280 type User_Access is access User_Type; 1281 type Data_Type_Record is record 1282 Func : Handler; 1283 -- User's callback 1284 1285 Proxy : Marshallers.Handler_Proxy := null; 1286 -- Handler_Proxy to use 1287 1288 User : User_Access := null; 1289 Object : Acc := null; 1290 -- Slot_Object for Object_Connect 1291 end record; 1292 type Data_Type_Access is access all Data_Type_Record; 1293 pragma Convention (C, Data_Type_Access); 1294 -- Data passed to the C handler 1295 1296 function Convert is new Unchecked_Conversion 1297 (Data_Type_Access, System.Address); 1298 function Convert is new Unchecked_Conversion 1299 (System.Address, Data_Type_Access); 1300 1301 procedure Free_Data (Data : Data_Type_Access); 1302 pragma Convention (C, Free_Data); 1303 -- Free the memory associated with the callback's data 1304 1305 procedure First_Marshaller 1306 (Closure : GClosure; 1307 Return_Value : Glib.Values.GValue; 1308 N_Params : Guint; 1309 Params : System.Address; 1310 Invocation_Hint : System.Address; 1311 User_Data : System.Address); 1312 pragma Convention (C, First_Marshaller); 1313 -- First level marshaller. This is the function that is actually 1314 -- called by gtk+. It then calls the Ada functions as required. 1315 -- </doc_ignore> 1316 1317 end User_Callback; 1318 1319 ------------------------------ 1320 -- User_Callback_With_Setup -- 1321 ------------------------------ 1322 -- This package is basically the same as User_Callback, except that an 1323 -- extra function (Setup) is called after a handler has been 1324 -- connected. Typical usage is to automatically call Add_Watch (see below) 1325 -- in case the User_Type is (or contains) widgets. 1326 1327 generic 1328 type Widget_Type is new Glib.Object.GObject_Record with private; 1329 type User_Type (<>) is private; 1330 with procedure Setup (User_Data : User_Type; Id : Handler_Id); 1331 package User_Callback_With_Setup is 1332 1333 package Internal_Cb is new User_Callback (Widget_Type, User_Type); 1334 package Marshallers renames Internal_Cb.Marshallers; 1335 1336 subtype Handler is Internal_Cb.Handler; 1337 subtype Simple_Handler is Internal_Cb.Simple_Handler; 1338 1339 -- Connecting a handler to an object 1340 1341 procedure Connect 1342 (Widget : access Widget_Type'Class; 1343 Name : Glib.Signal_Name; 1344 Marsh : Marshallers.Marshaller; 1345 User_Data : User_Type; 1346 After : Boolean := False); 1347 procedure Object_Connect 1348 (Widget : access Glib.Object.GObject_Record'Class; 1349 Name : Glib.Signal_Name; 1350 Marsh : Marshallers.Marshaller; 1351 Slot_Object : access Widget_Type'Class; 1352 User_Data : User_Type; 1353 After : Boolean := False); 1354 1355 procedure Connect 1356 (Widget : access Widget_Type'Class; 1357 Name : Glib.Signal_Name; 1358 Cb : Handler; 1359 User_Data : User_Type; 1360 After : Boolean := False); 1361 procedure Object_Connect 1362 (Widget : access Glib.Object.GObject_Record'Class; 1363 Name : Glib.Signal_Name; 1364 Cb : Handler; 1365 Slot_Object : access Widget_Type'Class; 1366 User_Data : User_Type; 1367 After : Boolean := False); 1368 1369 procedure Connect 1370 (Widget : access Widget_Type'Class; 1371 Name : Glib.Signal_Name; 1372 Cb : Simple_Handler; 1373 User_Data : User_Type; 1374 After : Boolean := False); 1375 procedure Object_Connect 1376 (Widget : access Glib.Object.GObject_Record'Class; 1377 Name : Glib.Signal_Name; 1378 Cb : Simple_Handler; 1379 Slot_Object : access Widget_Type'Class; 1380 User_Data : User_Type; 1381 After : Boolean := False); 1382 1383 pragma Inline (Connect); 1384 1385 function Connect 1386 (Widget : access Widget_Type'Class; 1387 Name : Glib.Signal_Name; 1388 Marsh : Marshallers.Marshaller; 1389 User_Data : User_Type; 1390 After : Boolean := False) return Handler_Id; 1391 1392 function Object_Connect 1393 (Widget : access Glib.Object.GObject_Record'Class; 1394 Name : Glib.Signal_Name; 1395 Marsh : Marshallers.Marshaller; 1396 Slot_Object : access Widget_Type'Class; 1397 User_Data : User_Type; 1398 After : Boolean := False) return Handler_Id; 1399 1400 function Connect 1401 (Widget : access Widget_Type'Class; 1402 Name : Glib.Signal_Name; 1403 Cb : Handler; 1404 User_Data : User_Type; 1405 After : Boolean := False) return Handler_Id; 1406 1407 function Object_Connect 1408 (Widget : access Glib.Object.GObject_Record'Class; 1409 Name : Glib.Signal_Name; 1410 Cb : Handler; 1411 Slot_Object : access Widget_Type'Class; 1412 User_Data : User_Type; 1413 After : Boolean := False) return Handler_Id; 1414 1415 -- Some convenient functions to create marshallers 1416 1417 package Gint_Marshaller renames Internal_Cb.Gint_Marshaller; 1418 package Guint_Marshaller renames Internal_Cb.Guint_Marshaller; 1419 package Event_Marshaller renames Internal_Cb.Event_Marshaller; 1420 package Widget_Marshaller renames Internal_Cb.Widget_Marshaller; 1421 package Notebook_Page_Marshaller 1422 renames Internal_Cb.Notebook_Page_Marshaller; 1423 1424 function To_Marshaller 1425 (Cb : Gint_Marshaller.Handler) 1426 return Internal_Cb.Marshallers.Marshaller 1427 renames Internal_Cb.To_Marshaller; 1428 function To_Marshaller 1429 (Cb : Guint_Marshaller.Handler) 1430 return Internal_Cb.Marshallers.Marshaller 1431 renames Internal_Cb.To_Marshaller; 1432 function To_Marshaller 1433 (Cb : Event_Marshaller.Handler) 1434 return Internal_Cb.Marshallers.Marshaller 1435 renames Internal_Cb.To_Marshaller; 1436 function To_Marshaller 1437 (Cb : Widget_Marshaller.Handler) 1438 return Internal_Cb.Marshallers.Marshaller 1439 renames Internal_Cb.To_Marshaller; 1440 function To_Marshaller 1441 (Cb : Internal_Cb.Marshallers.Void_Marshaller.Handler) 1442 return Internal_Cb.Marshallers.Marshaller 1443 renames Internal_Cb.To_Marshaller; 1444 function To_Marshaller 1445 (Cb : Notebook_Page_Marshaller.Handler) 1446 return Internal_Cb.Marshallers.Marshaller 1447 renames Internal_Cb.To_Marshaller; 1448 1449 -- Emitting a signal 1450 1451 procedure Emit_By_Name 1452 (Object : access Widget_Type'Class; 1453 Name : Glib.Signal_Name; 1454 Param : Gint) renames Internal_Cb.Emit_By_Name; 1455 1456 procedure Emit_By_Name 1457 (Object : access Widget_Type'Class; 1458 Name : Glib.Signal_Name; 1459 Param : Guint) renames Internal_Cb.Emit_By_Name; 1460 1461 procedure Emit_By_Name 1462 (Object : access Widget_Type'Class; 1463 Name : Glib.Signal_Name; 1464 Param : Gdk.Event.Gdk_Event) renames Internal_Cb.Emit_By_Name; 1465 1466 procedure Emit_By_Name 1467 (Object : access Widget_Type'Class; 1468 Name : Glib.Signal_Name; 1469 Param : access Gtk.Widget.Gtk_Widget_Record'Class) 1470 renames Internal_Cb.Emit_By_Name; 1471 1472 procedure Emit_By_Name 1473 (Object : access Widget_Type'Class; 1474 Name : Glib.Signal_Name) renames Internal_Cb.Emit_By_Name; 1475 1476 procedure Emit_By_Name 1477 (Object : access Widget_Type'Class; 1478 Name : Glib.Signal_Name; 1479 Param : Gtk.Notebook.Gtk_Notebook_Page) 1480 renames Internal_Cb.Emit_By_Name; 1481 1482 end User_Callback_With_Setup; 1483 1484 ------------------------------------------------------------------ 1485 -- General functions 1486 ------------------------------------------------------------------ 1487 1488 procedure Add_Watch 1489 (Id : Handler_Id; Object : access Glib.Object.GObject_Record'Class); 1490 -- Make sure that when Object is destroyed, the handler Id is also 1491 -- destroyed. This function should mostly be used in cases where you use a 1492 -- User_Data that is Object. If you don't destroy the callback at the same 1493 -- time, then the next time the callback is called it will try to access 1494 -- some invalid memory (Object being destroyed), and you will likely get a 1495 -- Storage_Error. 1496 1497 procedure Disconnect 1498 (Object : access Glib.Object.GObject_Record'Class; 1499 Id : in out Handler_Id); 1500 -- Disconnect the handler identified by the given Handler_Id. 1501 1502 procedure Emit_Stop_By_Name 1503 (Object : access Glib.Object.GObject_Record'Class; 1504 Name : Glib.Signal_Name); 1505 -- During a signal emission, invoking this procedure will halt the 1506 -- emission. 1507 1508 procedure Handler_Block 1509 (Obj : access Glib.Object.GObject_Record'Class; 1510 Id : Handler_Id); 1511 -- Blocks temporily the signal. For each call to this procedure, 1512 -- a call to Handler_Unblock must be performed in order to really 1513 -- unblock the signal. 1514 1515 procedure Handlers_Destroy 1516 (Obj : access Glib.Object.GObject_Record'Class); 1517 -- Destroys all the handlers associated to the given object. 1518 1519 procedure Handler_Unblock 1520 (Obj : access Glib.Object.GObject_Record'Class; 1521 Id : Handler_Id); 1522 -- See Handler_Block. 1523 1524 -- </doc_ignore> 1525 1526end Gtk.Handlers; 1527 1528-- <example> 1529-- -- This example connects the "delete_event" signal to a widget. 1530-- -- The handlers for this signal get an extra argument which is 1531-- -- the Gdk_Event that generated the signal. 1532-- 1533-- with Gtk.Handlers; use Gtk.Handlers; 1534-- with Gtk.Marshallers; use Gtk.Marshallers; 1535-- 1536-- function My_Cb (Widget : access Gtk_Widget_Record'Class; 1537-- Event : Gdk.Event.Gdk_Event) 1538-- return Gint; 1539-- -- your own function 1540-- 1541-- package Return_Widget_Cb is new Gtk.Handlers.Return_Callback 1542-- (Gtk.Widget.Gtk_Widget_Record, Gint); 1543-- 1544-- Return_Widget_Cb.Connect (W, "delete_event", 1545-- Return_Widget_Cb.To_Marshaller (My_Cb'Access)); 1546-- 1547-- </example> 1548