Proper init of Message_Icon box, some more checks added

5 files changed, 79 insertions, 3 deletions

diff --git a/body/c_fl_box.cpp b/body/c_fl_box.cpp
index 8bedec1..22ef21e 100644
--- a/body/c_fl_box.cpp
+++ b/body/c_fl_box.cpp
@@ -11,6 +11,16 @@
 
 
 
+//  Telprot stopover
+
+extern "C" void box_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l);
+void fl_box_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) {
+    box_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+
+
+
 //  Exports from Ada
 
 extern "C" void widget_draw_hook(void * ud);
diff --git a/body/c_fl_box.h b/body/c_fl_box.h
index 5143c3f..f0f8352 100644
--- a/body/c_fl_box.h
+++ b/body/c_fl_box.h
@@ -8,6 +8,9 @@
 #define FL_BOX_GUARD
 
 
+extern "C" void fl_box_extra_init(void * adaobj, int x, int y, int w, int h, const char * label);
+
+
 typedef void* BOX;
 
 
diff --git a/body/fltk-asks.adb b/body/fltk-asks.adb
index ee32c95..8d4f900 100644
--- a/body/fltk-asks.adb
+++ b/body/fltk-asks.adb
@@ -234,9 +234,9 @@ package body FLTK.Asks is
 
 
 
-    ---------------
-    --  Cleanup  --
-    ---------------
+    -------------------
+    --  Destructors  --
+    -------------------
 
     procedure Finalize
            (This : in out Dialog_String_Final_Controller)
@@ -254,6 +254,21 @@ package body FLTK.Asks is
 
 
 
+    --------------------
+    --  Constructors  --
+    --------------------
+
+    --  You can get out of a hole by digging deeper, right?
+    procedure fl_box_extra_init
+           (Ada_Obj    : in Storage.Integer_Address;
+            X, Y, W, H : in Interfaces.C.int;
+            C_Str      : in Interfaces.C.char_array);
+    pragma Import (C, fl_box_extra_init, "fl_box_extra_init");
+    pragma Inline (fl_box_extra_init);
+
+
+
+
     -----------------------
     --  API Subprograms  --
     -----------------------
@@ -369,6 +384,10 @@ package body FLTK.Asks is
             Interfaces.C.Strings.Null_Ptr);
     begin
         return Choice_Result'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_choice returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
     end Choice;
 
 
@@ -384,6 +403,10 @@ package body FLTK.Asks is
             Interfaces.C.Strings.Null_Ptr);
     begin
         return Choice_Result'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_choice returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
     end Choice;
 
 
@@ -400,6 +423,10 @@ package body FLTK.Asks is
             Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access));
     begin
         return Choice_Result'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_choice returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
     end Choice;
 
 
@@ -685,6 +712,14 @@ begin
 
     Wrapper (Icon_Box).Void_Ptr := fl_ask_message_icon;
     Wrapper (Icon_Box).Needs_Dealloc := False;
+    fl_box_extra_init
+       (Storage.To_Integer (Icon_Box'Address),
+        Interfaces.C.int (Icon_Box.Get_X),
+        Interfaces.C.int (Icon_Box.Get_Y),
+        Interfaces.C.int (Icon_Box.Get_W),
+        Interfaces.C.int (Icon_Box.Get_H),
+        Interfaces.C.To_C (Icon_Box.Get_Label));
+
 
     fl_ask_file_chooser_callback (Storage.To_Integer (File_Chooser_Callback_Hook'Address));
 
diff --git a/body/fltk-widgets-boxes.adb b/body/fltk-widgets-boxes.adb
index 6bd11f4..efe6e54 100644
--- a/body/fltk-widgets-boxes.adb
+++ b/body/fltk-widgets-boxes.adb
@@ -86,6 +86,30 @@ package body FLTK.Widgets.Boxes is
     --  Constructors  --
     --------------------
 
+    --  Hole successfully dug out of
+    procedure box_extra_init_hook
+           (Ada_Obj    : in Storage.Integer_Address;
+            X, Y, W, H : in Interfaces.C.int;
+            C_Str      : in Interfaces.C.Strings.chars_ptr);
+    pragma Export (C, box_extra_init_hook, "box_extra_init_hook");
+
+    procedure box_extra_init_hook
+           (Ada_Obj    : in Storage.Integer_Address;
+            X, Y, W, H : in Interfaces.C.int;
+            C_Str      : in Interfaces.C.Strings.chars_ptr)
+    is
+        My_Box : Box;
+        for My_Box'Address use Storage.To_Address (Ada_Obj);
+        pragma Import (Ada, My_Box);
+    begin
+        Extra_Init
+           (My_Box,
+            Integer (X), Integer (Y),
+            Integer (W), Integer (H),
+            Interfaces.C.Strings.Value (C_Str));
+    end box_extra_init_hook;
+
+
     procedure Extra_Init
            (This       : in out Box;
             X, Y, W, H : in     Integer;
diff --git a/spec/fltk-asks.ads b/spec/fltk-asks.ads
index 75296d3..23e2076 100644
--- a/spec/fltk-asks.ads
+++ b/spec/fltk-asks.ads
@@ -172,6 +172,10 @@ package FLTK.Asks is
            (Font : in Font_Kind;
             Size : in Font_Size);
 
+    --  Technically the returned Box should have a parent, but you can't access
+    --  it for annoying technical reasons relating to how the Choice functions
+    --  work in C++. You shouldn't be trying to poke at those internals anyway.
+    --  Just stick to calling subprograms to change stuff about this Box.
     function Get_Message_Icon
         return FLTK.Widgets.Boxes.Box_Reference;