Filled holes in Group binding API

4 files changed, 256 insertions, 54 deletions

diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp
index 890fd9a..62bee03 100644
--- a/src/c_fl_group.cpp
+++ b/src/c_fl_group.cpp
@@ -20,6 +20,19 @@ extern "C" int widget_handle_hook(void * ud, int e);
 
 
 
+//  Non-friend protected access
+
+class Friend_Group : Fl_Group {
+public:
+    using Fl_Group::draw_child;
+    using Fl_Group::draw_children;
+    using Fl_Group::draw_outside_label;
+    using Fl_Group::update_child;
+};
+
+
+
+
 //  Attaching all relevant hooks and friends
 
 class My_Group : public Fl_Group {
@@ -52,78 +65,80 @@ GROUP new_fl_group(int x, int y, int w, int h, char* label) {
 }
 
 void free_fl_group(GROUP g) {
-    delete reinterpret_cast<My_Group*>(g);
-}
-
-
-
-
-void fl_group_end(GROUP g) {
-    reinterpret_cast<Fl_Group*>(g)->end();
+    delete static_cast<My_Group*>(g);
 }
 
 
 
 
 void fl_group_add(GROUP g, WIDGET item) {
-    reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item));
+    static_cast<Fl_Group*>(g)->add(static_cast<Fl_Widget*>(item));
 }
 
 void fl_group_insert(GROUP g, WIDGET item, int place) {
-    reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place);
+    static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), place);
 }
 
 void fl_group_insert2(GROUP g, WIDGET item, WIDGET before) {
-    reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), reinterpret_cast<Fl_Widget*>(before));
+    static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), static_cast<Fl_Widget*>(before));
 }
 
 void fl_group_remove(GROUP g, WIDGET item) {
-    reinterpret_cast<Fl_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item));
+    static_cast<Fl_Group*>(g)->remove(static_cast<Fl_Widget*>(item));
 }
 
 void fl_group_remove2(GROUP g, int place) {
-    reinterpret_cast<Fl_Group*>(g)->remove(place);
+    static_cast<Fl_Group*>(g)->remove(place);
 }
 
 
 
 
 void * fl_group_child(GROUP g, int place) {
-    return reinterpret_cast<Fl_Group*>(g)->child(place);
+    return static_cast<Fl_Group*>(g)->child(place);
 }
 
 int fl_group_find(GROUP g, WIDGET item) {
-    return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item));
+    return static_cast<Fl_Group*>(g)->find(static_cast<Fl_Widget*>(item));
 }
 
 int fl_group_children(GROUP g) {
-    return reinterpret_cast<Fl_Group*>(g)->children();
+    return static_cast<Fl_Group*>(g)->children();
 }
 
 
 
 
 unsigned int fl_group_get_clip_children(GROUP g) {
-    return reinterpret_cast<Fl_Group*>(g)->clip_children();
+    return static_cast<Fl_Group*>(g)->clip_children();
 }
 
 void fl_group_set_clip_children(GROUP g, int c) {
-    reinterpret_cast<Fl_Group*>(g)->clip_children(c);
+    static_cast<Fl_Group*>(g)->clip_children(c);
 }
 
 
 
 
+void fl_group_add_resizable(GROUP g, WIDGET w) {
+    Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+    static_cast<Fl_Group*>(g)->add_resizable(ref);
+}
+
 void * fl_group_get_resizable(GROUP g) {
-    return reinterpret_cast<Fl_Group*>(g)->resizable();
+    return static_cast<Fl_Group*>(g)->resizable();
 }
 
 void fl_group_set_resizable(GROUP g, WIDGET item) {
-    reinterpret_cast<Fl_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item));
+    static_cast<Fl_Group*>(g)->resizable(static_cast<Fl_Widget*>(item));
 }
 
 void fl_group_init_sizes(GROUP g) {
-    reinterpret_cast<Fl_Group*>(g)->init_sizes();
+    static_cast<Fl_Group*>(g)->init_sizes();
+}
+
+void fl_group_resize(GROUP g, int x, int y, int w, int h) {
+    static_cast<Fl_Group*>(g)->resize(x, y, w, h);
 }
 
 
