1------------------------------------------------------------------------------
2--               GtkAda - Ada95 binding for the Gimp Toolkit                --
3--                                                                          --
4--                     Copyright (C) 1998-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
24with Gdk.RGBA;          use Gdk.RGBA;
25with Glib;              use Glib;
26with Glib.Object;       use Glib.Object;
27with Gtk.Box;           use Gtk.Box;
28with Gtk.Check_Button;  use Gtk.Check_Button;
29with Gtk.Enums;         use Gtk.Enums;
30with Gtk.Label;         use Gtk.Label;
31with Gtk.Stock;         use Gtk.Stock;
32with Gtk.Tooltip;       use Gtk.Tooltip;
33with Gtk.Widget;        use Gtk.Widget;
34with Gtk.Window;        use Gtk.Window;
35with Gtk;               use Gtk;
36
37package body Create_Tooltips is
38
39   ----------
40   -- Help --
41   ----------
42
43   function Help return String is
44   begin
45      return "@bGtk_Tooltips@B allow you to provide short help texts to the"
46        & " user. " & ASCII.LF
47        & " Through the @bwidget_entered@B and @bwidget_selected@B signals,"
48        & " you can decide to display some extensive help.";
49   end Help;
50
51   ----------------------
52   -- Query_Tooltip_Cb --
53   ----------------------
54
55   function Query_Tooltip_Cb
56      (Check        : access Gtk_Widget_Record'Class;
57       X, Y         : Gint;
58       Keyboard_Tip : Boolean;
59       Tooltip      : not null access GObject_Record'Class)
60      return Boolean
61   is
62      pragma Unreferenced (X, Y, Keyboard_Tip);
63   begin
64      Gtk_Tooltip (Tooltip).Set_Markup
65         ("The text of the widget is <b>"""
66          & Gtk_Check_Button (Check).Get_Label & """</b>");
67      Gtk_Tooltip (Tooltip).Set_Icon_From_Stock (Stock_Delete, Icon_Size_Menu);
68      return True;
69   end Query_Tooltip_Cb;
70
71   -----------------------------
72   -- Query_Tooltip_Custom_Cb --
73   -----------------------------
74
75   function Query_Tooltip_Custom_Cb
76      (Check        : access Gtk_Widget_Record'Class;
77       X, Y         : Gint;
78       Keyboard_Tip : Boolean;
79       Tooltip      : not null access GObject_Record'Class)
80      return Boolean
81   is
82      pragma Unreferenced (X, Y, Keyboard_Tip, Tooltip);
83      Window : constant Gtk_Window := Gtk_Window (Check.Get_Tooltip_Window);
84      Color  : constant Gdk_RGBA := (0.0, 0.0, 1.0, 0.5);
85   begin
86      Window.Override_Background_Color (Gtk_State_Flag_Normal, Color);
87      return True;
88   end Query_Tooltip_Custom_Cb;
89
90   ---------
91   -- Run --
92   ---------
93
94   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
95      Box1       : Gtk_Box;
96      Check      : Gtk_Check_Button;
97      Vbox       : Gtk_Box;
98      Label      : Gtk_Label;
99      Tooltip_Window : Gtk_Window;
100
101   begin
102      Set_Label (Frame, "Tooltips");
103      Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 0);
104      Add (Frame, Vbox);
105
106      Gtk_New_Vbox (Box1, False, 0);
107      Pack_Start (Vbox, Box1, Expand => False, Fill => False);
108
109      --  A check button using the tooltip-markup property
110
111      Gtk_New (Check, "Using the tooltip-markup property");
112      Box1.Pack_Start (Check, False, False, 0);
113      Check.Set_Tooltip_Text ("Hello, I am a static tooltip.");
114
115      --  A check button using the query-tooltip signal
116
117      Gtk_New (Check, "Using the query-tooltip signal");
118      Box1.Pack_Start (Check, False, False, 0);
119      Check.Set_Has_Tooltip (True);
120      Check.On_Query_Tooltip (Query_Tooltip_Cb'Access);
121
122      --  A label
123
124      Gtk_New (Label, "A simple label");
125      Box1.Pack_Start (Label, False, False, 0);
126      Label.Set_Selectable (False);
127      Label.Set_Tooltip_Text ("Label and tooltip");
128
129      --  A selectable label
130
131      Gtk_New (Label, "A selectable label");
132      Box1.Pack_Start (Label, False, False, 0);
133      Label.Set_Selectable (True);
134      Label.Set_Tooltip_Text ("<b>Another</b> Label tooltip");
135
136      --  Another one, with a custom tooltip window
137
138      Gtk_New (Tooltip_Window, Window_Popup);
139      Gtk_New (Label, "in custom tooltip window");
140      Tooltip_Window.Add (Label);
141      Label.Show;
142
143      Gtk_New (Check, "Using a custom tooltip window");
144      Box1.Pack_Start (Check, False, False, 0);
145      Check.Set_Tooltip_Window (Tooltip_Window);
146      Check.Set_Has_Tooltip (True);
147      Check.On_Query_Tooltip (Query_Tooltip_Custom_Cb'Access);
148
149      --  An insensitive button
150
151      Gtk_New (Check, "Insensitive button");
152      Box1.Pack_Start (Check, False, False, 0);
153      Check.Set_Sensitive (False);
154      Check.Set_Tooltip_Text ("Insensitive!");
155
156      Show_All (Frame);
157   end Run;
158
159end Create_Tooltips;
160