Fixed a number of issues with getting the Ada wrapper back given a C++ widget pointer

10 files changed, 217 insertions, 52 deletions

diff --git a/src/fltk-event.adb b/src/fltk-event.adb
index 6578830..c4933b4 100644
--- a/src/fltk-event.adb
+++ b/src/fltk-event.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C.Strings;
 
 use type
@@ -17,6 +18,15 @@ use type
 package body FLTK.Event is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
+    ------------------------
+    --  Functions From C  --
+    ------------------------
+
     procedure fl_event_add_handler
            (F : in Storage.Integer_Address);
     pragma Import (C, fl_event_add_handler, "fl_event_add_handler");
@@ -342,10 +352,19 @@ package body FLTK.Event is
 
 
     function Get_Grab
-        return access FLTK.Widgets.Groups.Windows.Window'Class is
+        return access FLTK.Widgets.Groups.Windows.Window'Class
+    is
+        Grab_Ptr : Storage.Integer_Address := fl_event_get_grab;
+        Actual_Grab : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        return Window_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_event_get_grab)));
+        if Grab_Ptr /= Null_Pointer then
+            Grab_Ptr := fl_widget_get_user_data (Grab_Ptr);
+            pragma Assert (Grab_Ptr /= Null_Pointer);
+            Actual_Grab := Window_Convert.To_Pointer (Storage.To_Address (Grab_Ptr));
+        end if;
+        return Actual_Grab;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Grab;
 
 
@@ -363,10 +382,19 @@ package body FLTK.Event is
 
 
     function Get_Pushed
-        return access FLTK.Widgets.Widget'Class is
+        return access FLTK.Widgets.Widget'Class
+    is
+        Pushed_Ptr : Storage.Integer_Address := fl_event_get_pushed;
+        Actual_Pushed : access FLTK.Widgets.Widget'Class;
     begin
-        return Widget_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_event_get_pushed)));
+        if Pushed_Ptr /= Null_Pointer then
+            Pushed_Ptr := fl_widget_get_user_data (Pushed_Ptr);
+            pragma Assert (Pushed_Ptr /= Null_Pointer);
+            Actual_Pushed := Widget_Convert.To_Pointer (Storage.To_Address (Pushed_Ptr));
+        end if;
+        return Actual_Pushed;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Pushed;
 
 
@@ -378,10 +406,19 @@ package body FLTK.Event is
 
 
     function Get_Below_Mouse
-        return access FLTK.Widgets.Widget'Class is
+        return access FLTK.Widgets.Widget'Class
+    is
+        Below_Ptr : Storage.Integer_Address := fl_event_get_belowmouse;
+        Actual_Below : access FLTK.Widgets.Widget'Class;
     begin
-        return Widget_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_event_get_belowmouse)));
+        if Below_Ptr /= Null_Pointer then
+            Below_Ptr := fl_widget_get_user_data (Below_Ptr);
+            pragma Assert (Below_Ptr /= Null_Pointer);
+            Actual_Below := Widget_Convert.To_Pointer (Storage.To_Address (Below_Ptr));
+        end if;
+        return Actual_Below;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Below_Mouse;
 
 
@@ -393,10 +430,19 @@ package body FLTK.Event is
 
 
     function Get_Focus
-        return access FLTK.Widgets.Widget'Class is
+        return access FLTK.Widgets.Widget'Class
+    is
+        Focus_Ptr : Storage.Integer_Address := fl_event_get_focus;
+        Actual_Focus : access FLTK.Widgets.Widget'Class;
     begin
-        return Widget_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_event_get_focus)));
+        if Focus_Ptr /= Null_Pointer then
+            Focus_Ptr := fl_widget_get_user_data (Focus_Ptr);
+            pragma Assert (Focus_Ptr /= Null_Pointer);
+            Actual_Focus := Widget_Convert.To_Pointer (Storage.To_Address (Focus_Ptr));
+        end if;
+        return Actual_Focus;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Focus;
 
 
diff --git a/src/fltk-file_choosers.adb b/src/fltk-file_choosers.adb
index d413f15..3eee496 100644
--- a/src/fltk-file_choosers.adb
+++ b/src/fltk-file_choosers.adb
@@ -31,6 +31,12 @@ package body FLTK.File_Choosers is
     --  Functions From C  --
     ------------------------
 
+    function fl_widget_get_user_data
+           (W : in Storage.Integer_Address)
+        return Storage.Integer_Address;
+    pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data");
+    pragma Inline (fl_widget_get_user_data);
+
     procedure fl_widget_set_user_data
            (W, D : in Storage.Integer_Address);
     pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data");