@@ -134,18 +149,45 @@ void * fl_group_get_current() {
 }
 
 void fl_group_set_current(GROUP g) {
-    Fl_Group::current(reinterpret_cast<Fl_Group*>(g));
+    Fl_Group::current(static_cast<Fl_Group*>(g));
+}
+
+void fl_group_begin(GROUP g) {
+    static_cast<Fl_Group*>(g)->begin();
+}
+
+void fl_group_end(GROUP g) {
+    static_cast<Fl_Group*>(g)->end();
 }
 
 
 
 
 void fl_group_draw(GROUP g) {
-    reinterpret_cast<My_Group*>(g)->Fl_Group::draw();
+    static_cast<My_Group*>(g)->Fl_Group::draw();
+}
+
+void fl_group_draw_child(GROUP g, WIDGET w) {
+    Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+    (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_child))(ref);
+}
+
+void fl_group_draw_children(GROUP g) {
+    (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_children))();
+}
+
+void fl_group_draw_outside_label(GROUP g, WIDGET w) {
+    Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+    (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_outside_label))(ref);
+}
+
+void fl_group_update_child(GROUP g, WIDGET w) {
+    Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+    (static_cast<Fl_Group*>(g)->*(&Friend_Group::update_child))(ref);
 }
 
 int fl_group_handle(GROUP g, int e) {
-    return reinterpret_cast<My_Group*>(g)->Fl_Group::handle(e);
+    return static_cast<My_Group*>(g)->Fl_Group::handle(e);
 }
 
 
diff --git a/src/c_fl_group.h b/src/c_fl_group.h
index 57f5e4c..af4559d 100644
--- a/src/c_fl_group.h
+++ b/src/c_fl_group.h
@@ -17,9 +17,6 @@ extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label);
 extern "C" void free_fl_group(GROUP g);
 
 
-extern "C" void fl_group_end(GROUP g);
-
-
 extern "C" void fl_group_add(GROUP g, WIDGET item);
 extern "C" void fl_group_insert(GROUP g, WIDGET item, int place);
 extern "C" void fl_group_insert2(GROUP g, WIDGET item, WIDGET before);
@@ -36,16 +33,24 @@ extern "C" unsigned int fl_group_get_clip_children(GROUP g);
 extern "C" void fl_group_set_clip_children(GROUP g, int c);
 
 
+extern "C" void fl_group_add_resizable(GROUP g, WIDGET w);
 extern "C" void * fl_group_get_resizable(GROUP g);
 extern "C" void fl_group_set_resizable(GROUP g, WIDGET item);
 extern "C" void fl_group_init_sizes(GROUP g);
+extern "C" void fl_group_resize(GROUP g, int x, int y, int w, int h);
 
 
 extern "C" void * fl_group_get_current();
 extern "C" void fl_group_set_current(GROUP g);
+extern "C" void fl_group_begin(GROUP g);
+extern "C" void fl_group_end(GROUP g);
 
 
 extern "C" void fl_group_draw(GROUP g);
+extern "C" void fl_group_draw_child(GROUP g, WIDGET w);
+extern "C" void fl_group_draw_children(GROUP g);
+extern "C" void fl_group_draw_outside_label(GROUP g, WIDGET w);
+extern "C" void fl_group_update_child(GROUP g, WIDGET w);
 extern "C" int fl_group_handle(GROUP g, int e);
 
 
diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb
index 4641dd1..2c21533 100644
--- a/src/fltk-widgets-groups.adb
+++ b/src/fltk-widgets-groups.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C;
 
 use type
@@ -16,6 +17,11 @@ use type
 package body FLTK.Widgets.Groups is
 
 
+    package Chk renames Ada.Assertions;
+
+
+
+
     ------------------------
     --  Functions From C  --
     ------------------------
@@ -35,14 +41,6 @@ package body FLTK.Widgets.Groups is
 
 
 
-    procedure fl_group_end
-           (G : in Storage.Integer_Address);
-    pragma Import (C, fl_group_end, "fl_group_end");
-    pragma Inline (fl_group_end);
-
-
-
-
     procedure fl_group_add
            (G, W : in Storage.Integer_Address);
     pragma Import (C, fl_group_add, "fl_group_add");
@@ -110,6 +108,11 @@ package body FLTK.Widgets.Groups is
 
 
 
+    procedure fl_group_add_resizable
+           (G, W : in Storage.Integer_Address);
+    pragma Import (C, fl_group_add_resizable, "fl_group_add_resizable");
+    pragma Inline (fl_group_add_resizable);
+
     function fl_group_get_resizable
            (G : in Storage.Integer_Address)
         return Storage.Integer_Address;
@@ -126,6 +129,12 @@ package body FLTK.Widgets.Groups is
     pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes");
     pragma Inline (fl_group_init_sizes);
 
+    procedure fl_group_resize
+           (G          : in Storage.Integer_Address;
+            X, Y, W, H : in Interfaces.C.int);
+    pragma Import (C, fl_group_resize, "fl_group_resize");
+    pragma Inline (fl_group_resize);
+
 
 
 
