diff options
Diffstat (limited to 'body/fltk-widgets-groups-browsers-textline-file.adb')
| -rw-r--r-- | body/fltk-widgets-groups-browsers-textline-file.adb | 77 |
1 files changed, 54 insertions, 23 deletions
diff --git a/body/fltk-widgets-groups-browsers-textline-file.adb b/body/fltk-widgets-groups-browsers-textline-file.adb index e45396c..d22cfc1 100644 --- a/body/fltk-widgets-groups-browsers-textline-file.adb +++ b/body/fltk-widgets-groups-browsers-textline-file.adb @@ -27,6 +27,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is -- Functions From C -- ------------------------ + -- Errors, File Data -- + function get_error_message return Interfaces.C.Strings.chars_ptr; pragma Import (C, get_error_message, "get_error_message"); @@ -42,6 +44,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Allocation -- + function new_fl_file_browser (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -57,6 +61,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Directory -- + function fl_file_browser_load (B : in Storage.Integer_Address; D : in Interfaces.C.char_array; @@ -68,6 +74,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Settings -- + function fl_file_browser_get_filetype (B : in Storage.Integer_Address) return Interfaces.C.int; @@ -119,6 +127,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Item Implementation -- + function fl_file_browser_item_width (B, I : in Storage.Integer_Address) return Interfaces.C.int; @@ -194,6 +204,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- List Implementation -- + function fl_file_browser_full_width (B : in Storage.Integer_Address) return Interfaces.C.int; @@ -221,6 +233,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Drawing, Events -- + procedure fl_file_browser_draw (B : in Storage.Integer_Address); pragma Import (C, fl_file_browser_draw, "fl_file_browser_draw"); @@ -236,6 +250,32 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + ------------- + -- Hooks -- + ------------- + + Current_Sort : FLTK.Filenames.Compare_Function; + + function Compare_Hook + (DA, DB : in Storage.Integer_Address) + return Interfaces.C.int; + + pragma Convention (C, Compare_Hook); + + function Compare_Hook + (DA, DB : in Storage.Integer_Address) + return Interfaces.C.int + is + Result : constant FLTK.Filenames.Comparison := Current_Sort + (Interfaces.C.Strings.Value (filename_dname (DA, 0)), + Interfaces.C.Strings.Value (filename_dname (DB, 0))); + begin + return FLTK.Filenames.Comparison'Pos (Result) - 1; + end Compare_Hook; + + + + ------------------- -- Destructors -- ------------------- @@ -338,25 +378,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is -- API Subprograms -- ----------------------- - Current_Sort : FLTK.Filenames.Compare_Function; - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int; - - pragma Convention (C, Compare_Hook); - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int - is - Result : FLTK.Filenames.Comparison := Current_Sort - (Interfaces.C.Strings.Value (filename_dname (DA, 0)), - Interfaces.C.Strings.Value (filename_dname (DB, 0))); - begin - return FLTK.Filenames.Comparison'Pos (Result) - 1; - end Compare_Hook; - + -- Directory -- function Load (This : in out File_Browser; @@ -389,7 +411,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is Sort : in not null FLTK.Filenames.Compare_Function := FLTK.Filenames.Numeric_Sort'Access) is - Result : Natural := This.Load (Dir, Sort); + Ignore : constant Natural := This.Load (Dir, Sort); begin null; end Load; @@ -397,16 +419,20 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Settings -- + function Get_File_Kind (This : in File_Browser) return File_Kind is - Code : Interfaces.C.int := fl_file_browser_get_filetype (This.Void_Ptr); + Code : constant Interfaces.C.int := fl_file_browser_get_filetype (This.Void_Ptr); begin pragma Assert (Code in File_Kind'Pos (File_Kind'First) .. File_Kind'Pos (File_Kind'Last)); return File_Kind'Val (Code); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_File_Browser::filetype returned unexpected int value of " & + Interfaces.C.int'Image (Code); end Get_File_Kind; @@ -422,7 +448,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is (This : in File_Browser) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_file_browser_get_filter (This.Void_Ptr); + Result : constant Interfaces.C.Strings.chars_ptr := + fl_file_browser_get_filter (This.Void_Ptr); begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -474,6 +501,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- List Implementation -- + function Full_List_Height (This : in File_Browser) return Integer is @@ -492,6 +521,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is + -- Item Implementation -- + function Item_Width (This : in File_Browser; Item : in Item_Cursor) |