diff options
Diffstat (limited to 'body/fltk-widgets-groups-tabbed.adb')
| -rw-r--r-- | body/fltk-widgets-groups-tabbed.adb | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/body/fltk-widgets-groups-tabbed.adb b/body/fltk-widgets-groups-tabbed.adb index 360b824..28c4c04 100644 --- a/body/fltk-widgets-groups-tabbed.adb +++ b/body/fltk-widgets-groups-tabbed.adb @@ -22,6 +22,8 @@ package body FLTK.Widgets.Groups.Tabbed is -- Functions From C -- ------------------------ + -- Allocation -- + function new_fl_tabs (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -37,6 +39,8 @@ package body FLTK.Widgets.Groups.Tabbed is + -- Child Area -- + procedure fl_tabs_client_area (T : in Storage.Integer_Address; X, Y, W, H : out Interfaces.C.int; @@ -47,6 +51,8 @@ package body FLTK.Widgets.Groups.Tabbed is + -- Operation -- + function fl_tabs_get_push (T : in Storage.Integer_Address) return Storage.Integer_Address; @@ -79,6 +85,8 @@ package body FLTK.Widgets.Groups.Tabbed is + -- Drawing, Events -- + procedure fl_tabs_draw (W : in Storage.Integer_Address); pragma Import (C, fl_tabs_draw, "fl_tabs_draw"); @@ -153,11 +161,11 @@ package body FLTK.Widgets.Groups.Tabbed is begin return This : Tabbed_Group do This.Void_Ptr := new_fl_tabs - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); Extra_Init (This, X, Y, W, H, Text); end return; end Create; @@ -183,6 +191,8 @@ package body FLTK.Widgets.Groups.Tabbed is -- API Subprograms -- ----------------------- + -- Child Area -- + procedure Get_Client_Area (This : in Tabbed_Group; Tab_Height : in Natural; @@ -200,6 +210,8 @@ package body FLTK.Widgets.Groups.Tabbed is + -- Operation -- + function Get_Push (This : in Tabbed_Group) return access Widget'Class @@ -214,7 +226,8 @@ package body FLTK.Widgets.Groups.Tabbed is end if; return Actual_Widget; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Tabs::push returned Widget with no user_data reference back to Ada"; end Get_Push; @@ -240,7 +253,8 @@ package body FLTK.Widgets.Groups.Tabbed is end if; return Actual_Widget; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Tabs::value returned Widget with no user_data reference back to Ada"; end Get_Visible; @@ -268,12 +282,15 @@ package body FLTK.Widgets.Groups.Tabbed is end if; return Actual_Widget; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Tabs::which returned Widget with no user_data reference back to Ada"; end Get_Which; + -- Drawing, Events -- + procedure Draw (This : in out Tabbed_Group) is begin |