-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
-- Copyright (C) 2000-2009, 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. --
-- --
-- --
-- --
-- --
-- --
-- --
-- --
-----------------------------------------------------------------------
--
-- This package provides a set of generic packages to easily create
-- some Marshallers. Although this package has been designed to be
-- easily reusable, its primary aim is to simplify the use of callbacks.
--
-- Note that most users don't need to understand or even look at this
-- package, since the main functions are also renamed in the Gtk.Handlers
-- package (They are called To_Marshaller). This package is rather
-- complex (generic packages inside generic packages), and thus you should
-- understand correctly how Gtk.Handlers work before looking at this one.
--
-- To understand the paradigm used in this package, some definitions
-- are necessary:
--
-- A Handler, or Callback, is a subprogram provided by the user.
-- This handler, when attached to a particular object, will be
-- called when certain events happen during the life of this
-- object. All handlers take as a first argument an access to
-- the object they were attached to. Depending on the signal, this
-- handler can also have some extra parameters; most of the time,
-- only one extra parameter will be used. For more information about
-- Handlers, refer to the package Gtk.Handlers, where this notion is
-- explained in more details.
--
-- A General_Handler is an access to any Handler. Note that this is
-- a type used internally, most users should *not* be using it. It is
-- publicly declared so that users can create new marshallers that
-- would not be already provided here.
--
-- A Handler_Proxy is a subprogram that calls its associated
-- handler with the appropriate arguments (from an array of arguments
-- stored in Glib.Values.GValues)
--
-- A Marshaller is the association of a General_Handler and a
-- Handler_Proxy.
--
-- This package is divided in four generic packages. Each package has
-- been designed to cover a certain kind of callback by providing the
-- associated marshallers. There are two primary factors that describe
-- a callback, and that decide which marshaller to use: Does the
-- callback have access to some user data? Does the callback return
-- some value?
--
-- Depending on that, the appropriate generic package should be chosen.
-- For example, if the callback returns a value, but does not expect
-- user data, then the "Return_Marshallers" package should be used.
-- More details about the usage of each package is provided individually
-- below.
--
-- Each of these packages is in turn divided into three generic
-- sub-packages. The organization of these subpackages is always the
-- same :
-- o The type "Handler" is defined. It describes the profile of the
-- Handler covered in this generic package.
-- o a "To_Marshaller" function is provided to build a Marshaller
-- from any Handler.
-- o A "Emit_By_Name" procedure is also provided to allow the user
-- to "emit" a signal. This service is explained in more details in
-- Gtk.Handlers.
-- o A private function "Call" is also defined. This is the actual
-- Handler_Proxy that will be used when creating Marshallers with
-- the "To_Marshaller" service.
--
-- Once again, selecting the right generic sub-package depends on the
-- callback. For instance, the first sub-package, always called
-- "Generic_Marshaller", is to be used when the handler has one extra
-- argument which is a simple non-tagged type. More details about the
-- usage of each sub-package is also provided individually.
--
-- Although most of the cases are covered by the packages below, some
-- unusual cases may appear. This is the case for example when the
-- callback accepts several extra parameters. In such cases, two options
-- are available: The first option is to use the "standard" callback
-- mechanism with one parameter, this parameter being an array of
-- arguments that you will parse yourself. The second option is to
-- create a new Marshaller package. This is more interesting if more
-- than one callback will follow the same pattern. The body of this
-- package can be used as a good model to build such new marshallers.
-- See also the example in the GtkAda distribution for how to create your
-- own marshallers.
--
--
-- Signal handling
-- 2.8.17
with Glib.Object;
with Gtk.Widget;
with Glib.Values;
package Gtk.Marshallers is
-- Do not create automatic documentation for this package
type General_Handler is access procedure;
--------------------------------------------------------------
-- Return Marshallers: Return a value, don't have user data
--------------------------------------------------------------
generic
type Widget_Type is new Glib.Object.GObject_Record with private;
type Return_Type is (<>);
package Return_Marshallers is
type Handler_Proxy is access function
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler) return Return_Type;
type Marshaller is record
Func : General_Handler; -- User callback
Proxy : Handler_Proxy; -- Handler_Proxy for this callback
end record;
-- Basic Marshaller
generic
type Base_Type is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type;
package Generic_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class;
Param : Base_Type) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type) return Return_Type;
-- The function above should be used when Base_Type can be passed
-- as is to C.
generic
with function Conversion (Param : Base_Type) return System.Address;
function Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type) return Return_Type;
-- Provide an explicit conversion function for PARAM.
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
type Access_Type is access all Base_Type'Class;
package Generic_Widget_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class;
Param : access Base_Type'Class) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : access Base_Type'Class) return Return_Type;
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Widget_Marshaller;
-- Void Marshaller
package Void_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name) return Return_Type;
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Void_Marshaller;
end Return_Marshallers;
--------------------------------------------------------------
-- User_Return_Marshallers: Return a value, have a user data
--------------------------------------------------------------
generic
type Widget_Type is new Glib.Object.GObject_Record with private;
type Return_Type is (<>);
type User_Type (<>) is private;
package User_Return_Marshallers is
type Handler_Proxy is access function
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type) return Return_Type;
type Marshaller is record
Func : General_Handler;
Proxy : Handler_Proxy;
end record;
-- Basic Marshaller
generic
type Base_Type is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type;
package Generic_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class;
Param : Base_Type;
User_Data : User_Type) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type) return Return_Type;
-- The function above should be used when BASE_TYPE can be passed
-- as is to C.
generic
with function Conversion (Param : Base_Type) return System.Address;
function Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type) return Return_Type;
-- Provide an explicit conversion function for PARAM.
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
type Access_Type is access all Base_Type'Class;
package Generic_Widget_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class;
Param : access Base_Type'Class;
User_Data : User_Type) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : access Base_Type'Class) return Return_Type;
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Widget_Marshaller;
-- Void Marshaller
package Void_Marshaller is
type Handler is access function
(Widget : access Widget_Type'Class;
User_Data : User_Type) return Return_Type;
function To_Marshaller (Cb : Handler) return Marshaller;
function Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name) return Return_Type;
private
function Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type) return Return_Type;
Call_Access : constant Handler_Proxy := Call'Access;
end Void_Marshaller;
end User_Return_Marshallers;
-----------------
-- Callback_Marshallers: Do not return a value, no user data
-----------------
generic
type Widget_Type is new Glib.Object.GObject_Record with private;
package Void_Marshallers is
type Handler_Proxy is access procedure
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler);
type Marshaller is record
Func : General_Handler;
Proxy : Handler_Proxy;
end record;
-- Basic Marshaller
generic
type Base_Type is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type;
package Generic_Marshaller is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param : Base_Type);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type);
-- The function above should be used when BASE_TYPE can be passed
-- as is to C.
generic
with function Conversion (Param : Base_Type) return System.Address;
procedure Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type);
-- Provide an explicit conversion function for PARAM.
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
generic
type Base_Type_1 is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type_1;
type Base_Type_2 is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type_2;
package Generic_Marshaller_2 is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2);
-- The function above should be used when BASE_TYPE can be passed
-- as is to C.
generic
with function Conversion
(Param : Base_Type_1) return System.Address;
with function Conversion
(Param : Base_Type_2) return System.Address;
procedure Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2);
-- Provide an explicit conversion function for PARAM.
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller_2;
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
type Access_Type is access all Base_Type'Class;
package Generic_Widget_Marshaller is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param : access Base_Type'Class);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : access Base_Type'Class);
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Widget_Marshaller;
-- Void Marshaller
package Void_Marshaller is
type Handler is access procedure (Widget : access Widget_Type'Class);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name);
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler);
Call_Access : constant Handler_Proxy := Call'Access;
end Void_Marshaller;
end Void_Marshallers;
----------------------------------------------------------------------
-- User_Callback_Marshallers: Do not return a value, have user data
----------------------------------------------------------------------
generic
type Widget_Type is new Glib.Object.GObject_Record with private;
type User_Type (<>) is private;
package User_Void_Marshallers is
type Handler_Proxy is access procedure
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type);
type Marshaller is record
Func : General_Handler;
Proxy : Handler_Proxy;
end record;
-- Basic Marshaller
generic
type Base_Type is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type;
package Generic_Marshaller is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param : Base_Type;
User_Data : User_Type);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type);
-- The function above should be used when BASE_TYPE can be passed
-- as is to C.
generic
with function Conversion (Param : Base_Type) return System.Address;
procedure Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : Base_Type);
-- Provide an explicit conversion function for PARAM.
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller;
generic
type Base_Type_1 is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type_1;
type Base_Type_2 is private;
with function Conversion
(Value : Glib.Values.GValue) return Base_Type_2;
package Generic_Marshaller_2 is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2;
User_Data : User_Type);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2);
-- The function above should be used when BASE_TYPE can be passed
-- as is to C.
generic
with function Conversion
(Param : Base_Type_1) return System.Address;
with function Conversion
(Param : Base_Type_2) return System.Address;
procedure Emit_By_Name_Generic
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param_1 : Base_Type_1;
Param_2 : Base_Type_2);
-- Provide an explicit conversion function for PARAM.
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Marshaller_2;
-- Widget Marshaller
generic
type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
type Access_Type is access all Base_Type'Class;
package Generic_Widget_Marshaller is
type Handler is access procedure
(Widget : access Widget_Type'Class;
Param : access Base_Type'Class;
User_Data : User_Type);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name;
Param : access Base_Type'Class);
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type);
Call_Access : constant Handler_Proxy := Call'Access;
end Generic_Widget_Marshaller;
-- Void Marshaller
package Void_Marshaller is
type Handler is access procedure
(Widget : access Widget_Type'Class;
User_Data : User_Type);
function To_Marshaller (Cb : Handler) return Marshaller;
procedure Emit_By_Name
(Object : access Widget_Type'Class;
Name : Glib.Signal_Name);
private
procedure Call
(Widget : access Widget_Type'Class;
Params : Glib.Values.GValues;
Cb : General_Handler;
User_Data : User_Type);
Call_Access : constant Handler_Proxy := Call'Access;
end Void_Marshaller;
end User_Void_Marshallers;
--
end Gtk.Marshallers;