Testgtk source code
This code is part of testgtk, a demo application packaged with GtkAda. Testgtk demonstrates the various widgets of GtkAda
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
-- Copyright (C) 2000-2008, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- --
-- --
-- --
-- --
-- --
-- --
-- --
-----------------------------------------------------------------------
with Glib;
use Glib;
with Glib.Object;
use Glib.Object;
with Gtk.Handlers;
with Gtkada.Handlers;
use Gtkada.Handlers;
with Gtk.Box;
use Gtk.Box;
with Gtk.Button;
use Gtk.Button;
with Gtk.Menu;
use Gtk.Menu;
with Gtk.Menu_Bar;
use Gtk.Menu_Bar;
with Gtk.Menu_Item;
use Gtk.Menu_Item;
-- Gtk.Option_Menu is obsolescent, but we would still like to test it.
-- Deactivate obsolencence warning.
pragma Warnings (Off);
with Gtk.Option_Menu;
use Gtk.Option_Menu;
pragma Warnings (On);
with Gtk.Spin_Button;
use Gtk.Spin_Button;
with Gtk.Radio_Menu_Item;
use Gtk.Radio_Menu_Item;
with Gtk.Tearoff_Menu_Item;
use Gtk.Tearoff_Menu_Item;
with Gtk.Widget;
use Gtk.Widget;
with Gtk;
use Gtk;
package body Create_Menu
is
package Button_Cb
is new Handlers.Callback (Gtk_Button_Record);
package My_Popup
is new Gtk.Menu.User_Menu_Popup (Gint);
use My_Popup;
procedure Position_At_0
(Menu :
access Gtk_Menu_Record'Class;
X :
out Gint;
Y :
out Gint);
-- Position function at coordinates 0,0.
procedure Position_At_Data
(Menu :
access Gtk_Menu_Record'Class;
X :
out Gint;
Y :
out Gint;
Val :
access Gint);
-- Position function at coordinates Val,Val.
procedure Popup_At_Position (Widget :
access GObject_Record'Class);
-- Callback for the "Popup at given coordinates" button
procedure Popup (Widget :
access Gtk_Button_Record'Class);
-- Callback for the "Popup at 0,0 coordinates" button
-------------------
-- Position_At_0 --
-------------------
procedure Position_At_0
(Menu :
access Gtk_Menu_Record'Class;
X :
out Gint;
Y :
out Gint)
is
pragma Unreferenced (Menu);
begin
X := 0;
Y := 0;
end Position_At_0;
----------------------
-- Position_At_Data --
----------------------
procedure Position_At_Data
(Menu :
access Gtk_Menu_Record'Class;
X :
out Gint;
Y :
out Gint;
Val :
access Gint)
is
pragma Unreferenced (Menu);
begin
X := Val.
all;
Y := Val.
all;
end Position_At_Data;
-----------------------
-- Popup_At_Position --
-----------------------
procedure Popup_At_Position (Widget :
access GObject_Record'Class)
is
Spin :
constant Gtk_Spin_Button := Gtk_Spin_Button (Widget);
Menu : Gtk_Menu;
Menu_Item : Gtk_Menu_Item;
Val :
aliased Gint := Get_Value_As_Int (Spin);
begin
Gtk_New (Menu);
Gtk_New (Menu_Item, "this");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "menu");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "should be positioned");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "
at " & Val'Img & "," & Val'Img);
Append (Menu, Menu_Item);
Show_All (Menu);
My_Popup.Popup
(Menu => Menu,
Func => Position_At_Data'Access,
Data => Val'Access);
end Popup_At_Position;
-----------
-- Popup --
-----------
procedure Popup (Widget :
access Gtk_Button_Record'Class)
is
pragma Unreferenced (Widget);
Menu : Gtk_Menu;
Menu_Item : Gtk_Menu_Item;
begin
Gtk_New (Menu);
Gtk_New (Menu_Item, "this");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "menu");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "should be positioned");
Append (Menu, Menu_Item);
Gtk_New (Menu_Item, "
in the top-left corner");
Append (Menu, Menu_Item);
Show_All (Menu);
Popup
(Menu,
Parent_Menu_Shell =>
null,
Parent_Menu_Item =>
null,
Func => Position_At_0'Access,
Button => 1,
Activate_Time => 0);
end Popup;
----------
-- Help --
----------
function Help
return String
is
begin
return
"There are several widgets involved
in displaying menus. The"
& " @bGtk_Menu_Bar@B widget
is a horizontal menu bar, which normally"
& " appears
at the top
of an application. The @bGtk_Menu@B widget
is"
& " the actual menu that pops up. Both @bGtk_Menu_Bar@B
and"
& " @bGtk_Menu@B are subclasses
of @bGtk_Menu_Shell@B; a"
& " @bGtk_Menu_Shell@B contains menu items (@bGtk_Menu_Item@B)."
& " Each menu item contains text
and/
or images
and can be selected"
& " by the user."
& ASCII.LF
& "This demo shows how to create a @bGtk_Menu_Bar@B,
with multiple"
& " @bGtk_Menu@Bs. Each
of this submenu
is actually a @btearoff@B menu"
& ", which means by that clicking on the dashed line, you can simply"
& " glue the submenu to another place on your desktop,
and keep it"
& " around. To hide it, simply click on the dashed line again."
& ASCII.LF
& "There are several kinds
of menu item, including plain"
& " @bGtk_Menu_Item@B, @bGtk_Check_Menu_Item@B which can be"
& " checked/unchecked, @bGtk_Radio_Menu_Item@B which
is a check menu"
& " item that's
in a mutually exclusive group,"
& " @bGtk_Separator_Menu_Item@B which
is a separator bar,"
& " @bGtk_Tearoff_Menu_Item@B which allows a @bGtk_Menu@B to be torn"
& " off,
and @bGtk_Image_Menu_Item@B which can place a @bGtk_Image@B"
& "
or other widget next to the menu text. A @bGtk_Menu_Item can have"
& " a submenu, which
is simply a @bGtk_Menu@B to pop up
when the menu"
& " item
is selected. Typically,
all menu items
in a menu bar have"
& " submenus."
& ASCII.LF
& "The @bGtk_Option_Menu@B widget
is a button that pops up a"
& " @bGtk_Menu@B
when clicked. It's used inside dialogs
and such."
& " This
is different from the @bGtk_Combo_Box@B that you can see"
& "
in the @bEntry@B demo, since a @bGtk_Option_Menu@B does
not have"
& " any editable
entry associated
with it.";
end Help;
-----------------
-- Create_Menu --
-----------------
function Create_Menu
(Depth : Integer; Tearoff : Boolean)
return Gtk_Menu
is
Menu : Gtk_Menu;
Group : Widget_SList.GSlist;
Menu_Item : Gtk_Radio_Menu_Item;
begin
Gtk_New (Menu);
if Tearoff
then
declare
Tear_Menu : Gtk_Tearoff_Menu_Item;
begin
Gtk_New (Tear_Menu);
Append (Menu, Tear_Menu);
Show (Tear_Menu);
end;
end if;
for J
in 0 .. 5
loop
Gtk_New (Menu_Item, Group, "Item" & Integer'Image (Depth)
& " -" & Integer'Image (J + 1));
Group := Gtk.Radio_Menu_Item.Get_Group (Menu_Item);
Append (Menu, Menu_Item);
Show (Menu_Item);
if J = 3
then
Set_Sensitive (Menu_Item, False);
end if;
if Depth > 1
then
Set_Submenu (Menu_Item, Create_Menu (Depth - 1, Tearoff));
end if;
end loop;
return Menu;
end Create_Menu;
---------
-- Run --
---------
procedure Run (Frame :
access Gtk.Frame.Gtk_Frame_Record'Class)
is
Box1 : Gtk_Box;
Box2 : Gtk_Box;
Menu_Bar : Gtk_Menu_Bar;
Menu : Gtk_Menu;
Menu_Item : Gtk_Menu_Item;
Option_Menu : Gtk_Option_Menu;
Button : Gtk_Button;
Spin : Gtk_Spin_Button;
begin
Set_Label (Frame, "Menus");
Gtk_New_Vbox (Box1, False, 0);
Add (Frame, Box1);
Gtk_New (Menu_Bar);
Pack_Start (Box1, Menu_Bar, False, False, 0);
Menu := Create_Menu (2, True);
Gtk_New (Menu_Item, "test" & ASCII.LF & "line2");
Set_Submenu (Menu_Item, Menu);
Append (Menu_Bar, Menu_Item);
Gtk_New (Menu_Item, "foo");
Set_Submenu (Menu_Item, Create_Menu (3, True));
Append (Menu_Bar, Menu_Item);
Gtk_New (Menu_Item, "bar");
Set_Submenu (Menu_Item, Create_Menu (4, True));
Set_Right_Justified (Menu_Item, True);
Append (Menu_Bar, Menu_Item);
Gtk_New_Vbox (Box2, False, 10);
Set_Border_Width (Box2, 10);
Pack_Start (Box1, Box2, False, False, 0);
Gtk_New (Option_Menu);
Set_Menu (Option_Menu, Create_Menu (1, False));
Set_History (Option_Menu, 3);
Pack_Start (Box2, Option_Menu, False, False, 0);
Gtk_New (Button, "Popup
at 0,0 coordinates");
Pack_Start (Box1, Button, False, False, 3);
Button_Cb.Connect
(Button, "clicked",
Button_Cb.To_Marshaller (Popup'Access));
Gtk_New_Hbox (Box2, False, 10);
Pack_Start (Box1, Box2, False, False, 0);
Gtk_New (Spin, 0.0, 800.0, 100.0);
Set_Value (Spin, 200.0);
Pack_Start (Box2, Spin, False, False, 3);
Gtk_New (Button, "Popup
at given coordinates");
Pack_Start (Box2, Button, False, False, 3);
Object_Callback.Object_Connect
(Button, "clicked",
Popup_At_Position'Access,
Spin);
Show_All (Frame);
end Run;
end Create_Menu;
Note that there is a second version of this function (with added user data in the package User_Menu_Popup below