@@ -952,8 +958,16 @@ package body FLTK.File_Choosers is
     is
         C_Addr : Storage.Integer_Address :=
             fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+        Ada_Obj : access Widgets.Widget'Class;
     begin
-        return Widget_Convert.To_Pointer (Storage.To_Address (C_Addr));
+        if C_Addr /= Null_Pointer then
+            C_Addr := fl_widget_get_user_data (C_Addr);
+            pragma Assert (C_Addr /= Null_Pointer);
+            Ada_Obj := Widget_Convert.To_Pointer (Storage.To_Address (C_Addr));
+        end if;
+        return Ada_Obj;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Eject_Extra;
 
 
diff --git a/src/fltk-static.adb b/src/fltk-static.adb
index 016301b..56b30c0 100644
--- a/src/fltk-static.adb
+++ b/src/fltk-static.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Ada.Containers.Vectors,
     Interfaces.C.Strings,
     System.Address_To_Access_Conversions,
@@ -20,6 +21,7 @@ use type
 package body FLTK.Static is
 
 
+    package Chk  renames Ada.Assertions;
     package Conv renames FLTK.Static_Callback_Conversions;
 
 
@@ -901,10 +903,19 @@ package body FLTK.Static is
 
 
     function Get_First_Window
-        return access FLTK.Widgets.Groups.Windows.Window'Class is
+        return access FLTK.Widgets.Groups.Windows.Window'Class
+    is
+        First_Ptr : Storage.Integer_Address := fl_static_get_first_window;
+        Actual_First : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        return Window_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_static_get_first_window)));
+        if First_Ptr /= Null_Pointer then
+            First_Ptr := fl_widget_get_user_data (First_Ptr);
+            pragma Assert (First_Ptr /= Null_Pointer);
+            Actual_First := Window_Convert.To_Pointer (Storage.To_Address (First_Ptr));
+        end if;
+        return Actual_First;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_First_Window;
 
 
@@ -917,28 +928,55 @@ package body FLTK.Static is
 
     function Get_Next_Window
            (From : in FLTK.Widgets.Groups.Windows.Window'Class)
-        return access FLTK.Widgets.Groups.Windows.Window'Class is
+        return access FLTK.Widgets.Groups.Windows.Window'Class
+    is
+        Next_Ptr : Storage.Integer_Address := fl_static_next_window (Wrapper (From).Void_Ptr);
+        Actual_Next : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        return Window_Convert.To_Pointer (Storage.To_Address
-            (fl_widget_get_user_data (fl_static_next_window (Wrapper (From).Void_Ptr))));
+        if Next_Ptr /= Null_Pointer then
+            Next_Ptr := fl_widget_get_user_data (Next_Ptr);
+            pragma Assert (Next_Ptr /= Null_Pointer);
+            Actual_Next := Window_Convert.To_Pointer (Storage.To_Address (Next_Ptr));
+        end if;
+        return Actual_Next;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Next_Window;
 
 
     function Get_Top_Modal
-        return access FLTK.Widgets.Groups.Windows.Window'Class is
+        return access FLTK.Widgets.Groups.Windows.Window'Class
+    is
+        Modal_Ptr : Storage.Integer_Address := fl_static_modal;
+        Actual_Modal : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        return Window_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_static_modal)));
+        if Modal_Ptr /= Null_Pointer then
+            Modal_Ptr := fl_widget_get_user_data (Modal_Ptr);
+            pragma Assert (Modal_Ptr /= Null_Pointer);
+            Actual_Modal := Window_Convert.To_Pointer (Storage.To_Address (Modal_Ptr));
+        end if;
+        return Actual_Modal;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Top_Modal;
 
 
 
 
     function Read_Queue
-        return access FLTK.Widgets.Widget'Class is
+        return access FLTK.Widgets.Widget'Class
+    is
+        Queue_Ptr : Storage.Integer_Address := fl_static_readqueue;
+        Actual_Queue : access FLTK.Widgets.Widget'Class;
     begin
-        return Widget_Convert.To_Pointer
-            (Storage.To_Address (fl_widget_get_user_data (fl_static_readqueue)));
+        if Queue_Ptr /= Null_Pointer then
+            Queue_Ptr := fl_widget_get_user_data (Queue_Ptr);
+            pragma Assert (Queue_Ptr /= Null_Pointer);
+            Actual_Queue := Widget_Convert.To_Pointer (Storage.To_Address (Queue_Ptr));
+        end if;
+        return Actual_Queue;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Read_Queue;
 
 
diff --git a/src/fltk-tooltips.adb b/src/fltk-tooltips.adb
index 84e4160..ccdb649 100644
--- a/src/fltk-tooltips.adb
+++ b/src/fltk-tooltips.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C,
     System.Address_To_Access_Conversions;
 
