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-2002 ACT-Europe --
-- --
-- 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.Arguments;
use Gtk.Arguments;
with Gtk.Box;
use Gtk.Box;
with Gtk.Button;
use Gtk.Button;
with Gtk.Handlers;
use Gtk.Handlers;
pragma Warnings (Off); -- Gtk.Tips_Query
is obsolescent
with Gtk.Tips_Query;
use Gtk.Tips_Query;
pragma Warnings (On);
with Gtk.Toggle_Button;
use Gtk.Toggle_Button;
with Gtk.Tooltips;
use Gtk.Tooltips;
with Gtk.Widget;
use Gtk.Widget;
with Gtk;
use Gtk;
with Ada.Text_IO;
package body Create_Tooltips
is
package Tooltips_Data
is new User_Data (Gtk_Tooltips);
-- This is required to set tooltips for a widget.
package Query_Cb
is new Handlers.Callback (Gtk_Tips_Query_Record);
package Entered_Cb
is new Handlers.User_Callback
(Gtk_Tips_Query_Record, Gtk_Toggle_Button);
package Selected_Cb
is new Handlers.Return_Callback
(Gtk_Tips_Query_Record, Gint);
package Button_Cb
is new Handlers.Callback (Gtk_Button_Record);
----------
-- Help --
----------
function Help
return String
is
begin
return "@bGtk_Tooltips@B allow you to provide short help texts to the"
& " user. This also requires a @bGtk_Tips_Query@B widget, that"
& " displays tooltips
and has a ""What's this"" functionnality."
& " Through the @bwidget_entered@B
and @bwidget_selected@B signals,"
& " you can decide to display some extensive help.";
end Help;
--------------------
-- Widget_Entered --
--------------------
procedure Widget_Entered (Tips_Query :
access Gtk_Tips_Query_Record'Class;
Params :
in Gtk.Arguments.Gtk_Args;
Toggle :
in Gtk_Toggle_Button)
is
-- Widget : Gtk_Widget := Gtk_Widget (To_Object (Params, 1));
Tip_Text :
constant String := To_String (Params, 2);
-- Tip_Private : String := To_String (Params, 3);
begin
if Get_Active (Toggle)
then
if Tip_Text'Length /= 0
then
Set_Text (Tips_Query, "There
is a Tip!");
else
Set_Text (Tips_Query, "There
is no Tip!");
end if;
-- Don't let GtkTipsQuery reset it's label
Emit_Stop_By_Name (Tips_Query, "widget_entered");
end if;
end Widget_Entered;
---------------------
-- Widget_Selected --
---------------------
function Widget_Selected (Tips_Query :
access Gtk_Tips_Query_Record'Class;
Params :
in Gtk.Arguments.Gtk_Args)
return Gint
is
Widget :
constant Gtk_Widget := Gtk_Widget (To_Object (Params, 1));
-- Tip_Text : String := To_String (Params, 2);
Tip_Private :
constant String := To_String (Params, 3);
pragma Warnings (Off, Tips_Query);
begin
if Is_Created (Widget.
all)
then
Ada.Text_IO.Put ("Help ");
if Tip_Private'Length = 0
then
Ada.Text_IO.Put ("None");
else
Ada.Text_IO.Put (Tip_Private);
end if;
Ada.Text_IO.Put_Line (" requested
for "
& Type_Name (Get_Type (Widget)));
end if;
return 0;
end Widget_Selected;
-----------------
-- Start_Query --
-----------------
procedure Start_Query (Tips_Query :
access Gtk_Tips_Query_Record'Class)
is
begin
Gtk.Tips_Query.Start_Query (Tips_Query);
end Start_Query;
-----------------
-- Get_Data_Cb --
-----------------
procedure Get_Data_Cb (Button :
access Gtk_Button_Record'Class)
is
Data :
constant Gtk.Tooltips.Tooltips_Data :=
Gtk.Tooltips.Get_Data (Button);
begin
Ada.Text_IO.Put_Line ("Result
of call to Gtk.Tooltips.Get_Data:");
Ada.Text_IO.Put_Line (" Text=" & Data.Text);
Ada.Text_IO.Put_Line (" Text_Private=" & Data.Text_Private);
end Get_Data_Cb;
---------
-- Run --
---------
procedure Run (Frame :
access Gtk.Frame.Gtk_Frame_Record'Class)
is
Box1,
Box2,
Box3 : Gtk_Box;
Button : Gtk_Button;
Tooltips : Gtk_Tooltips;
Toggle : Gtk_Toggle_Button;
Tips_Query : Gtk_Tips_Query;
Frame2 : Gtk_Frame;
Vbox : Gtk_Box;
begin
Set_Label (Frame, "Tooltips");
Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 0);
Add (Frame, Vbox);
Gtk_New (Tooltips);
Tooltips_Data.Set (Vbox, Tooltips, "tooltips");
Gtk_New_Vbox (Box1, False, 0);
Pack_Start (Vbox, Box1, Expand => False, Fill => False);
Gtk_New_Vbox (Box2, False, 10);
Set_Border_Width (Box2, 10);
Pack_Start (Box1, Box2, True, True, 0);
Gtk_New (Button, "Button1");
Show (Button);
Pack_Start (Box2, Button, False, False, 0);
Set_Tip (Tooltips, Button, "This
is button 1",
"ContextHelp/buttons/1");
Gtk_New (Button, "(Print result
of Get_Data)");
Pack_Start (Box2, Button, False, False, 0);
Set_Tip (Tooltips, Button,
"This
is button 2. This
is also a really long tool tip which"
&" probably won't fit on a single line
and will therefore "
& "need to be wrapped. Hopefully the wrapping will work "
& "correctly.", "ContextHelp/buttons/2");
Button_Cb.Connect (Button, "clicked",
Button_Cb.To_Marshaller (Get_Data_Cb'Access));
Gtk_New (Toggle, "Override TipsQuery Label");
Pack_Start (Box2, Toggle, False, False, 0);
Set_Tip (Tooltips, Toggle, "Toggle TipsQuery view.", "Hi!");
Gtk_New_Vbox (Box3, False, 5);
Set_Border_Width (Box3, 5);
Gtk_New (Tips_Query);
Gtk_New (Button, "[?]");
Pack_Start (Box3, Button, False, False, 0);
Query_Cb.Object_Connect
(Button, "clicked",
Query_Cb.To_Marshaller (Start_Query'Access),
Slot_Object => Tips_Query);
Set_Tip (Tooltips, Button, "Start the Tooltips Inspector",
"ContextHelp/buttons/?");
Pack_Start (Box3, Tips_Query, False, False, 0);
Set_Caller (Tips_Query, Button);
Entered_Cb.Connect (Tips_Query, "widget_entered",
Widget_Entered'Access, Toggle);
Selected_Cb.Connect (Tips_Query, "widget_selected",
Widget_Selected'Access);
Gtk_New (Frame2, "Tooltips Inspector");
Set_Border_Width (Frame2, 0);
Pack_Start (Box2, Frame2, True, True, 10);
Add (Frame2, Box3);
Show_All (Frame);
end Run;
end Create_Tooltips;