[gtkada] More flexible Gtkada.Dialog
Duncan Sands
sands at topo.math.u-psud.fr
Mon Feb 19 10:00:12 CET 2001
Dear All, thanks a lot for GtkAda, it works very well.
However, I found Gtkada.Dialog a bit too rigid, so I
rewrote it to make it more flexible (and just as easy
to use). See below for the code. Here's an example
of usage:
with GtkAda.Dialogs2; use GtkAda.Dialogs2;
...
Button : Natural;
begin
Button := Message_Dialog (
Msg => "Bug detected!",
Dialog_Type => Error,
Buttons => (+"Ok", +"Details"),
Extra_Button => 2,
Extra_Msg => "Segmentation fault"
);
...
The difference is that you can choose the titles of the
buttons. In particular, the "Help" button doesn't need to
be called "Help", in this snippet it is called "Details".
Putting Extra_Button => 2 tells the dialog that the second
button "Details" is the one that will pop up a new window.
The dialog returns the index of the button pressed (1,
meaning "Ok", is the only possibility here), or 0 if the
dialog was deleted. Note that it might be worth making
the dialog even more flexible (for example, choosing the
type of the extra window) if that can be done without
making it harder to use.
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 2000 --
-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet --
-- --
-- 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. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
-- <description>
--
-- This package provides a ready to use high level dialog capability.
--
-- </description>
with Gtk.Enums; use Gtk.Enums;
with Gtkada.Intl; use Gtkada.Intl;
package Gtkada.Dialogs2 is
pragma Elaborate_Body;
Max_Label_Length : constant := 20;
subtype Label_String is String (1 .. Max_Label_Length);
function "+" (S : String) return Label_String;
type Message_Dialog_Type is
(Warning,
-- Message box with a yellow exclamation point.
Error,
-- Message box with a red stop sign.
Information,
-- Message box with a blue "i".
Confirmation,
-- Message box with a blue question mark.
Custom
-- Message box with no pixmap. The caption of the box should be set by
-- the user.
);
-- Define the values describing the type of message box.
-- Used by the Message_Dialog function.
type Label_Array is array (Positive range <>) of Label_String;
function Message_Dialog
(Msg : String;
Dialog_Type : Message_Dialog_Type := Information;
Buttons : Label_Array := (1 => +(-("Ok")));
Default_Button : Natural := 1;
Title : String := "";
Extra_Button : Natural := 0;
Extra_Msg : String := "";
Justification : Gtk_Justification := Justify_Center)
return Natural;
-- Display a message dialog box centered on the mouse.
-- This will create a dialog box containing the specified message.
-- Dialog_Type indicates the purpose of the dialog.
-- If Title is null, a default title will be chosen depending on the value
-- of Dialog_Type.
-- Buttons indicates the labels of the buttons appearing in the dialog.
-- If Extra_Button is the index of a button in the Buttons array, then
-- the message Extra_Msg is displayed in a separate dialog box when that
-- button is pressed while the dialog is displayed. The dialog displayed
-- will only have an OK button and has the button's text for title.
--
-- This function will return only after the user pressed one of the buttons
-- or deleted the dialog, by running an additional level of main loop.
-- The value returned is the index in the Button array of the button
-- pressed, or zero if the dialog was deleted.
end Gtkada.Dialogs2;
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 2000 --
-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet --
-- --
-- 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. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Glib; use Glib;
with Gdk.Pixmap; use Gdk.Pixmap;
with Gdk.Color; use Gdk.Color;
with Gtk.Main; use Gtk.Main;
with Gtk.Box; use Gtk.Box;
with Gtk.Button; use Gtk.Button;
with Gtk.Dialog; use Gtk.Dialog;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Label; use Gtk.Label;
with Gtk.Pixmap; use Gtk.Pixmap;
with Gtk.Widget; use Gtk.Widget;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Gtkada.Handlers; use Gtkada.Handlers;
with Gtkada.Pixmaps; use Gtkada.Pixmaps;
with Gtkada.Intl; use Gtkada.Intl;
package body Gtkada.Dialogs2 is
type Button_Array is array (Positive range <>) of Gtk_Button;
type Buttons_Pointer is access Button_Array;
procedure Free is new Ada.Unchecked_Deallocation (Button_Array,
Buttons_Pointer);
type Gtkada_Dialog_Record is new Gtk_Dialog_Record with record
Buttons : Buttons_Pointer;
Extra_Button : Natural;
Extra_Msg : String_Ptr;
Value : Natural := 0;
end record;
type Gtkada_Dialog is access all Gtkada_Dialog_Record'Class;
function Delete_Cb (Win : access Gtk_Widget_Record'Class) return Boolean;
procedure Clicked_Cb (Button : access Gtk_Widget_Record'Class);
-------
-- + --
-------
function "+" (S : String) return Label_String is
Result : Label_String := (others => ' ');
begin
Result (1 .. S'Length) := S;
return Result;
end "+";
--------------------
-- Destroy_Dialog --
--------------------
function Delete_Cb (Win : access Gtk_Widget_Record'Class) return Boolean is
begin
Main_Quit;
return True;
end Delete_Cb;
----------------
-- Clicked_Cb --
----------------
procedure Clicked_Cb (Button : access Gtk_Widget_Record'Class) is
Dialog : Gtkada_Dialog := Gtkada_Dialog (Get_Toplevel (Button));
Label : aliased Gtk_Label_Record;
Result : Natural;
begin
for J in Dialog.Buttons'Range loop
if Gtk_Button (Button) = Dialog.Buttons (J) then
Dialog.Value := J;
exit;
end if;
end loop;
if Dialog.Value = 0 then
raise Program_Error;
end if;
if Dialog.Value = Dialog.Extra_Button then
Gtk.Set_Object
(Label'Unchecked_Access,
Gtk.Get_Object (Get_Child (Gtk_Button (Button))));
Result := Message_Dialog
(Dialog.Extra_Msg.all, Title => Get (Label'Unchecked_Access));
Dialog.Value := 0;
else
Main_Quit;
end if;
end Clicked_Cb;
--------------------
-- Message_Dialog --
--------------------
function Message_Dialog
(Msg : String;
Dialog_Type : Message_Dialog_Type := Information;
Buttons : Label_Array := (1 => +(-("Ok")));
Default_Button : Natural := 1;
Title : String := "";
Extra_Button : Natural := 0;
Extra_Msg : String := "";
Justification : Gtk_Justification := Justify_Center)
return Natural
is
Dialog : Gtkada_Dialog;
Label : Gtk_Label;
Button : Gtk_Button;
Box : Gtk_Box;
Pix : Gtk_Pixmap;
Pixmap : Gdk_Pixmap;
Mask : Gdk_Pixmap;
Value : Natural;
use Gdk;
begin
Dialog := new Gtkada_Dialog_Record;
Initialize (Dialog);
-- Realize it so that we force the creation of its Gdk_Window.
-- This is needed below to create a pixmap.
Realize (Dialog);
Dialog.Buttons := new Button_Array (Buttons'Range);
Dialog.Extra_Button := Extra_Button;
Dialog.Extra_Msg := new String' (Extra_Msg);
Set_Modal (Dialog);
Set_Position (Dialog, Win_Pos_Mouse);
Return_Callback.Connect
(Dialog, "delete_event",
Return_Callback.To_Marshaller (Delete_Cb'Access));
case Dialog_Type is
when Warning =>
Create_From_Xpm_D
(Pixmap, Get_Window (Dialog), Mask,
Null_Color, Warning_Xpm);
Set_Title (Dialog, -"Warning");
when Error =>
Create_From_Xpm_D
(Pixmap, Get_Window (Dialog), Mask,
Null_Color, Error_Xpm);
Set_Title (Dialog, -"Error");
when Information =>
Create_From_Xpm_D
(Pixmap, Get_Window (Dialog), Mask,
Null_Color, Information_Xpm);
Set_Title (Dialog, -"Information");
when Confirmation =>
Create_From_Xpm_D
(Pixmap, Get_Window (Dialog), Mask,
Null_Color, Confirmation_Xpm);
Set_Title (Dialog, -"Confirmation");
when Custom =>
null;
end case;
if Title /= "" then
Set_Title (Dialog, Title);
end if;
Gtk_New_Hbox (Box);
Pack_Start (Get_Vbox (Dialog), Box, Padding => 10);
if Pixmap /= null then
Gtk_New (Pix, Pixmap, Mask);
Pack_Start (Box, Pix, Padding => 10);
end if;
Gtk_New (Label, Msg);
Set_Justify (Label, Justification);
Pack_Start (Box, Label, Padding => 10);
for J in Buttons'Range loop
Gtk_New (Button, Trim (Buttons (J), Right));
Set_USize (Button, 80, -1);
Pack_Start
(Get_Action_Area (Dialog), Button,
False, False, 14);
Set_Flags (Button, Can_Default);
Widget_Callback.Connect
(Button, "clicked",
Widget_Callback.To_Marshaller (Clicked_Cb'Access));
if Default_Button = J then
Grab_Default (Button);
end if;
Dialog.Buttons (J) := Button;
end loop;
Show_All (Dialog);
Main;
Value := Dialog.Value;
Free (Dialog.Extra_Msg);
Free (Dialog.Buttons);
Destroy (Dialog);
return Value;
end Message_Dialog;
end Gtkada.Dialogs2;
More information about the gtkada
mailing list