@@ -17,6 +18,11 @@ use type
 package body FLTK.Tooltips is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -174,13 +180,16 @@ package body FLTK.Tooltips is
         return access FLTK.Widgets.Widget'Class
     is
         Widget_Ptr : Storage.Integer_Address := fl_tooltip_get_current;
+        Actual_Widget : access FLTK.Widgets.Widget'Class;
     begin
         if Widget_Ptr /= Null_Pointer then
-            return Widget_Convert.To_Pointer
-                (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
-        else
-            return null;
+            Widget_Ptr := fl_widget_get_user_data (Widget_Ptr);
+            pragma Assert (Widget_Ptr /= Null_Pointer);
+            Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr));
         end if;
+        return Actual_Widget;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Target;
 
 
diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb
index c6f4602..ec8688d 100644
--- a/src/fltk-widgets-groups-help_views.adb
+++ b/src/fltk-widgets-groups-help_views.adb
@@ -243,9 +243,11 @@ package body FLTK.Widgets.Groups.Help_Views is
             S : in Interfaces.C.Strings.chars_ptr)
         return Interfaces.C.Strings.chars_ptr
     is
-        Ada_Help_View : access Help_View'Class :=
-            Help_View_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (V)));
+        User_Data : Storage.Integer_Address := fl_widget_get_user_data (V);
+        Ada_Help_View : access Help_View'Class;
     begin
+        pragma Assert (User_Data /= Null_Pointer);
+        Ada_Help_View := Help_View_Convert.To_Pointer (Storage.To_Address (User_Data));
         if Ada_Help_View.Zelda = null then
             return S;
         end if;
@@ -257,6 +259,8 @@ package body FLTK.Widgets.Groups.Help_Views is
         else
             return Ada_Help_View.Hilda;
         end if;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Link_Callback_Hook;
 
 
diff --git a/src/fltk-widgets-groups-tabbed.adb b/src/fltk-widgets-groups-tabbed.adb
index 37556e5..3b62b3c 100644
--- a/src/fltk-widgets-groups-tabbed.adb
+++ b/src/fltk-widgets-groups-tabbed.adb
@@ -6,12 +6,18 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C;
 
 
 package body FLTK.Widgets.Groups.Tabbed is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -186,12 +192,17 @@ package body FLTK.Widgets.Groups.Tabbed is
            (This : in Tabbed_Group)
         return access Widget'Class
     is
-        Widget_Ptr : Storage.Integer_Address :=
-            fl_tabs_get_push (This.Void_Ptr);
-        Actual_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
+        Push_Ptr : Storage.Integer_Address := fl_tabs_get_push (This.Void_Ptr);
+        Actual_Widget : access Widget'Class;
     begin
+        if Push_Ptr /= Null_Pointer then
+            Push_Ptr := fl_widget_get_user_data (Push_Ptr);
+            pragma Assert (Push_Ptr /= Null_Pointer);
+            Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Push_Ptr));
+        end if;
         return Actual_Widget;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Push;
 
 
@@ -207,12 +218,17 @@ package body FLTK.Widgets.Groups.Tabbed is
            (This : in Tabbed_Group)
         return access Widget'Class
     is
-        Widget_Ptr : Storage.Integer_Address :=
-            fl_tabs_get_value (This.Void_Ptr);
-        Actual_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
+        Visible_Ptr : Storage.Integer_Address := fl_tabs_get_value (This.Void_Ptr);
+        Actual_Widget : access Widget'Class;
     begin
+        if Visible_Ptr /= Null_Pointer then
+            Visible_Ptr := fl_widget_get_user_data (Visible_Ptr);
+            pragma Assert (Visible_Ptr /= Null_Pointer);
+            Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr));
+        end if;
         return Actual_Widget;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Visible;
 
 
@@ -229,12 +245,18 @@ package body FLTK.Widgets.Groups.Tabbed is
             Event_X, Event_Y : in Integer)
         return access Widget'Class
     is
-        Widget_Ptr : Storage.Integer_Address :=
+        Which_Ptr : Storage.Integer_Address :=
             fl_tabs_which (This.Void_Ptr, Interfaces.C.int (Event_X), Interfaces.C.int (Event_Y));
-        Actual_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
+        Actual_Widget : access Widget'Class;
     begin