@@ -139,6 +148,16 @@ package body FLTK.Widgets.Groups is
     pragma Import (C, fl_group_set_current, "fl_group_set_current");
     pragma Inline (fl_group_set_current);
 
+    procedure fl_group_begin
+           (G : in Storage.Integer_Address);
+    pragma Import (C, fl_group_begin, "fl_group_begin");
+    pragma Inline (fl_group_begin);
+
+    procedure fl_group_end
+           (G : in Storage.Integer_Address);
+    pragma Import (C, fl_group_end, "fl_group_end");
+    pragma Inline (fl_group_end);
+
 
 
 
@@ -147,6 +166,26 @@ package body FLTK.Widgets.Groups is
     pragma Import (C, fl_group_draw, "fl_group_draw");
     pragma Inline (fl_group_draw);
 
+    procedure fl_group_draw_child
+           (G, W : in Storage.Integer_Address);
+    pragma Import (C, fl_group_draw_child, "fl_group_draw_child");
+    pragma Inline (fl_group_draw_child);
+
+    procedure fl_group_draw_children
+           (G : in Storage.Integer_Address);
+    pragma Import (C, fl_group_draw_children, "fl_group_draw_children");
+    pragma Inline (fl_group_draw_children);
+
+    procedure fl_group_draw_outside_label
+           (G, W : in Storage.Integer_Address);
+    pragma Import (C, fl_group_draw_outside_label, "fl_group_draw_outside_label");
+    pragma Inline (fl_group_draw_outside_label);
+
+    procedure fl_group_update_child
+           (G, W : in Storage.Integer_Address);
+    pragma Import (C, fl_group_update_child, "fl_group_update_child");
+    pragma Inline (fl_group_update_child);
+
     function fl_group_handle
            (W : in Storage.Integer_Address;
             E : in Interfaces.C.int)
@@ -282,6 +321,8 @@ package body FLTK.Widgets.Groups is
     procedure Clear
            (This : in out Group) is
     begin
+        --  We don't use the actual clear method here because
+        --  that would delete the children from memory.
         for I in reverse 1 .. This.Number_Of_Children loop
             This.Remove (Index (I));
         end loop;
@@ -314,10 +355,14 @@ package body FLTK.Widgets.Groups is
     is
         Widget_Ptr : Storage.Integer_Address :=
             fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1);
-        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
+        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));
         return (Data => Actual_Widget);
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Child;
 
 
@@ -335,13 +380,12 @@ package body FLTK.Widgets.Groups is
             Item : in out Widget'Class)
         return Extended_Index
     is
-        Ret : Interfaces.C.int;
+        Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr);
     begin
-        Ret := fl_group_find (This.Void_Ptr, Item.Void_Ptr);
-        if Ret = fl_group_children (This.Void_Ptr) then
+        if Result = fl_group_children (This.Void_Ptr) then
             return No_Index;
         end if;
-        return Extended_Index (Ret + 1);
+        return Extended_Index (Result + 1);
     end Find;
 
 
@@ -433,16 +477,29 @@ package body FLTK.Widgets.Groups is
 
 
 
+    procedure Add_Resizable
+           (This : in out Group;
+            Item : in out Widget'Class) is
+    begin
+        fl_group_add_resizable (This.Void_Ptr, Item.Void_Ptr);
+    end Add_Resizable;
+
+
     function Get_Resizable
            (This : in Group)
         return access Widget'Class
     is
-        Widget_Ptr : Storage.Integer_Address :=
-            fl_group_get_resizable (This.Void_Ptr);
-        Actual_Widget : access Widget'Class :=
-            Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr)));
+        Widget_Ptr : Storage.Integer_Address := fl_group_get_resizable (This.Void_Ptr);
+        Actual_Widget : access Widget'Class;
     begin
+        if Widget_Ptr /= Null_Pointer then
+            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_Resizable;
 
 
@@ -454,11 +511,24 @@ package body FLTK.Widgets.Groups is
     end Set_Resizable;
 
 
-    procedure Reset_Initial_Sizes
+    procedure Reset_Sizes
            (This : in out Group) is
     begin
         fl_group_init_sizes (This.Void_Ptr);
-    end Reset_Initial_Sizes;
+    end Reset_Sizes;
+
+
+    procedure Resize
+           (This       : in out Group;
+            X, Y, W, H : in     Integer) is
+    begin
+        fl_group_resize
+           (This.Void_Ptr,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H));
+    end Resize;
 
 
 
@@ -470,9 +540,13 @@ package body FLTK.Widgets.Groups is
         Actual_Group : access Group'Class;
     begin
         if Group_Ptr /= Null_Pointer then
