diff options
Diffstat (limited to 'body/fltk-widgets-groups-help_views.adb')
| -rw-r--r-- | body/fltk-widgets-groups-help_views.adb | 42 |
1 files changed, 35 insertions, 7 deletions
diff --git a/body/fltk-widgets-groups-help_views.adb b/body/fltk-widgets-groups-help_views.adb index 6435c0f..d31e532 100644 --- a/body/fltk-widgets-groups-help_views.adb +++ b/body/fltk-widgets-groups-help_views.adb @@ -7,7 +7,7 @@ with Ada.Assertions, - Interfaces.C.Strings, + Interfaces.C, System.Address_To_Access_Conversions; use type @@ -27,6 +27,8 @@ package body FLTK.Widgets.Groups.Help_Views is -- Functions From C -- ------------------------ + -- Allocation -- + function new_fl_help_view (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -42,6 +44,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Selection -- + procedure fl_help_view_clear_selection (V : in Storage.Integer_Address); pragma Import (C, fl_help_view_clear_selection, "fl_help_view_clear_selection"); @@ -55,6 +59,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Position -- + function fl_help_view_find (V : in Storage.Integer_Address; S : in Interfaces.C.char_array; @@ -96,6 +102,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Content -- + function fl_help_view_directory (V : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; @@ -141,6 +149,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Settings -- + function fl_help_view_get_scrollbar_size (V : in Storage.Integer_Address) return Interfaces.C.int; @@ -210,6 +220,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Drawing, Events -- + procedure fl_help_view_draw (V : in Storage.Integer_Address); pragma Import (C, fl_help_view_draw, "fl_help_view_draw"); @@ -243,7 +255,7 @@ package body FLTK.Widgets.Groups.Help_Views is S : in Interfaces.C.Strings.chars_ptr) return Interfaces.C.Strings.chars_ptr is - User_Data : Storage.Integer_Address := fl_widget_get_user_data (V); + User_Data : constant Storage.Integer_Address := fl_widget_get_user_data (V); Ada_Help_View : access Help_View'Class; begin pragma Assert (User_Data /= Null_Pointer); @@ -260,7 +272,9 @@ package body FLTK.Widgets.Groups.Help_Views is return Ada_Help_View.Hilda; end if; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Help_View::link callback hook received Widget with no user_data reference " & + "back to Ada"; end Link_Callback_Hook; @@ -352,6 +366,8 @@ package body FLTK.Widgets.Groups.Help_Views is -- API Subprograms -- ----------------------- + -- Selection -- + procedure Clear_Selection (This : in out Help_View) is begin @@ -368,6 +384,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Position -- + function Find (This : in Help_View; Item : in String; @@ -423,6 +441,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Content -- + function Current_Directory (This : in Help_View) return String is @@ -443,7 +463,8 @@ package body FLTK.Widgets.Groups.Help_Views is (This : in out Help_View; Name : in String) is - Code : Interfaces.C.int := fl_help_view_load (This.Void_Ptr, Interfaces.C.To_C (Name)); + Code : constant Interfaces.C.int := + fl_help_view_load (This.Void_Ptr, Interfaces.C.To_C (Name)); begin if Code = -1 then raise Load_Help_Error; @@ -451,7 +472,9 @@ package body FLTK.Widgets.Groups.Help_Views is pragma Assert (Code = 0); end if; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Help_View::load returned unexpected int value of " & + Interfaces.C.int'Image (Code); end Load; @@ -459,7 +482,7 @@ package body FLTK.Widgets.Groups.Help_Views is (This : in Help_View) return String is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_title (This.Void_Ptr); + Raw_Chars : constant Interfaces.C.Strings.chars_ptr := fl_help_view_title (This.Void_Ptr); use type Interfaces.C.Strings.chars_ptr; begin if Raw_Chars = Interfaces.C.Strings.Null_Ptr then @@ -474,7 +497,8 @@ package body FLTK.Widgets.Groups.Help_Views is (This : in Help_View) return String is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_get_value (This.Void_Ptr); + Raw_Chars : constant Interfaces.C.Strings.chars_ptr := + fl_help_view_get_value (This.Void_Ptr); use type Interfaces.C.Strings.chars_ptr; begin if Raw_Chars = Interfaces.C.Strings.Null_Ptr then @@ -503,6 +527,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Settings -- + function Get_Scrollbar_Size (This : in Help_View) return Natural is @@ -601,6 +627,8 @@ package body FLTK.Widgets.Groups.Help_Views is + -- Drawing, Events -- + procedure Draw (This : in out Help_View) is begin |