+        if Which_Ptr /= Null_Pointer then
+            Which_Ptr := fl_widget_get_user_data (Which_Ptr);
+            pragma Assert (Which_Ptr /= Null_Pointer);
+            Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Which_Ptr));
+        end if;
         return Actual_Widget;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Which;
 
 
diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb
index c3fea47..636e368 100644
--- a/src/fltk-widgets-groups-text_displays-text_editors.adb
+++ b/src/fltk-widgets-groups-text_displays-text_editors.adb
@@ -356,14 +356,16 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is
             E : in Storage.Integer_Address)
         return Interfaces.C.int
     is
-        Ada_Editor : access Text_Editor'Class :=
-            Editor_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (E)));
+        Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E);
+        Ada_Editor : access Text_Editor'Class;
         Modi : Modifier := FLTK.Event.Last_Modifier;
         Actual_Key : Keypress := FLTK.Event.Last_Key; --  fuck you FLTK, give me the real code
         Ada_Key : Key_Combo := To_Ada (To_C (Actual_Key) + To_C (Modi));
 
         Found_Binding : Boolean := False;
     begin
+        pragma Assert (Editor_Ptr /= Null_Pointer);
+        Ada_Editor := Editor_Convert.To_Pointer (Storage.To_Address (Editor_Ptr));
         for B of Ada_Editor.Bindings loop
             if B.Key = Ada_Key then
                 B.Func (Ada_Editor.all);
diff --git a/src/fltk-widgets-groups-windows-double-cairo.adb b/src/fltk-widgets-groups-windows-double-cairo.adb
index 75cf50a..eedcbd1 100644
--- a/src/fltk-widgets-groups-windows-double-cairo.adb
+++ b/src/fltk-widgets-groups-windows-double-cairo.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C,
     System.Address_To_Access_Conversions;
 
@@ -13,6 +14,11 @@ with
 package body FLTK.Widgets.Groups.Windows.Double.Cairo is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -74,9 +80,12 @@ package body FLTK.Widgets.Groups.Windows.Double.Cairo is
         Ada_Object : access Cairo_Window'Class :=
             Cairo_Convert.To_Pointer (Ada_Addr);
     begin
+        pragma Assert (Ada_Object /= null);
         if Ada_Object.My_Func /= null then
             Ada_Object.My_Func (Cairo_Window (Ada_Object.all), Storage.To_Address (Cairo_Addr));
         end if;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Cairo_Draw_Hook;
 
 
diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb
index 658bf55..0f60c46 100644
--- a/src/fltk-widgets-groups-wizards.adb
+++ b/src/fltk-widgets-groups-wizards.adb
@@ -6,12 +6,18 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C;
 
 
 package body FLTK.Widgets.Groups.Wizards is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -165,12 +171,17 @@ package body FLTK.Widgets.Groups.Wizards is
            (This : in Wizard)
         return access Widget'Class
     is
-        Widget_Ptr : Storage.Integer_Address :=
-            fl_wizard_get_visible (This.Void_Ptr);
-        Actual_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
+        Visible_Ptr : Storage.Integer_Address := fl_wizard_get_visible (This.Void_Ptr);
+        Actual_Widget : access Widget'Class;
     begin
+        if Visible_Ptr /= Null_Pointer then
+            Visible_Ptr := fl_widget_get_user_data (Visible_Ptr);
+            pragma Assert (Visible_Ptr /= Null_Pointer);
+            Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr));
+        end if;
         return Actual_Widget;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Visible;
 
 
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index be46a72..28653ec 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -6,8 +6,9 @@
 
 with
 
-    Interfaces.C.Strings,
-    Ada.Unchecked_Deallocation;
+    Ada.Assertions,
+    Ada.Unchecked_Deallocation,
+    Interfaces.C.Strings;
 
 use type
 
@@ -19,6 +20,11 @@ use type
 package body FLTK.Widgets.Menus is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -272,11 +278,15 @@ package body FLTK.Widgets.Menus is
     procedure Item_Hook
            (M, U : in Storage.Integer_Address)
     is
-        Ada_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (M)));
+        C_Ptr : Storage.Integer_Address := fl_widget_get_user_data (M);
+        Ada_Widget : access Widget'Class;
         Action : Widget_Callback := Callback_Convert.To_Access (U);
     begin
+        pragma Assert (C_Ptr /= Null_Pointer);
+        Ada_Widget := Widget_Convert.To_Pointer (Storage.To_Address (C_Ptr));
         Action.all (Ada_Widget.all);
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Item_Hook;