1------------------------------------------------------------------------------ 2-- -- 3-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 4-- Copyright (C) 2000-2015, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24pragma Style_Checks (Off); 25pragma Warnings (Off, "*is already use-visible*"); 26with Ada.Unchecked_Conversion; 27with Glib.Type_Conversion_Hooks; use Glib.Type_Conversion_Hooks; 28with Glib.Values; use Glib.Values; 29with Gtk.Arguments; use Gtk.Arguments; 30with Gtkada.Bindings; use Gtkada.Bindings; 31pragma Warnings(Off); -- might be unused 32with Interfaces.C.Strings; use Interfaces.C.Strings; 33pragma Warnings(On); 34 35package body Gtk.Menu is 36 37 procedure C_Gtk_Menu_Attach_To_Widget 38 (Menu : System.Address; 39 Attach_Widget : System.Address; 40 Detacher : System.Address); 41 pragma Import (C, C_Gtk_Menu_Attach_To_Widget, "gtk_menu_attach_to_widget"); 42 -- Attaches the menu to the widget and provides a callback function that 43 -- will be invoked when the menu calls Gtk.Menu.Detach during its 44 -- destruction. 45 -- If the menu is attached to the widget then it will be destroyed when 46 -- the widget is destroyed, as if it was a child widget. An attached menu 47 -- will also move between screens correctly if the widgets moves between 48 -- screens. 49 -- "attach_widget": the Gtk.Widget.Gtk_Widget that the menu will be 50 -- attached to 51 -- "detacher": the user supplied callback function that will be called 52 -- when the menu calls Gtk.Menu.Detach 53 54 procedure C_Gtk_Menu_Popup 55 (Menu : System.Address; 56 Parent_Menu_Shell : System.Address; 57 Parent_Menu_Item : System.Address; 58 Func : System.Address; 59 Data : System.Address; 60 Button : Guint; 61 Activate_Time : Guint32); 62 pragma Import (C, C_Gtk_Menu_Popup, "gtk_menu_popup"); 63 -- Displays a menu and makes it available for selection. 64 -- Applications can use this function to display context-sensitive menus, 65 -- and will typically supply null for the Parent_Menu_Shell, 66 -- Parent_Menu_Item, Func and Data parameters. The default menu positioning 67 -- function will position the menu at the current mouse cursor position. 68 -- The Button parameter should be the mouse button pressed to initiate the 69 -- menu popup. If the menu popup was initiated by something other than a 70 -- mouse button press, such as a mouse button release or a keypress, Button 71 -- should be 0. 72 -- The Activate_Time parameter is used to conflict-resolve initiation of 73 -- concurrent requests for mouse/keyboard grab requests. To function 74 -- properly, this needs to be the timestamp of the user event (such as a 75 -- mouse click or key press) that caused the initiation of the popup. Only 76 -- if no such event is available, Gtk.Main.Get_Current_Event_Time can be 77 -- used instead. 78 -- "parent_menu_shell": the menu shell containing the triggering menu 79 -- item, or null 80 -- "parent_menu_item": the menu item whose activation triggered the popup, 81 -- or null 82 -- "func": a user supplied function used to position the menu, or null 83 -- "data": user supplied data to be passed to Func. 84 -- "button": the mouse button which was pressed to initiate the event. 85 -- "activate_time": the time at which the activation event occurred. 86 87 procedure C_Gtk_Menu_Popup_For_Device 88 (Menu : System.Address; 89 Device : System.Address; 90 Parent_Menu_Shell : System.Address; 91 Parent_Menu_Item : System.Address; 92 Func : System.Address; 93 Data : System.Address; 94 Destroy : System.Address; 95 Button : Guint; 96 Activate_Time : Guint32); 97 pragma Import (C, C_Gtk_Menu_Popup_For_Device, "gtk_menu_popup_for_device"); 98 -- Displays a menu and makes it available for selection. 99 -- Applications can use this function to display context-sensitive menus, 100 -- and will typically supply null for the Parent_Menu_Shell, 101 -- Parent_Menu_Item, Func, Data and Destroy parameters. The default menu 102 -- positioning function will position the menu at the current position of 103 -- Device (or its corresponding pointer). 104 -- The Button parameter should be the mouse button pressed to initiate the 105 -- menu popup. If the menu popup was initiated by something other than a 106 -- mouse button press, such as a mouse button release or a keypress, Button 107 -- should be 0. 108 -- The Activate_Time parameter is used to conflict-resolve initiation of 109 -- concurrent requests for mouse/keyboard grab requests. To function 110 -- properly, this needs to be the time stamp of the user event (such as a 111 -- mouse click or key press) that caused the initiation of the popup. Only 112 -- if no such event is available, Gtk.Main.Get_Current_Event_Time can be 113 -- used instead. 114 -- Since: gtk+ 3.0 115 -- "device": a Gdk.Device.Gdk_Device 116 -- "parent_menu_shell": the menu shell containing the triggering menu 117 -- item, or null 118 -- "parent_menu_item": the menu item whose activation triggered the popup, 119 -- or null 120 -- "func": a user supplied function used to position the menu, or null 121 -- "data": user supplied data to be passed to Func 122 -- "destroy": destroy notify for Data 123 -- "button": the mouse button which was pressed to initiate the event 124 -- "activate_time": the time at which the activation event occurred 125 126 function To_Gtk_Menu_Position_Func is new Ada.Unchecked_Conversion 127 (System.Address, Gtk_Menu_Position_Func); 128 129 function To_Address is new Ada.Unchecked_Conversion 130 (Gtk_Menu_Position_Func, System.Address); 131 132 procedure Internal_Gtk_Menu_Position_Func 133 (Menu : System.Address; 134 X : out Gint; 135 Y : out Gint; 136 Push_In : out Glib.Gboolean; 137 User_Data : System.Address); 138 pragma Convention (C, Internal_Gtk_Menu_Position_Func); 139 -- "menu": a Gtk.Menu.Gtk_Menu. 140 -- "x": address of the Gint representing the horizontal position where the 141 -- menu shall be drawn. 142 -- "y": address of the Gint representing the vertical position where the 143 -- menu shall be drawn. This is an output parameter. 144 -- "push_in": This parameter controls how menus placed outside the monitor 145 -- are handled. If this is set to True and part of the menu is outside the 146 -- monitor then GTK+ pushes the window into the visible area, effectively 147 -- modifying the popup position. Note that moving and possibly resizing the 148 -- menu around will alter the scroll position to keep the menu items "in 149 -- place", i.e. at the same monitor position they would have been without 150 -- resizing. In practice, this behavior is only useful for combobox popups 151 -- or option menus and cannot be used to simply confine a menu to monitor 152 -- boundaries. In that case, changing the scroll offset is not desirable. 153 -- "user_data": the data supplied by the user in the Gtk.Menu.Popup Data 154 -- parameter. 155 156 ------------------------------------- 157 -- Internal_Gtk_Menu_Position_Func -- 158 ------------------------------------- 159 160 procedure Internal_Gtk_Menu_Position_Func 161 (Menu : System.Address; 162 X : out Gint; 163 Y : out Gint; 164 Push_In : out Glib.Gboolean; 165 User_Data : System.Address) 166 is 167 Func : constant Gtk_Menu_Position_Func := To_Gtk_Menu_Position_Func (User_Data); 168 Stub_Gtk_Menu : Gtk_Menu_Record; 169 Tmp_Push_In : Boolean; 170 begin 171 Func (Gtk.Menu.Gtk_Menu (Get_User_Data (Menu, Stub_Gtk_Menu)), X, Y, Tmp_Push_In); 172 Push_In := Boolean'Pos (Tmp_Push_In); 173 end Internal_Gtk_Menu_Position_Func; 174 175 package Type_Conversion_Gtk_Menu is new Glib.Type_Conversion_Hooks.Hook_Registrator 176 (Get_Type'Access, Gtk_Menu_Record); 177 pragma Unreferenced (Type_Conversion_Gtk_Menu); 178 179 ------------------ 180 -- Gtk_Menu_New -- 181 ------------------ 182 183 function Gtk_Menu_New return Gtk_Menu is 184 Menu : constant Gtk_Menu := new Gtk_Menu_Record; 185 begin 186 Gtk.Menu.Initialize (Menu); 187 return Menu; 188 end Gtk_Menu_New; 189 190 ----------------------------- 191 -- Gtk_Menu_New_From_Model -- 192 ----------------------------- 193 194 function Gtk_Menu_New_From_Model 195 (Model : not null access Glib.Menu_Model.Gmenu_Model_Record'Class) 196 return Gtk_Menu 197 is 198 Menu : constant Gtk_Menu := new Gtk_Menu_Record; 199 begin 200 Gtk.Menu.Initialize_From_Model (Menu, Model); 201 return Menu; 202 end Gtk_Menu_New_From_Model; 203 204 ------------- 205 -- Gtk_New -- 206 ------------- 207 208 procedure Gtk_New (Menu : out Gtk_Menu) is 209 begin 210 Menu := new Gtk_Menu_Record; 211 Gtk.Menu.Initialize (Menu); 212 end Gtk_New; 213 214 ------------------------ 215 -- Gtk_New_From_Model -- 216 ------------------------ 217 218 procedure Gtk_New_From_Model 219 (Menu : out Gtk_Menu; 220 Model : not null access Glib.Menu_Model.Gmenu_Model_Record'Class) 221 is 222 begin 223 Menu := new Gtk_Menu_Record; 224 Gtk.Menu.Initialize_From_Model (Menu, Model); 225 end Gtk_New_From_Model; 226 227 ---------------- 228 -- Initialize -- 229 ---------------- 230 231 procedure Initialize (Menu : not null access Gtk_Menu_Record'Class) is 232 function Internal return System.Address; 233 pragma Import (C, Internal, "gtk_menu_new"); 234 begin 235 if not Menu.Is_Created then 236 Set_Object (Menu, Internal); 237 end if; 238 end Initialize; 239 240 --------------------------- 241 -- Initialize_From_Model -- 242 --------------------------- 243 244 procedure Initialize_From_Model 245 (Menu : not null access Gtk_Menu_Record'Class; 246 Model : not null access Glib.Menu_Model.Gmenu_Model_Record'Class) 247 is 248 function Internal (Model : System.Address) return System.Address; 249 pragma Import (C, Internal, "gtk_menu_new_from_model"); 250 begin 251 if not Menu.Is_Created then 252 Set_Object (Menu, Internal (Get_Object (Model))); 253 end if; 254 end Initialize_From_Model; 255 256 ------------ 257 -- Attach -- 258 ------------ 259 260 procedure Attach 261 (Menu : not null access Gtk_Menu_Record; 262 Child : not null access Gtk.Widget.Gtk_Widget_Record'Class; 263 Left_Attach : Guint; 264 Right_Attach : Guint; 265 Top_Attach : Guint; 266 Bottom_Attach : Guint) 267 is 268 procedure Internal 269 (Menu : System.Address; 270 Child : System.Address; 271 Left_Attach : Guint; 272 Right_Attach : Guint; 273 Top_Attach : Guint; 274 Bottom_Attach : Guint); 275 pragma Import (C, Internal, "gtk_menu_attach"); 276 begin 277 Internal (Get_Object (Menu), Get_Object (Child), Left_Attach, Right_Attach, Top_Attach, Bottom_Attach); 278 end Attach; 279 280 ---------------------- 281 -- Attach_To_Widget -- 282 ---------------------- 283 284 procedure Attach_To_Widget 285 (Menu : not null access Gtk_Menu_Record; 286 Attach_Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class; 287 Detacher : Gtk_Menu_Detach_Func) 288 is 289 begin 290 if Detacher = null then 291 C_Gtk_Menu_Attach_To_Widget (Get_Object (Menu), Get_Object (Attach_Widget), System.Null_Address); 292 else 293 C_Gtk_Menu_Attach_To_Widget (Get_Object (Menu), Get_Object (Attach_Widget), Detacher'Address); 294 end if; 295 end Attach_To_Widget; 296 297 ------------ 298 -- Detach -- 299 ------------ 300 301 procedure Detach (Menu : not null access Gtk_Menu_Record) is 302 procedure Internal (Menu : System.Address); 303 pragma Import (C, Internal, "gtk_menu_detach"); 304 begin 305 Internal (Get_Object (Menu)); 306 end Detach; 307 308 --------------------- 309 -- Get_Accel_Group -- 310 --------------------- 311 312 function Get_Accel_Group 313 (Menu : not null access Gtk_Menu_Record) 314 return Gtk.Accel_Group.Gtk_Accel_Group 315 is 316 function Internal (Menu : System.Address) return System.Address; 317 pragma Import (C, Internal, "gtk_menu_get_accel_group"); 318 Stub_Gtk_Accel_Group : Gtk.Accel_Group.Gtk_Accel_Group_Record; 319 begin 320 return Gtk.Accel_Group.Gtk_Accel_Group (Get_User_Data (Internal (Get_Object (Menu)), Stub_Gtk_Accel_Group)); 321 end Get_Accel_Group; 322 323 -------------------- 324 -- Get_Accel_Path -- 325 -------------------- 326 327 function Get_Accel_Path 328 (Menu : not null access Gtk_Menu_Record) return UTF8_String 329 is 330 function Internal 331 (Menu : System.Address) return Interfaces.C.Strings.chars_ptr; 332 pragma Import (C, Internal, "gtk_menu_get_accel_path"); 333 begin 334 return Gtkada.Bindings.Value_Allowing_Null (Internal (Get_Object (Menu))); 335 end Get_Accel_Path; 336 337 ---------------- 338 -- Get_Active -- 339 ---------------- 340 341 function Get_Active 342 (Menu : not null access Gtk_Menu_Record) 343 return Gtk.Menu_Item.Gtk_Menu_Item 344 is 345 function Internal (Menu : System.Address) return System.Address; 346 pragma Import (C, Internal, "gtk_menu_get_active"); 347 Stub_Gtk_Menu_Item : Gtk.Menu_Item.Gtk_Menu_Item_Record; 348 begin 349 return Gtk.Menu_Item.Gtk_Menu_Item (Get_User_Data (Internal (Get_Object (Menu)), Stub_Gtk_Menu_Item)); 350 end Get_Active; 351 352 ----------------------- 353 -- Get_Attach_Widget -- 354 ----------------------- 355 356 function Get_Attach_Widget 357 (Menu : not null access Gtk_Menu_Record) return Gtk.Widget.Gtk_Widget 358 is 359 function Internal (Menu : System.Address) return System.Address; 360 pragma Import (C, Internal, "gtk_menu_get_attach_widget"); 361 Stub_Gtk_Widget : Gtk.Widget.Gtk_Widget_Record; 362 begin 363 return Gtk.Widget.Gtk_Widget (Get_User_Data (Internal (Get_Object (Menu)), Stub_Gtk_Widget)); 364 end Get_Attach_Widget; 365 366 ----------------- 367 -- Get_Monitor -- 368 ----------------- 369 370 function Get_Monitor (Menu : not null access Gtk_Menu_Record) return Gint is 371 function Internal (Menu : System.Address) return Gint; 372 pragma Import (C, Internal, "gtk_menu_get_monitor"); 373 begin 374 return Internal (Get_Object (Menu)); 375 end Get_Monitor; 376 377 ----------------------------- 378 -- Get_Reserve_Toggle_Size -- 379 ----------------------------- 380 381 function Get_Reserve_Toggle_Size 382 (Menu : not null access Gtk_Menu_Record) return Boolean 383 is 384 function Internal (Menu : System.Address) return Glib.Gboolean; 385 pragma Import (C, Internal, "gtk_menu_get_reserve_toggle_size"); 386 begin 387 return Internal (Get_Object (Menu)) /= 0; 388 end Get_Reserve_Toggle_Size; 389 390 ----------------------- 391 -- Get_Tearoff_State -- 392 ----------------------- 393 394 function Get_Tearoff_State 395 (Menu : not null access Gtk_Menu_Record) return Boolean 396 is 397 function Internal (Menu : System.Address) return Glib.Gboolean; 398 pragma Import (C, Internal, "gtk_menu_get_tearoff_state"); 399 begin 400 return Internal (Get_Object (Menu)) /= 0; 401 end Get_Tearoff_State; 402 403 --------------- 404 -- Get_Title -- 405 --------------- 406 407 function Get_Title 408 (Menu : not null access Gtk_Menu_Record) return UTF8_String 409 is 410 function Internal 411 (Menu : System.Address) return Interfaces.C.Strings.chars_ptr; 412 pragma Import (C, Internal, "gtk_menu_get_title"); 413 begin 414 return Gtkada.Bindings.Value_Allowing_Null (Internal (Get_Object (Menu))); 415 end Get_Title; 416 417 ------------- 418 -- Popdown -- 419 ------------- 420 421 procedure Popdown (Menu : not null access Gtk_Menu_Record) is 422 procedure Internal (Menu : System.Address); 423 pragma Import (C, Internal, "gtk_menu_popdown"); 424 begin 425 Internal (Get_Object (Menu)); 426 end Popdown; 427 428 ----------- 429 -- Popup -- 430 ----------- 431 432 procedure Popup 433 (Menu : not null access Gtk_Menu_Record; 434 Parent_Menu_Shell : Gtk.Menu_Shell.Gtk_Menu_Shell := null; 435 Parent_Menu_Item : Gtk.Menu_Item.Gtk_Menu_Item := null; 436 Func : Gtk_Menu_Position_Func := null; 437 Button : Guint := 1; 438 Activate_Time : Guint32 := 0) 439 is 440 begin 441 if Func = null then 442 C_Gtk_Menu_Popup (Get_Object (Menu), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), System.Null_Address, System.Null_Address, Button, Activate_Time); 443 else 444 C_Gtk_Menu_Popup (Get_Object (Menu), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), Internal_Gtk_Menu_Position_Func'Address, To_Address (Func), Button, Activate_Time); 445 end if; 446 end Popup; 447 448 ---------------------- 449 -- Popup_For_Device -- 450 ---------------------- 451 452 procedure Popup_For_Device 453 (Menu : not null access Gtk_Menu_Record; 454 Device : access Gdk.Device.Gdk_Device_Record'Class; 455 Parent_Menu_Shell : access Gtk.Widget.Gtk_Widget_Record'Class; 456 Parent_Menu_Item : access Gtk.Widget.Gtk_Widget_Record'Class; 457 Func : Gtk_Menu_Position_Func; 458 Button : Guint; 459 Activate_Time : Guint32) 460 is 461 begin 462 if Func = null then 463 C_Gtk_Menu_Popup_For_Device (Get_Object (Menu), Get_Object_Or_Null (GObject (Device)), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), System.Null_Address, System.Null_Address, System.Null_Address, Button, Activate_Time); 464 else 465 C_Gtk_Menu_Popup_For_Device (Get_Object (Menu), Get_Object_Or_Null (GObject (Device)), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), Internal_Gtk_Menu_Position_Func'Address, To_Address (Func), System.Null_Address, Button, Activate_Time); 466 end if; 467 end Popup_For_Device; 468 469 package body Popup_For_Device_User_Data is 470 471 package Users is new Glib.Object.User_Data_Closure 472 (User_Data_Type, Destroy); 473 474 function To_Gtk_Menu_Position_Func is new Ada.Unchecked_Conversion 475 (System.Address, Gtk_Menu_Position_Func); 476 477 function To_Address is new Ada.Unchecked_Conversion 478 (Gtk_Menu_Position_Func, System.Address); 479 480 procedure Internal_Cb 481 (Menu : System.Address; 482 X : out Gint; 483 Y : out Gint; 484 Push_In : out Glib.Gboolean; 485 User_Data : System.Address); 486 pragma Convention (C, Internal_Cb); 487 -- A user function supplied when calling Gtk.Menu.Popup which controls 488 -- the positioning of the menu when it is displayed. The function sets 489 -- the X and Y parameters to the coordinates where the menu is to be 490 -- drawn. To make the menu appear on a different monitor than the mouse 491 -- pointer, Gtk.Menu.Set_Monitor must be called. 492 -- "menu": a Gtk.Menu.Gtk_Menu. 493 -- "x": address of the Gint representing the horizontal position where 494 -- the menu shall be drawn. 495 -- "y": address of the Gint representing the vertical position where 496 -- the menu shall be drawn. This is an output parameter. 497 -- "push_in": This parameter controls how menus placed outside the 498 -- monitor are handled. If this is set to True and part of the menu is 499 -- outside the monitor then GTK+ pushes the window into the visible 500 -- area, effectively modifying the popup position. Note that moving and 501 -- possibly resizing the menu around will alter the scroll position to 502 -- keep the menu items "in place", i.e. at the same monitor position 503 -- they would have been without resizing. In practice, this behavior is 504 -- only useful for combobox popups or option menus and cannot be used to 505 -- simply confine a menu to monitor boundaries. In that case, changing 506 -- the scroll offset is not desirable. 507 -- "user_data": the data supplied by the user in the Gtk.Menu.Popup 508 -- Data parameter. 509 510 ----------------- 511 -- Internal_Cb -- 512 ----------------- 513 514 procedure Internal_Cb 515 (Menu : System.Address; 516 X : out Gint; 517 Y : out Gint; 518 Push_In : out Glib.Gboolean; 519 User_Data : System.Address) 520 is 521 D : constant Users.Internal_Data_Access := Users.Convert (User_Data); 522 Stub_Gtk_Menu : Gtk.Menu.Gtk_Menu_Record; 523 Tmp_Push_In : Boolean; 524 begin 525 To_Gtk_Menu_Position_Func (D.Func) (Gtk.Menu.Gtk_Menu (Get_User_Data (Menu, Stub_Gtk_Menu)), X, Y, Tmp_Push_In, D.Data.all); 526 Push_In := Boolean'Pos (Tmp_Push_In); 527 end Internal_Cb; 528 529 ---------------------- 530 -- Popup_For_Device -- 531 ---------------------- 532 533 procedure Popup_For_Device 534 (Menu : not null access Gtk.Menu.Gtk_Menu_Record'Class; 535 Device : access Gdk.Device.Gdk_Device_Record'Class; 536 Parent_Menu_Shell : access Gtk.Widget.Gtk_Widget_Record'Class; 537 Parent_Menu_Item : access Gtk.Widget.Gtk_Widget_Record'Class; 538 Func : Gtk_Menu_Position_Func; 539 Data : User_Data_Type; 540 Button : Guint; 541 Activate_Time : Guint32) 542 is 543 begin 544 if Func = null then 545 C_Gtk_Menu_Popup_For_Device (Get_Object (Menu), Get_Object_Or_Null (GObject (Device)), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), System.Null_Address, System.Null_Address, Users.Free_Data'Address, Button, Activate_Time); 546 else 547 C_Gtk_Menu_Popup_For_Device (Get_Object (Menu), Get_Object_Or_Null (GObject (Device)), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), Internal_Cb'Address, Users.Build (To_Address (Func), Data), Users.Free_Data'Address, Button, Activate_Time); 548 end if; 549 end Popup_For_Device; 550 551 end Popup_For_Device_User_Data; 552 553 package body Popup_User_Data is 554 555 package Users is new Glib.Object.User_Data_Closure 556 (User_Data_Type, Destroy); 557 558 function To_Gtk_Menu_Position_Func is new Ada.Unchecked_Conversion 559 (System.Address, Gtk_Menu_Position_Func); 560 561 function To_Address is new Ada.Unchecked_Conversion 562 (Gtk_Menu_Position_Func, System.Address); 563 564 procedure Internal_Cb 565 (Menu : System.Address; 566 X : out Gint; 567 Y : out Gint; 568 Push_In : out Glib.Gboolean; 569 User_Data : System.Address); 570 pragma Convention (C, Internal_Cb); 571 -- A user function supplied when calling Gtk.Menu.Popup which controls 572 -- the positioning of the menu when it is displayed. The function sets 573 -- the X and Y parameters to the coordinates where the menu is to be 574 -- drawn. To make the menu appear on a different monitor than the mouse 575 -- pointer, Gtk.Menu.Set_Monitor must be called. 576 -- "menu": a Gtk.Menu.Gtk_Menu. 577 -- "x": address of the Gint representing the horizontal position where 578 -- the menu shall be drawn. 579 -- "y": address of the Gint representing the vertical position where 580 -- the menu shall be drawn. This is an output parameter. 581 -- "push_in": This parameter controls how menus placed outside the 582 -- monitor are handled. If this is set to True and part of the menu is 583 -- outside the monitor then GTK+ pushes the window into the visible 584 -- area, effectively modifying the popup position. Note that moving and 585 -- possibly resizing the menu around will alter the scroll position to 586 -- keep the menu items "in place", i.e. at the same monitor position 587 -- they would have been without resizing. In practice, this behavior is 588 -- only useful for combobox popups or option menus and cannot be used to 589 -- simply confine a menu to monitor boundaries. In that case, changing 590 -- the scroll offset is not desirable. 591 -- "user_data": the data supplied by the user in the Gtk.Menu.Popup 592 -- Data parameter. 593 594 ----------------- 595 -- Internal_Cb -- 596 ----------------- 597 598 procedure Internal_Cb 599 (Menu : System.Address; 600 X : out Gint; 601 Y : out Gint; 602 Push_In : out Glib.Gboolean; 603 User_Data : System.Address) 604 is 605 D : constant Users.Internal_Data_Access := Users.Convert (User_Data); 606 Stub_Gtk_Menu : Gtk.Menu.Gtk_Menu_Record; 607 Tmp_Push_In : Boolean; 608 begin 609 To_Gtk_Menu_Position_Func (D.Func) (Gtk.Menu.Gtk_Menu (Get_User_Data (Menu, Stub_Gtk_Menu)), X, Y, Tmp_Push_In, D.Data.all); 610 Push_In := Boolean'Pos (Tmp_Push_In); 611 end Internal_Cb; 612 613 ----------- 614 -- Popup -- 615 ----------- 616 617 procedure Popup 618 (Menu : not null access Gtk.Menu.Gtk_Menu_Record'Class; 619 Parent_Menu_Shell : Gtk.Menu_Shell.Gtk_Menu_Shell := null; 620 Parent_Menu_Item : Gtk.Menu_Item.Gtk_Menu_Item := null; 621 Func : Gtk_Menu_Position_Func := null; 622 Data : User_Data_Type; 623 Button : Guint := 1; 624 Activate_Time : Guint32 := 0) 625 is 626 begin 627 if Func = null then 628 C_Gtk_Menu_Popup (Get_Object (Menu), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), System.Null_Address, System.Null_Address, Button, Activate_Time); 629 else 630 C_Gtk_Menu_Popup (Get_Object (Menu), Get_Object_Or_Null (GObject (Parent_Menu_Shell)), Get_Object_Or_Null (GObject (Parent_Menu_Item)), Internal_Cb'Address, Users.Build (To_Address (Func), Data), Button, Activate_Time); 631 end if; 632 end Popup; 633 634 end Popup_User_Data; 635 636 ------------------- 637 -- Reorder_Child -- 638 ------------------- 639 640 procedure Reorder_Child 641 (Menu : not null access Gtk_Menu_Record; 642 Child : not null access Gtk.Widget.Gtk_Widget_Record'Class; 643 Position : Gint) 644 is 645 procedure Internal 646 (Menu : System.Address; 647 Child : System.Address; 648 Position : Gint); 649 pragma Import (C, Internal, "gtk_menu_reorder_child"); 650 begin 651 Internal (Get_Object (Menu), Get_Object (Child), Position); 652 end Reorder_Child; 653 654 ---------------- 655 -- Reposition -- 656 ---------------- 657 658 procedure Reposition (Menu : not null access Gtk_Menu_Record) is 659 procedure Internal (Menu : System.Address); 660 pragma Import (C, Internal, "gtk_menu_reposition"); 661 begin 662 Internal (Get_Object (Menu)); 663 end Reposition; 664 665 --------------------- 666 -- Set_Accel_Group -- 667 --------------------- 668 669 procedure Set_Accel_Group 670 (Menu : not null access Gtk_Menu_Record; 671 Accel_Group : access Gtk.Accel_Group.Gtk_Accel_Group_Record'Class) 672 is 673 procedure Internal 674 (Menu : System.Address; 675 Accel_Group : System.Address); 676 pragma Import (C, Internal, "gtk_menu_set_accel_group"); 677 begin 678 Internal (Get_Object (Menu), Get_Object_Or_Null (GObject (Accel_Group))); 679 end Set_Accel_Group; 680 681 -------------------- 682 -- Set_Accel_Path -- 683 -------------------- 684 685 procedure Set_Accel_Path 686 (Menu : not null access Gtk_Menu_Record; 687 Accel_Path : UTF8_String := "") 688 is 689 procedure Internal 690 (Menu : System.Address; 691 Accel_Path : Interfaces.C.Strings.chars_ptr); 692 pragma Import (C, Internal, "gtk_menu_set_accel_path"); 693 Tmp_Accel_Path : Interfaces.C.Strings.chars_ptr; 694 begin 695 if Accel_Path = "" then 696 Tmp_Accel_Path := Interfaces.C.Strings.Null_Ptr; 697 else 698 Tmp_Accel_Path := New_String (Accel_Path); 699 end if; 700 Internal (Get_Object (Menu), Tmp_Accel_Path); 701 Free (Tmp_Accel_Path); 702 end Set_Accel_Path; 703 704 ---------------- 705 -- Set_Active -- 706 ---------------- 707 708 procedure Set_Active 709 (Menu : not null access Gtk_Menu_Record; 710 Index : Guint) 711 is 712 procedure Internal (Menu : System.Address; Index : Guint); 713 pragma Import (C, Internal, "gtk_menu_set_active"); 714 begin 715 Internal (Get_Object (Menu), Index); 716 end Set_Active; 717 718 ----------------- 719 -- Set_Monitor -- 720 ----------------- 721 722 procedure Set_Monitor 723 (Menu : not null access Gtk_Menu_Record; 724 Monitor_Num : Gint) 725 is 726 procedure Internal (Menu : System.Address; Monitor_Num : Gint); 727 pragma Import (C, Internal, "gtk_menu_set_monitor"); 728 begin 729 Internal (Get_Object (Menu), Monitor_Num); 730 end Set_Monitor; 731 732 ----------------------------- 733 -- Set_Reserve_Toggle_Size -- 734 ----------------------------- 735 736 procedure Set_Reserve_Toggle_Size 737 (Menu : not null access Gtk_Menu_Record; 738 Reserve_Toggle_Size : Boolean) 739 is 740 procedure Internal 741 (Menu : System.Address; 742 Reserve_Toggle_Size : Glib.Gboolean); 743 pragma Import (C, Internal, "gtk_menu_set_reserve_toggle_size"); 744 begin 745 Internal (Get_Object (Menu), Boolean'Pos (Reserve_Toggle_Size)); 746 end Set_Reserve_Toggle_Size; 747 748 ---------------- 749 -- Set_Screen -- 750 ---------------- 751 752 procedure Set_Screen 753 (Menu : not null access Gtk_Menu_Record; 754 Screen : access Gdk.Screen.Gdk_Screen_Record'Class) 755 is 756 procedure Internal (Menu : System.Address; Screen : System.Address); 757 pragma Import (C, Internal, "gtk_menu_set_screen"); 758 begin 759 Internal (Get_Object (Menu), Get_Object_Or_Null (GObject (Screen))); 760 end Set_Screen; 761 762 ----------------------- 763 -- Set_Tearoff_State -- 764 ----------------------- 765 766 procedure Set_Tearoff_State 767 (Menu : not null access Gtk_Menu_Record; 768 Torn_Off : Boolean) 769 is 770 procedure Internal (Menu : System.Address; Torn_Off : Glib.Gboolean); 771 pragma Import (C, Internal, "gtk_menu_set_tearoff_state"); 772 begin 773 Internal (Get_Object (Menu), Boolean'Pos (Torn_Off)); 774 end Set_Tearoff_State; 775 776 --------------- 777 -- Set_Title -- 778 --------------- 779 780 procedure Set_Title 781 (Menu : not null access Gtk_Menu_Record; 782 Title : UTF8_String) 783 is 784 procedure Internal 785 (Menu : System.Address; 786 Title : Interfaces.C.Strings.chars_ptr); 787 pragma Import (C, Internal, "gtk_menu_set_title"); 788 Tmp_Title : Interfaces.C.Strings.chars_ptr := New_String (Title); 789 begin 790 Internal (Get_Object (Menu), Tmp_Title); 791 Free (Tmp_Title); 792 end Set_Title; 793 794 --------------------------- 795 -- Get_For_Attach_Widget -- 796 --------------------------- 797 798 function Get_For_Attach_Widget 799 (Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class) 800 return Gtk.Widget.Widget_List.Glist 801 is 802 function Internal (Widget : System.Address) return System.Address; 803 pragma Import (C, Internal, "gtk_menu_get_for_attach_widget"); 804 Tmp_Return : Gtk.Widget.Widget_List.Glist; 805 begin 806 Gtk.Widget.Widget_List.Set_Object (Tmp_Return, Internal (Get_Object (Widget))); 807 return Tmp_Return; 808 end Get_For_Attach_Widget; 809 810 use type System.Address; 811 812 function Cb_To_Address is new Ada.Unchecked_Conversion 813 (Cb_Gtk_Menu_Gtk_Scroll_Type_Void, System.Address); 814 function Address_To_Cb is new Ada.Unchecked_Conversion 815 (System.Address, Cb_Gtk_Menu_Gtk_Scroll_Type_Void); 816 817 function Cb_To_Address is new Ada.Unchecked_Conversion 818 (Cb_GObject_Gtk_Scroll_Type_Void, System.Address); 819 function Address_To_Cb is new Ada.Unchecked_Conversion 820 (System.Address, Cb_GObject_Gtk_Scroll_Type_Void); 821 822 procedure Connect 823 (Object : access Gtk_Menu_Record'Class; 824 C_Name : Glib.Signal_Name; 825 Handler : Cb_Gtk_Menu_Gtk_Scroll_Type_Void; 826 After : Boolean); 827 828 procedure Connect_Slot 829 (Object : access Gtk_Menu_Record'Class; 830 C_Name : Glib.Signal_Name; 831 Handler : Cb_GObject_Gtk_Scroll_Type_Void; 832 After : Boolean; 833 Slot : access Glib.Object.GObject_Record'Class := null); 834 835 procedure Marsh_GObject_Gtk_Scroll_Type_Void 836 (Closure : GClosure; 837 Return_Value : Glib.Values.GValue; 838 N_Params : Glib.Guint; 839 Params : Glib.Values.C_GValues; 840 Invocation_Hint : System.Address; 841 User_Data : System.Address); 842 pragma Convention (C, Marsh_GObject_Gtk_Scroll_Type_Void); 843 844 procedure Marsh_Gtk_Menu_Gtk_Scroll_Type_Void 845 (Closure : GClosure; 846 Return_Value : Glib.Values.GValue; 847 N_Params : Glib.Guint; 848 Params : Glib.Values.C_GValues; 849 Invocation_Hint : System.Address; 850 User_Data : System.Address); 851 pragma Convention (C, Marsh_Gtk_Menu_Gtk_Scroll_Type_Void); 852 853 ------------- 854 -- Connect -- 855 ------------- 856 857 procedure Connect 858 (Object : access Gtk_Menu_Record'Class; 859 C_Name : Glib.Signal_Name; 860 Handler : Cb_Gtk_Menu_Gtk_Scroll_Type_Void; 861 After : Boolean) 862 is 863 begin 864 Unchecked_Do_Signal_Connect 865 (Object => Object, 866 C_Name => C_Name, 867 Marshaller => Marsh_Gtk_Menu_Gtk_Scroll_Type_Void'Access, 868 Handler => Cb_To_Address (Handler),-- Set in the closure 869 After => After); 870 end Connect; 871 872 ------------------ 873 -- Connect_Slot -- 874 ------------------ 875 876 procedure Connect_Slot 877 (Object : access Gtk_Menu_Record'Class; 878 C_Name : Glib.Signal_Name; 879 Handler : Cb_GObject_Gtk_Scroll_Type_Void; 880 After : Boolean; 881 Slot : access Glib.Object.GObject_Record'Class := null) 882 is 883 begin 884 Unchecked_Do_Signal_Connect 885 (Object => Object, 886 C_Name => C_Name, 887 Marshaller => Marsh_GObject_Gtk_Scroll_Type_Void'Access, 888 Handler => Cb_To_Address (Handler),-- Set in the closure 889 Slot_Object => Slot, 890 After => After); 891 end Connect_Slot; 892 893 ---------------------------------------- 894 -- Marsh_GObject_Gtk_Scroll_Type_Void -- 895 ---------------------------------------- 896 897 procedure Marsh_GObject_Gtk_Scroll_Type_Void 898 (Closure : GClosure; 899 Return_Value : Glib.Values.GValue; 900 N_Params : Glib.Guint; 901 Params : Glib.Values.C_GValues; 902 Invocation_Hint : System.Address; 903 User_Data : System.Address) 904 is 905 pragma Unreferenced (Return_Value, N_Params, Invocation_Hint, User_Data); 906 H : constant Cb_GObject_Gtk_Scroll_Type_Void := Address_To_Cb (Get_Callback (Closure)); 907 Obj : constant Glib.Object.GObject := Glib.Object.Convert (Get_Data (Closure)); 908 begin 909 H (Obj, Unchecked_To_Gtk_Scroll_Type (Params, 1)); 910 exception when E : others => Process_Exception (E); 911 end Marsh_GObject_Gtk_Scroll_Type_Void; 912 913 ----------------------------------------- 914 -- Marsh_Gtk_Menu_Gtk_Scroll_Type_Void -- 915 ----------------------------------------- 916 917 procedure Marsh_Gtk_Menu_Gtk_Scroll_Type_Void 918 (Closure : GClosure; 919 Return_Value : Glib.Values.GValue; 920 N_Params : Glib.Guint; 921 Params : Glib.Values.C_GValues; 922 Invocation_Hint : System.Address; 923 User_Data : System.Address) 924 is 925 pragma Unreferenced (Return_Value, N_Params, Invocation_Hint, User_Data); 926 H : constant Cb_Gtk_Menu_Gtk_Scroll_Type_Void := Address_To_Cb (Get_Callback (Closure)); 927 Obj : constant Gtk_Menu := Gtk_Menu (Unchecked_To_Object (Params, 0)); 928 begin 929 H (Obj, Unchecked_To_Gtk_Scroll_Type (Params, 1)); 930 exception when E : others => Process_Exception (E); 931 end Marsh_Gtk_Menu_Gtk_Scroll_Type_Void; 932 933 -------------------- 934 -- On_Move_Scroll -- 935 -------------------- 936 937 procedure On_Move_Scroll 938 (Self : not null access Gtk_Menu_Record; 939 Call : Cb_Gtk_Menu_Gtk_Scroll_Type_Void; 940 After : Boolean := False) 941 is 942 begin 943 Connect (Self, "move-scroll" & ASCII.NUL, Call, After); 944 end On_Move_Scroll; 945 946 -------------------- 947 -- On_Move_Scroll -- 948 -------------------- 949 950 procedure On_Move_Scroll 951 (Self : not null access Gtk_Menu_Record; 952 Call : Cb_GObject_Gtk_Scroll_Type_Void; 953 Slot : not null access Glib.Object.GObject_Record'Class; 954 After : Boolean := False) 955 is 956 begin 957 Connect_Slot (Self, "move-scroll" & ASCII.NUL, Call, After, Slot); 958 end On_Move_Scroll; 959 960end Gtk.Menu; 961