+            Group_Ptr := fl_widget_get_user_data (Group_Ptr);
+            pragma Assert (Group_Ptr /= Null_Pointer);
             Actual_Group := Group_Convert.To_Pointer (Storage.To_Address (Group_Ptr));
         end if;
         return Actual_Group;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Get_Current;
 
 
@@ -483,6 +557,20 @@ package body FLTK.Widgets.Groups is
     end Set_Current;
 
 
+    procedure Begin_Current
+           (This : in out Group) is
+    begin
+        fl_group_begin (This.Void_Ptr);
+    end Begin_Current;
+
+
+    procedure End_Current
+           (This : in out Group) is
+    begin
+        fl_group_end (This.Void_Ptr);
+    end End_Current;
+
+
 
 
     procedure Draw
@@ -492,6 +580,37 @@ package body FLTK.Widgets.Groups is
     end Draw;
 
 
+    procedure Draw_Child
+           (This : in out Group;
+            Item : in out Widget'Class) is
+    begin
+        fl_group_draw_child (This.Void_Ptr, Item.Void_Ptr);
+    end Draw_Child;
+
+
+    procedure Draw_Children
+           (This : in out Group) is
+    begin
+        fl_group_draw_children (This.Void_Ptr);
+    end Draw_Children;
+
+
+    procedure Draw_Outside_Label
+           (This : in out Group;
+            Item : in out Widget'Class) is
+    begin
+        fl_group_draw_outside_label (This.Void_Ptr, Item.Void_Ptr);
+    end Draw_Outside_Label;
+
+
+    procedure Update_Child
+           (This : in out Group;
+            Item : in out Widget'Class) is
+    begin
+        fl_group_update_child (This.Void_Ptr, Item.Void_Ptr);
+    end Update_Child;
+
+
     function Handle
            (This  : in out Group;
             Event : in     Event_Kind)
diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads
index 9212085..960c7b6 100644
--- a/src/fltk-widgets-groups.ads
+++ b/src/fltk-widgets-groups.ads
@@ -87,7 +87,8 @@ package FLTK.Widgets.Groups is
     function Child
            (This  : in Group;
             Place : in Index)
-        return Widget_Reference;
+        return Widget_Reference
+    with Pre => This.Has_Child (Place);
 
     function Child
            (This  : in Group;
@@ -127,6 +128,10 @@ package FLTK.Widgets.Groups is
 
 
 
+    procedure Add_Resizable
+           (This : in out Group;
+            Item : in out Widget'Class);
+
     function Get_Resizable
            (This : in Group)
         return access Widget'Class;
@@ -135,9 +140,13 @@ package FLTK.Widgets.Groups is
            (This : in out Group;
             Item : in     Widget'Class);
 
-    procedure Reset_Initial_Sizes
+    procedure Reset_Sizes
            (This : in out Group);
 
+    procedure Resize
+           (This       : in out Group;
+            X, Y, W, H : in     Integer);
+
 
 
 
@@ -147,12 +156,33 @@ package FLTK.Widgets.Groups is
     procedure Set_Current
            (To : in Group'Class);
 
+    procedure Begin_Current
+           (This : in out Group);
+
+    procedure End_Current
+           (This : in out Group);
+
 
 
 
     procedure Draw
            (This : in out Group);
 
+    procedure Draw_Child
+           (This : in out Group;
+            Item : in out Widget'Class);
+
+    procedure Draw_Children
+           (This : in out Group);
+
+    procedure Draw_Outside_Label
+           (This : in out Group;
+            Item : in out Widget'Class);
+
+    procedure Update_Child
+           (This : in out Group;
+            Item : in out Widget'Class);
+
     function Handle
            (This  : in out Group;
             Event : in     Event_Kind)
@@ -222,17 +252,23 @@ private
 
     pragma Inline (Iterate);
 
-    --  pragma Inline (Get_Clip_Mode);
-    --  pragma Inline (Set_Clip_Mode);
+    pragma Inline (Get_Clip_Mode);
+    pragma Inline (Set_Clip_Mode);
 
-    pragma Inline (Get_Resizable);
+    pragma Inline (Add_Resizable);
     pragma Inline (Set_Resizable);
-    pragma Inline (Reset_Initial_Sizes);
+    pragma Inline (Reset_Sizes);
+    pragma Inline (Resize);
 
-    pragma Inline (Get_Current);
     pragma Inline (Set_Current);
+    pragma Inline (Begin_Current);
+    pragma Inline (End_Current);
 
     pragma Inline (Draw);
+    pragma Inline (Draw_Child);
+    pragma Inline (Draw_Children);
+    pragma Inline (Draw_Outside_Label);
+    pragma Inline (Update_Child);
     pragma Inline (Handle);