diff options
Diffstat (limited to 'body/fltk-widgets-groups-browsers-textline.adb')
| -rw-r--r-- | body/fltk-widgets-groups-browsers-textline.adb | 86 |
1 files changed, 72 insertions, 14 deletions
diff --git a/body/fltk-widgets-groups-browsers-textline.adb b/body/fltk-widgets-groups-browsers-textline.adb index b7b3077..e75ea6f 100644 --- a/body/fltk-widgets-groups-browsers-textline.adb +++ b/body/fltk-widgets-groups-browsers-textline.adb @@ -8,7 +8,6 @@ with Ada.Assertions, Ada.Unchecked_Deallocation, - FLTK.Images, Interfaces.C.Strings; use type @@ -29,6 +28,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is -- Functions From C -- ------------------------ + -- Errors -- + function get_error_message return Interfaces.C.Strings.chars_ptr; pragma Import (C, get_error_message, "get_error_message"); @@ -37,6 +38,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Allocation -- + function new_fl_browser (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -52,6 +55,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Lines -- + procedure fl_browser_add (B : in Storage.Integer_Address; T : in Interfaces.C.char_array; @@ -99,6 +104,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Text Loading -- + function fl_browser_load (B : in Storage.Integer_Address; F : in Interfaces.C.char_array) @@ -135,6 +142,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Columns, Formatting -- + function fl_browser_get_column_char (B : in Storage.Integer_Address) return Interfaces.C.char; @@ -167,6 +176,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Line Positions -- + function fl_browser_get_topline (B : in Storage.Integer_Address) return Interfaces.C.int; @@ -200,6 +211,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Selection -- + function fl_browser_select (B : in Storage.Integer_Address; L, V : in Interfaces.C.int) @@ -223,6 +236,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Visibility -- + function fl_browser_visible (B : in Storage.Integer_Address; L : in Interfaces.C.int) @@ -268,6 +283,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Dimensions -- + procedure fl_browser_set_size (B : in Storage.Integer_Address; W, H : in Interfaces.C.int); @@ -277,6 +294,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Icons -- + procedure fl_browser_set_icon (B : in Storage.Integer_Address; L : in Interfaces.C.int; @@ -293,6 +312,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Item Implementation -- + function fl_browser_item_width (B, I : in Storage.Integer_Address) return Interfaces.C.int; @@ -368,6 +389,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- List Implementation -- + function fl_browser_full_width (B : in Storage.Integer_Address) return Interfaces.C.int; @@ -395,6 +418,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Line Numbers -- + function fl_browser_lineno (B, I : in Storage.Integer_Address) return Interfaces.C.int; @@ -404,6 +429,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Drawing, Events -- + procedure fl_browser_draw (B : in Storage.Integer_Address); pragma Import (C, fl_browser_draw, "fl_browser_draw"); @@ -534,6 +561,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is -- API Subprograms -- ----------------------- + -- Lines -- + procedure Add (This : in out Textline_Browser; Text : in String) is @@ -607,12 +636,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Text Loading -- + procedure Load (This : in out Textline_Browser; File : in String) is Msg : Interfaces.C.Strings.chars_ptr; - Code : Interfaces.C.int := fl_browser_load (This.Void_Ptr, Interfaces.C.To_C (File)); + Code : constant Interfaces.C.int := + fl_browser_load (This.Void_Ptr, Interfaces.C.To_C (File)); begin if Code = 0 then Msg := get_error_message; @@ -625,7 +657,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is pragma Assert (Code = 1); end if; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Browser::load returned unexpected int value of " & Interfaces.C.int'Image (Code); end Load; @@ -634,7 +667,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Line : in Positive) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_browser_get_text + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_browser_get_text (This.Void_Ptr, Interfaces.C.int (Line)); begin @@ -676,6 +709,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Columns, Formatting -- + function Get_Column_Character (This : in Textline_Browser) return Character is @@ -740,6 +775,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Line Positions -- + function Get_Top_Line (This : in Textline_Browser) return Positive is @@ -783,13 +820,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Selection -- + function Set_Select (This : in out Textline_Browser; Line : in Positive; State : in Boolean := True) return Boolean is - Code : Interfaces.C.int := fl_browser_select + Code : constant Interfaces.C.int := fl_browser_select (This.Void_Ptr, Interfaces.C.int (Line), Boolean'Pos (State)); @@ -797,7 +836,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Browser::select returned unexpected int value of " & Interfaces.C.int'Image (Code); end Set_Select; @@ -806,14 +846,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Line : in Positive; State : in Boolean := True) is - Code : Interfaces.C.int := fl_browser_select + Code : constant Interfaces.C.int := fl_browser_select (This.Void_Ptr, Interfaces.C.int (Line), Boolean'Pos (State)); begin pragma Assert (Code in 0 .. 1); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Browser::select returned unexpected int value of " & Interfaces.C.int'Image (Code); end Set_Select; @@ -822,14 +863,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Line : in Positive) return Boolean is - Code : Interfaces.C.int := fl_browser_selected + Code : constant Interfaces.C.int := fl_browser_selected (This.Void_Ptr, Interfaces.C.int (Line)); begin pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Browser::selected returned unexpected int value of " & Interfaces.C.int'Image (Code); end Is_Selected; @@ -843,6 +885,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Visibility -- + function Is_Visible (This : in Textline_Browser; Line : in Positive) @@ -865,14 +909,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Line : in Positive) return Boolean is - Code : Interfaces.C.int := fl_browser_displayed + Code : constant Interfaces.C.int := fl_browser_displayed (This.Void_Ptr, Interfaces.C.int (Line)); begin pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Browser::displayed returned unexpected int value of " & Interfaces.C.int'Image (Code); end Is_Displayed; @@ -908,6 +953,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Dimensions -- + procedure Resize (This : in out Textline_Browser; W, H : in Integer) is @@ -921,6 +968,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Icons -- + function Has_Icon (This : in Textline_Browser; Line : in Positive) @@ -974,6 +1023,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- List Implementation -- + function Full_List_Height (This : in Textline_Browser) return Integer is @@ -992,6 +1043,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Item Implementation -- + function Item_Width (This : in Textline_Browser; Item : in Item_Cursor) @@ -1121,12 +1174,15 @@ package body FLTK.Widgets.Groups.Browsers.Textline is return Interfaces.C.int; for my_item_selected'Address use This.Item_Override_Ptrs (Item_Selected_Ptr); pragma Import (Ada, my_item_selected); - Code : Interfaces.C.int := my_item_selected (This.Void_Ptr, Cursor_To_Address (Item)); + Code : constant Interfaces.C.int := + my_item_selected (This.Void_Ptr, Cursor_To_Address (Item)); begin pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Dispatched item_selected function returned unexpected int value of " & + Interfaces.C.int'Image (Code); end Item_Selected; @@ -1181,6 +1237,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is + -- Line Numbers -- + function Line_Number (This : in Textline_Browser; Item : in Item_Cursor) |