Simplified widget callbacks

4 files changed, 22 insertions, 20 deletions

diff --git a/fltk-widgets-menus.adb b/fltk-widgets-menus.adb
index 7669820..0f50fc8 100644
--- a/fltk-widgets-menus.adb
+++ b/fltk-widgets-menus.adb
@@ -98,16 +98,13 @@ package body FLTK.Widgets.Menus is
     pragma Convention (C, Item_Hook);
 
     procedure Item_Hook
-           (M, U : in System.Address) is
-
+           (M, U : in System.Address)
+    is
         Ada_Widget : access Widget'Class :=
             Widget_Convert.To_Pointer (fl_widget_get_user_data (M));
-
-        Action : access Widget_Callback'Class :=
-            Callback_Convert.To_Pointer (U);
-
+        Action : Widget_Callback := Callback_Convert.To_Pointer (U);
     begin
-        Action.Call (Ada_Widget.all);
+        Action.all (Ada_Widget.all);
     end Item_Hook;
 
 
@@ -116,7 +113,7 @@ package body FLTK.Widgets.Menus is
     procedure Add
            (This     : in out Menu;
             Text     : in     String;
-            Action   : access Widget_Callback'Class := null;
+            Action   : in     Widget_Callback := null;
             Shortcut : in     Shortcut_Key := No_Key;
             Flags    : in     Menu_Flag := Flag_Normal)
     is
diff --git a/fltk-widgets-menus.ads b/fltk-widgets-menus.ads
index acb59bd..27b9d4a 100644
--- a/fltk-widgets-menus.ads
+++ b/fltk-widgets-menus.ads
@@ -57,7 +57,7 @@ package FLTK.Widgets.Menus is
     procedure Add
            (This     : in out Menu;
             Text     : in     String;
-            Action   : access Widget_Callback'Class := null;
+            Action   : in     Widget_Callback := null;
             Shortcut : in     Shortcut_Key := No_Key;
             Flags    : in     Menu_Flag := Flag_Normal);
 
diff --git a/fltk-widgets.adb b/fltk-widgets.adb
index 256b8e6..9ec2350 100644
--- a/fltk-widgets.adb
+++ b/fltk-widgets.adb
@@ -242,7 +242,7 @@ package body FLTK.Widgets is
         Ada_Widget : access Widget'Class :=
             Widget_Convert.To_Pointer (U);
     begin
-        Ada_Widget.Callback.Call (Ada_Widget.all);
+        Ada_Widget.Callback.all (Ada_Widget.all);
     end Callback_Hook;
 
 
@@ -250,10 +250,12 @@ package body FLTK.Widgets is
 
     procedure Set_Callback
            (This : in out Widget;
-            Func : not null access Widget_Callback'Class) is
+            Func : in     Widget_Callback) is
     begin
-        This.Callback := Func;
-        fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address);
+        if Func /= null then
+            This.Callback := Func;
+            fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address);
+        end if;
     end Set_Callback;
 
 
diff --git a/fltk-widgets.ads b/fltk-widgets.ads
index 7af5e2b..d1c4b89 100644
--- a/fltk-widgets.ads
+++ b/fltk-widgets.ads
@@ -5,6 +5,7 @@ with FLTK.Images;
 limited with FLTK.Widgets.Groups;
 private with System;
 private with System.Address_To_Access_Conversions;
+private with Ada.Unchecked_Conversion;
 
 
 package FLTK.Widgets is
@@ -13,10 +14,8 @@ package FLTK.Widgets is
     type Widget is abstract new Wrapper with private;
 
 
-    type Widget_Callback is interface;
-    procedure Call
-           (This : in     Widget_Callback;
-            Item : in out Widget'Class) is abstract;
+    type Widget_Callback is access procedure
+           (Item : in out Widget'Class);
 
 
     type Font_Size is new Natural;
@@ -87,7 +86,7 @@ package FLTK.Widgets is
 
     procedure Set_Callback
            (This : in out Widget;
-            Func : not null access Widget_Callback'Class);
+            Func : in     Widget_Callback);
 
 
     function Get_X
@@ -135,13 +134,17 @@ private
 
     type Widget is abstract new Wrapper with
         record
-            Callback      : access Widget_Callback'Class;
+            Callback      : Widget_Callback;
             Current_Image : access FLTK.Images.Image'Class;
         end record;
 
 
     package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class);
-    package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback'Class);
+    --  package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback);
+    package Callback_Convert is
+        function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback);
+        function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address);
+    end Callback_Convert;
 
 
     function fl_widget_get_user_data