diff options
98 files changed, 667 insertions, 549 deletions
diff --git a/body/fltk-args_marshal.adb b/body/fltk-args_marshal.adb index f9a5aaa..f08e025 100644 --- a/body/fltk-args_marshal.adb +++ b/body/fltk-args_marshal.adb @@ -7,7 +7,7 @@ with Ada.Command_Line, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Args_Marshal is diff --git a/body/fltk-asks.adb b/body/fltk-asks.adb index 034a674..ee32c95 100644 --- a/body/fltk-asks.adb +++ b/body/fltk-asks.adb @@ -362,7 +362,7 @@ package body FLTK.Asks is (Message, Button1 : in String) return Choice_Result is - Result : Interfaces.C.int := fl_ask_choice + Result : constant Interfaces.C.int := fl_ask_choice (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.Null_Ptr, @@ -377,7 +377,7 @@ package body FLTK.Asks is return Choice_Result is Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Result : Interfaces.C.int := fl_ask_choice + Result : constant Interfaces.C.int := fl_ask_choice (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), @@ -393,7 +393,7 @@ package body FLTK.Asks is is Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3); - Result : Interfaces.C.int := fl_ask_choice + Result : constant Interfaces.C.int := fl_ask_choice (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), @@ -407,7 +407,7 @@ package body FLTK.Asks is (Message, Button1 : in String) return Extended_Choice_Result is - Result : Interfaces.C.int := fl_ask_choice_n + Result : constant Interfaces.C.int := fl_ask_choice_n (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.Null_Ptr, @@ -427,7 +427,7 @@ package body FLTK.Asks is return Extended_Choice_Result is Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Result : Interfaces.C.int := fl_ask_choice_n + Result : constant Interfaces.C.int := fl_ask_choice_n (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), @@ -448,7 +448,7 @@ package body FLTK.Asks is is Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3); - Result : Interfaces.C.int := fl_ask_choice_n + Result : constant Interfaces.C.int := fl_ask_choice_n (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), @@ -468,7 +468,7 @@ package body FLTK.Asks is Default : in String := "") return String is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_input + Result : constant Interfaces.C.Strings.chars_ptr := fl_ask_input (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default)); begin @@ -493,7 +493,7 @@ package body FLTK.Asks is Default : in String := "") return String is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_password + Result : constant Interfaces.C.Strings.chars_ptr := fl_ask_password (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default)); begin @@ -520,8 +520,8 @@ package body FLTK.Asks is C_R : Interfaces.C.double := Interfaces.C.double (R); C_G : Interfaces.C.double := Interfaces.C.double (G); C_B : Interfaces.C.double := Interfaces.C.double (B); - M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); - Result : Interfaces.C.int := fl_ask_color_chooser + M : constant Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); + Result : constant Interfaces.C.int := fl_ask_color_chooser (Interfaces.C.To_C (Title), C_R, C_G, C_B, M); begin if Result = 1 then @@ -550,8 +550,8 @@ package body FLTK.Asks is C_R : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (R); C_G : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (G); C_B : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (B); - M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); - Result : Interfaces.C.int := fl_ask_color_chooser2 + M : constant Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); + Result : constant Interfaces.C.int := fl_ask_color_chooser2 (Interfaces.C.To_C (Title), C_R, C_G, C_B, M); begin if Result = 1 then @@ -583,7 +583,7 @@ package body FLTK.Asks is Relative : in Boolean := False) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_dir_chooser + Result : constant Interfaces.C.Strings.chars_ptr := fl_ask_dir_chooser (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default), Boolean'Pos (Relative)); @@ -602,7 +602,7 @@ package body FLTK.Asks is Relative : in Boolean := False) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_file_chooser + Result : constant Interfaces.C.Strings.chars_ptr := fl_ask_file_chooser (Interfaces.C.To_C (Message), Interfaces.C.To_C (Filter_Pattern), Interfaces.C.To_C (Default), diff --git a/body/fltk-devices-surface-paged-postscript.adb b/body/fltk-devices-surface-paged-postscript.adb index 76553b1..07284bb 100644 --- a/body/fltk-devices-surface-paged-postscript.adb +++ b/body/fltk-devices-surface-paged-postscript.adb @@ -7,7 +7,7 @@ with Ada.Assertions, - Interfaces.C.Strings; + Interfaces.C; use type @@ -75,11 +75,12 @@ package body FLTK.Devices.Surface.Paged.Postscript is -- Driver -- - function fl_postscript_file_device_get_driver - (D : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_postscript_file_device_get_driver, "fl_postscript_file_device_get_driver"); - pragma Inline (fl_postscript_file_device_get_driver); + -- function fl_postscript_file_device_get_driver + -- (D : in Storage.Integer_Address) + -- return Storage.Integer_Address; + -- pragma Import (C, fl_postscript_file_device_get_driver, + -- "fl_postscript_file_device_get_driver"); + -- pragma Inline (fl_postscript_file_device_get_driver); @@ -362,7 +363,7 @@ package body FLTK.Devices.Surface.Paged.Postscript is Format : in Page_Format := A4; Layout : in Page_Layout := Portrait) is - Code : Interfaces.C.int := fl_postscript_file_device_start_job3 + Code : constant Interfaces.C.int := fl_postscript_file_device_start_job3 (This.Void_Ptr, Output.C_File, Interfaces.C.int (Count), @@ -383,7 +384,7 @@ package body FLTK.Devices.Surface.Paged.Postscript is Format : in Page_Format := A4; Layout : in Page_Layout := Portrait) is - Code : Interfaces.C.int := fl_postscript_file_device_start_job4 + Code : constant Interfaces.C.int := fl_postscript_file_device_start_job4 (This.Void_Ptr, Interfaces.C.int (Count), To_Cint (Format), diff --git a/body/fltk-devices-surface-paged-printers.adb b/body/fltk-devices-surface-paged-printers.adb index e460eb1..8ee0660 100644 --- a/body/fltk-devices-surface-paged-printers.adb +++ b/body/fltk-devices-surface-paged-printers.adb @@ -6,7 +6,7 @@ with - Interfaces.C.Strings; + Interfaces.C; use type diff --git a/body/fltk-devices-surface-paged.adb b/body/fltk-devices-surface-paged.adb index 950d3ce..fbc8dc6 100644 --- a/body/fltk-devices-surface-paged.adb +++ b/body/fltk-devices-surface-paged.adb @@ -7,7 +7,6 @@ with Ada.Assertions, - Ada.Strings.Unbounded, Interfaces.C.Strings; use type diff --git a/body/fltk-draw.adb b/body/fltk-draw.adb index e7119ed..c99d5cd 100644 --- a/body/fltk-draw.adb +++ b/body/fltk-draw.adb @@ -14,8 +14,7 @@ with use type - Interfaces.C.int, - Interfaces.C.size_t; + Interfaces.C.int; package body FLTK.Draw is @@ -642,7 +641,7 @@ package body FLTK.Draw is function Can_Do_Alpha_Blending return Boolean is - Result : Interfaces.C.int := fl_draw_can_do_alpha_blending; + Result : constant Interfaces.C.int := fl_draw_can_do_alpha_blending; begin if Result = 1 then return True; @@ -662,7 +661,7 @@ package body FLTK.Draw is return String is begin return Interfaces.C.Strings.Value - (fl_draw_shortcut_label (Interfaces.C.unsigned (To_C (Keys)))); + (fl_draw_shortcut_label (To_C (Keys))); end Shortcut_Label; @@ -716,7 +715,7 @@ package body FLTK.Draw is return Boolean is CX, CY, CW, CH : Interfaces.C.int; - Result : Interfaces.C.int := fl_draw_clip_box + Result : constant Interfaces.C.int := fl_draw_clip_box (Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1038,14 +1037,13 @@ package body FLTK.Draw is Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address); - pragma Convention (C, Draw_Image_Hook); procedure Draw_Image_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address) is @@ -1108,14 +1106,13 @@ package body FLTK.Draw is Mono_Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Mono_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address); - pragma Convention (C, Draw_Image_Mono_Hook); procedure Draw_Image_Mono_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address) is @@ -1152,7 +1149,7 @@ package body FLTK.Draw is is C_Data : Pixmap_Marshal.chars_ptr_array_access := Pixmap_Marshal.Marshal_Data (Values, Colors, Pixels); - Result : Interfaces.C.int := fl_draw_draw_pixmap + Result : constant Interfaces.C.int := fl_draw_draw_pixmap (Storage.To_Integer (C_Data (C_Data'First)'Address), Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1172,7 +1169,7 @@ package body FLTK.Draw is Alpha : in Integer := 0) return Color_Component_Array is - My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4); + My_Len : constant Integer := (if Alpha = 0 then W * H * 3 else W * H * 4); Result : Color_Component_Array (1 .. My_Len); Buffer : Storage.Integer_Address; begin @@ -1201,7 +1198,7 @@ package body FLTK.Draw is Callback : in Symbol_Draw_Function; Scalable : in Boolean) is - Ret_Val : Interfaces.C.int := fl_draw_add_symbol + Ret_Val : constant Interfaces.C.int := fl_draw_add_symbol (Interfaces.C.To_C (Text), Storage.To_Integer (Callback.all'Address), Boolean'Pos (Scalable)); @@ -1374,7 +1371,7 @@ package body FLTK.Draw is Name : in String; Hue : in Color) is - Ret_Val : Interfaces.C.int := fl_draw_draw_symbol + Ret_Val : constant Interfaces.C.int := fl_draw_draw_symbol (Interfaces.C.To_C (Name), Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1479,7 +1476,7 @@ package body FLTK.Draw is Buffer : Interfaces.C.Strings.chars_ptr; Length : Interfaces.C.int; Temp : Interfaces.C.char_array := Interfaces.C.To_C (Text); - Result : Char_Pointers.Pointer := fl_draw_expand_text + Result : constant Char_Pointers.Pointer := fl_draw_expand_text (Temp, Buffer, 0, Interfaces.C.double (Max_Width), Length, diff --git a/body/fltk-environment.adb b/body/fltk-environment.adb index f09795f..c510e26 100644 --- a/body/fltk-environment.adb +++ b/body/fltk-environment.adb @@ -125,9 +125,9 @@ package body FLTK.Environment is pragma Inline (fl_preferences_flush); function fl_preferences_getuserdatapath - (E : in Storage.Integer_Address; - P : in Interfaces.C.char_array; - L : in Interfaces.C.int) + (E : in Storage.Integer_Address; + P : out Interfaces.C.char_array; + L : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_preferences_getuserdatapath, "fl_preferences_getuserdatapath"); pragma Inline (fl_preferences_getuserdatapath); @@ -285,11 +285,11 @@ package body FLTK.Environment is pragma Inline (fl_preferences_get_str); function fl_preferences_get_str_limit - (E : in Storage.Integer_Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.char_array; - D : in Interfaces.C.char_array; - M : in Interfaces.C.int) + (E : in Storage.Integer_Address; + K : in Interfaces.C.char_array; + V : out Interfaces.C.char_array; + D : in Interfaces.C.char_array; + M : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_preferences_get_str_limit, "fl_preferences_get_str_limit"); pragma Inline (fl_preferences_get_str_limit); @@ -552,7 +552,7 @@ package body FLTK.Environment is function New_UUID return String is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_new_uuid; + Text : constant Interfaces.C.Strings.chars_ptr := fl_preferences_new_uuid; begin return Interfaces.C.Strings.Value (Text); end New_UUID; @@ -655,7 +655,7 @@ package body FLTK.Environment is Index : in Positive) return String is - Key : Interfaces.C.Strings.chars_ptr := + Key : constant Interfaces.C.Strings.chars_ptr := fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index) - 1); begin -- no need for dealloc? @@ -702,7 +702,7 @@ package body FLTK.Environment is Index : in Positive) return String is - Name : Interfaces.C.Strings.chars_ptr := + Name : constant Interfaces.C.Strings.chars_ptr := fl_preferences_group (This.Void_Ptr, Interfaces.C.int (Index) - 1); begin -- no need for dealloc? @@ -731,7 +731,7 @@ package body FLTK.Environment is (This : in Pref_Group) return String is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_name (This.Void_Ptr); + Text : constant Interfaces.C.Strings.chars_ptr := fl_preferences_name (This.Void_Ptr); begin if Text = Interfaces.C.Strings.Null_Ptr then return ""; @@ -745,7 +745,7 @@ package body FLTK.Environment is (This : in Pref_Group) return String is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_path (This.Void_Ptr); + Text : constant Interfaces.C.Strings.chars_ptr := fl_preferences_path (This.Void_Ptr); begin if Text = Interfaces.C.Strings.Null_Ptr then return ""; @@ -783,9 +783,9 @@ package body FLTK.Environment is Default : in Integer) return Integer is - Value, X : Interfaces.C.int; + Value, Ignore : Interfaces.C.int; begin - X := fl_preferences_get_int + Ignore := fl_preferences_get_int (This.Void_Ptr, Interfaces.C.To_C (Key), Value, @@ -819,9 +819,9 @@ package body FLTK.Environment is return Float is Value : Interfaces.C.C_float; - X : Interfaces.C.int; + Ignore : Interfaces.C.int; begin - X := fl_preferences_get_float + Ignore := fl_preferences_get_float (This.Void_Ptr, Interfaces.C.To_C (Key), Value, @@ -855,9 +855,9 @@ package body FLTK.Environment is return Long_Float is Value : Interfaces.C.double; - X : Interfaces.C.int; + Ignore : Interfaces.C.int; begin - X := fl_preferences_get_double + Ignore := fl_preferences_get_double (This.Void_Ptr, Interfaces.C.To_C (Key), Value, @@ -872,7 +872,7 @@ package body FLTK.Environment is return String is Text : Interfaces.C.Strings.chars_ptr; - Check : Interfaces.C.int := fl_preferences_get_str + Check : constant Interfaces.C.int := fl_preferences_get_str (This.Void_Ptr, Interfaces.C.To_C (Key), Text, @@ -884,7 +884,7 @@ package body FLTK.Environment is if Text = Interfaces.C.Strings.Null_Ptr then return ""; end if; - return Str : String := Interfaces.C.Strings.Value (Text) do + return Str : constant String := Interfaces.C.Strings.Value (Text) do Interfaces.C.Strings.Free (Text); end return; end Get; @@ -897,7 +897,7 @@ package body FLTK.Environment is return String is Text : Interfaces.C.Strings.chars_ptr; - X : Interfaces.C.int := fl_preferences_get_str + Ignore : Interfaces.C.int := fl_preferences_get_str (This.Void_Ptr, Interfaces.C.To_C (Key), Text, @@ -906,7 +906,7 @@ package body FLTK.Environment is if Text = Interfaces.C.Strings.Null_Ptr then return Default; end if; - return Str : String := Interfaces.C.Strings.Value (Text) do + return Str : constant String := Interfaces.C.Strings.Value (Text) do Interfaces.C.Strings.Free (Text); end return; end Get; @@ -920,7 +920,7 @@ package body FLTK.Environment is return String is Text : Interfaces.C.char_array := (1 .. Interfaces.C.size_t (Max_Length + 1) => ' '); - Check : Interfaces.C.int := fl_preferences_get_str_limit + Check : constant Interfaces.C.int := fl_preferences_get_str_limit (This.Void_Ptr, Interfaces.C.To_C (Key), Text, @@ -942,7 +942,7 @@ package body FLTK.Environment is is Thing : Storage.Integer_Address; Dummy : Interfaces.C.int := 42; - Check : Interfaces.C.int := fl_preferences_get_void + Check : constant Interfaces.C.int := fl_preferences_get_void (This.Void_Ptr, Interfaces.C.To_C (Key), Thing, @@ -954,12 +954,12 @@ package body FLTK.Environment is raise Preference_Error; end if; declare - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); + Length : constant Natural := This.Value_Size (Key) * Natural (c_pointer_size); Actual : Binary_Data (1 .. Length); for Actual'Address use Storage.To_Address (Thing); pragma Import (Ada, Actual); begin - return Result : Binary_Data := Actual do + return Result : constant Binary_Data := Actual do free_fl_preferences_void_data (Thing); end return; end; @@ -979,12 +979,12 @@ package body FLTK.Environment is Thing, Storage.To_Integer (Default'Address), Default'Length / Interfaces.C.int (c_pointer_size)); - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); + Length : constant Natural := This.Value_Size (Key) * Natural (c_pointer_size); Actual : Binary_Data (1 .. Length); for Actual'Address use Storage.To_Address (Thing); pragma Import (Ada, Actual); begin - return Result : Binary_Data := Actual do + return Result : constant Binary_Data := Actual do free_fl_preferences_void_data (Thing); end return; end Get; @@ -1005,7 +1005,7 @@ package body FLTK.Environment is Storage.To_Integer (Default'Address), Default'Length / Interfaces.C.int (c_pointer_size), Interfaces.C.int (Max_Length) / Interfaces.C.int (c_pointer_size)); - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); + Length : constant Natural := This.Value_Size (Key) * Natural (c_pointer_size); begin return Actual (1 .. Length); end Get; diff --git a/body/fltk-events.adb b/body/fltk-events.adb index 8488785..7a5932f 100644 --- a/body/fltk-events.adb +++ b/body/fltk-events.adb @@ -560,7 +560,7 @@ package body FLTK.Events is Origin : in out FLTK.Widgets.Groups.Windows.Window'Class) return Event_Outcome is - Result : Interfaces.C.int := fl_event_handle_dispatch + Result : constant Interfaces.C.int := fl_event_handle_dispatch (Event_Kind'Pos (Event), Wrapper (Origin).Void_Ptr); begin @@ -576,7 +576,7 @@ package body FLTK.Events is Origin : in out FLTK.Widgets.Groups.Windows.Window'Class) return Event_Outcome is - Result : Interfaces.C.int := fl_event_handle + Result : constant Interfaces.C.int := fl_event_handle (Event_Kind'Pos (Event), Wrapper (Origin).Void_Ptr); begin @@ -718,7 +718,7 @@ package body FLTK.Events is function Clipboard_Text return String is - Text_Ptr : Interfaces.C.Strings.chars_ptr := fl_event_clipboard_text; + Text_Ptr : constant Interfaces.C.Strings.chars_ptr := fl_event_clipboard_text; begin if Text_Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -731,7 +731,7 @@ package body FLTK.Events is function Clipboard_Kind return String is - Text_Ptr : Interfaces.C.Strings.chars_ptr := fl_event_clipboard_type; + Text_Ptr : constant Interfaces.C.Strings.chars_ptr := fl_event_clipboard_type; begin if Text_Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -756,7 +756,7 @@ package body FLTK.Events is function Text return String is - Str : Interfaces.C.Strings.chars_ptr := fl_event_text; + Str : constant Interfaces.C.Strings.chars_ptr := fl_event_text; begin if Str = Interfaces.C.Strings.Null_Ptr then return ""; @@ -788,7 +788,7 @@ package body FLTK.Events is function Last return Event_Kind is - Value : Interfaces.C.int := fl_event_get; + Value : constant Interfaces.C.int := fl_event_get; begin return Event_Kind'Val (Value); exception @@ -889,7 +889,7 @@ package body FLTK.Events is function Get_Clicks return Natural is - Raw : Interfaces.C.int := fl_event_get_clicks; + Raw : constant Interfaces.C.int := fl_event_get_clicks; begin if Is_Click then return Positive (Raw + 1); @@ -920,7 +920,7 @@ package body FLTK.Events is function Last_Button return Mouse_Button is - Code : Interfaces.C.int := fl_event_button; + Code : constant Interfaces.C.int := fl_event_button; begin pragma Assert (Last = Push or Last = Release); if Code = fl_enum_left_mouse then @@ -982,7 +982,7 @@ package body FLTK.Events is (Left, Middle, Right, Back, Forward : out Boolean) is type Cint_Mod is mod 2 ** Interfaces.C.int'Size; - Mask : Interfaces.C.int := fl_event_buttons; + Mask : constant Interfaces.C.int := fl_event_buttons; begin Left := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button1)) /= 0; Middle := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button2)) /= 0; diff --git a/body/fltk-file_choosers.adb b/body/fltk-file_choosers.adb index a1ef4f7..a5eac34 100644 --- a/body/fltk-file_choosers.adb +++ b/body/fltk-file_choosers.adb @@ -39,16 +39,16 @@ package body FLTK.File_Choosers is pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); pragma Inline (fl_widget_get_user_data); - procedure fl_widget_set_user_data - (W, D : in Storage.Integer_Address); - pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); - pragma Inline (fl_widget_set_user_data); + -- procedure fl_widget_set_user_data + -- (W, D : in Storage.Integer_Address); + -- pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); + -- pragma Inline (fl_widget_set_user_data); - function fl_file_chooser_get_user_data - (F : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_get_user_data, "fl_file_chooser_get_user_data"); - pragma Inline (fl_file_chooser_get_user_data); + -- function fl_file_chooser_get_user_data + -- (F : in Storage.Integer_Address) + -- return Storage.Integer_Address; + -- pragma Import (C, fl_file_chooser_get_user_data, "fl_file_chooser_get_user_data"); + -- pragma Inline (fl_file_chooser_get_user_data); procedure fl_file_chooser_set_user_data (F, U : in Storage.Integer_Address); @@ -514,14 +514,13 @@ package body FLTK.File_Choosers is procedure File_Chooser_Callback_Hook - (C_Addr, User_Data : in Storage.Integer_Address); - + (Ignore, User_Data : in Storage.Integer_Address); pragma Convention (C, File_Chooser_Callback_Hook); procedure File_Chooser_Callback_Hook - (C_Addr, User_Data : in Storage.Integer_Address) + (Ignore, User_Data : in Storage.Integer_Address) is - Ada_Obj : access File_Chooser'Class := + Ada_Obj : constant access File_Chooser'Class := File_Chooser_Convert.To_Pointer (Storage.To_Address (User_Data)); begin if Ada_Obj.My_Callback /= null then @@ -960,18 +959,19 @@ package body FLTK.File_Choosers is (This : in out File_Chooser; Item : in out Widgets.Widget'Class) is - C_Addr : Storage.Integer_Address; + Ignore : Storage.Integer_Address := + fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr); begin - C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr); + null; end Add_Extra; procedure Remove_Extra (This : in out File_Chooser) is - C_Addr : Storage.Integer_Address; + Ignore : Storage.Integer_Address := fl_file_chooser_add_extra (This.Void_Ptr, Null_Pointer); begin - C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Null_Pointer); + null; end Remove_Extra; @@ -1080,7 +1080,7 @@ package body FLTK.File_Choosers is (This : in File_Chooser) return Boolean is - Ret : Interfaces.C.int := fl_file_chooser_get_preview (This.Void_Ptr); + Ret : constant Interfaces.C.int := fl_file_chooser_get_preview (This.Void_Ptr); begin pragma Assert (Ret in 0 .. 1); return Boolean'Val (Ret); @@ -1151,7 +1151,7 @@ package body FLTK.File_Choosers is (This : in File_Chooser) return Chooser_Kind is - Ret : Interfaces.C.int := fl_file_chooser_get_type (This.Void_Ptr); + Ret : constant Interfaces.C.int := fl_file_chooser_get_type (This.Void_Ptr); begin pragma Assert (Ret in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last)); return Chooser_Kind'Val (Ret); @@ -1186,7 +1186,8 @@ package body FLTK.File_Choosers is (This : in File_Chooser) return String is - C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_directory (This.Void_Ptr); + C_Ptr : constant Interfaces.C.Strings.chars_ptr := + fl_file_chooser_get_directory (This.Void_Ptr); begin if C_Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1217,7 +1218,8 @@ package body FLTK.File_Choosers is (This : in File_Chooser) return String is - C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_filter (This.Void_Ptr); + C_Ptr : constant Interfaces.C.Strings.chars_ptr := + fl_file_chooser_get_filter (This.Void_Ptr); begin if C_Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1279,7 +1281,7 @@ package body FLTK.File_Choosers is Index : in Positive := 1) return String is - C_Ptr : Interfaces.C.Strings.chars_ptr := + C_Ptr : constant Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_value (This.Void_Ptr, Interfaces.C.int (Index)); begin if C_Ptr = Interfaces.C.Strings.Null_Ptr then diff --git a/body/fltk-filenames.adb b/body/fltk-filenames.adb index 0612810..9e41b7d 100644 --- a/body/fltk-filenames.adb +++ b/body/fltk-filenames.adb @@ -63,17 +63,17 @@ package body FLTK.Filenames is pragma Inline (filename_decode_uri); function filename_absolute - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) + (To : out Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, filename_absolute, "filename_absolute"); pragma Inline (filename_absolute); function filename_expand - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) + (To : out Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, filename_expand, "filename_expand"); pragma Inline (filename_expand); @@ -111,9 +111,9 @@ package body FLTK.Filenames is pragma Inline (filename_name); function filename_relative - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) + (To : out Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, filename_relative, "filename_relative"); pragma Inline (filename_relative); @@ -127,8 +127,9 @@ package body FLTK.Filenames is pragma Inline (filename_setext); function filename_open_uri - (U, M : in Interfaces.C.char_array; - Len : in Interfaces.C.int) + (U : in Interfaces.C.char_array; + M : out Interfaces.C.char_array; + Len : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, filename_open_uri, "filename_open_uri"); pragma Inline (filename_open_uri); @@ -171,7 +172,7 @@ package body FLTK.Filenames is (A, B : in String) return Comparison is - Result : Interfaces.C.int := + Result : constant Interfaces.C.int := filename_alphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin pragma Assert @@ -188,7 +189,7 @@ package body FLTK.Filenames is (A, B : in String) return Comparison is - Result : Interfaces.C.int := + Result : constant Interfaces.C.int := filename_casealphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin pragma Assert @@ -205,7 +206,7 @@ package body FLTK.Filenames is (A, B : in String) return Comparison is - Result : Interfaces.C.int := + Result : constant Interfaces.C.int := filename_numericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin pragma Assert @@ -222,7 +223,7 @@ package body FLTK.Filenames is (A, B : in String) return Comparison is - Result : Interfaces.C.int := + Result : constant Interfaces.C.int := filename_casenumericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin pragma Assert @@ -279,7 +280,7 @@ package body FLTK.Filenames is (URI : in Path_String) return Path_String is - C_Ptr : Interfaces.C.char_array := Interfaces.C.To_C (URI); + C_Ptr : constant Interfaces.C.char_array := Interfaces.C.To_C (URI); begin filename_decode_uri (C_Ptr); return Interfaces.C.To_Ada (C_Ptr); @@ -291,7 +292,7 @@ package body FLTK.Filenames is is Message : Interfaces.C.char_array (1 .. Interfaces.C.size_t (error_bsize)) := (others => Interfaces.C.char'Val (0)); - Result : Interfaces.C.int := filename_open_uri + Result : constant Interfaces.C.int := filename_open_uri (Interfaces.C.To_C (URI), Message, error_bsize); @@ -317,7 +318,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_absolute + Ignore : constant Interfaces.C.int := filename_absolute (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -333,7 +334,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_absolute + Code : constant Interfaces.C.int := filename_absolute (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -349,7 +350,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_relative + Ignore : constant Interfaces.C.int := filename_relative (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -365,7 +366,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_relative + Code : constant Interfaces.C.int := filename_relative (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -381,7 +382,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_expand + Ignore : constant Interfaces.C.int := filename_expand (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -397,7 +398,7 @@ package body FLTK.Filenames is is Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_expand + Code : constant Interfaces.C.int := filename_expand (Result, Interfaces.C.int (Max_Path_Length), Interfaces.C.To_C (Name)); @@ -415,7 +416,7 @@ package body FLTK.Filenames is (Name : in Path_String) return Path_String is - Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); + Data : constant Interfaces.C.char_array := Interfaces.C.To_C (Name); begin return Interfaces.C.Strings.Value (filename_name (Data)); end Base_Name; @@ -425,8 +426,8 @@ package body FLTK.Filenames is (Name : in Path_String) return Path_String is - Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); - Result : Interfaces.C.Strings.chars_ptr := filename_ext (Data); + Data : constant Interfaces.C.char_array := Interfaces.C.To_C (Name); + Result : constant Interfaces.C.Strings.chars_ptr := filename_ext (Data); begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -478,7 +479,7 @@ package body FLTK.Filenames is (DA, DB : in Storage.Integer_Address) return Interfaces.C.int is - Result : Comparison := Current_Sort + Result : constant Comparison := Current_Sort (Interfaces.C.Strings.Value (filename_dname (DA, 0)), Interfaces.C.Strings.Value (filename_dname (DB, 0))); begin diff --git a/body/fltk-help_dialogs.adb b/body/fltk-help_dialogs.adb index 6348527..d316662 100644 --- a/body/fltk-help_dialogs.adb +++ b/body/fltk-help_dialogs.adb @@ -282,7 +282,8 @@ package body FLTK.Help_Dialogs is (This : in Help_Dialog) return String is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_dialog_get_value (This.Void_Ptr); + Raw_Chars : constant Interfaces.C.Strings.chars_ptr := + fl_help_dialog_get_value (This.Void_Ptr); use type Interfaces.C.Strings.chars_ptr; begin if Raw_Chars = Interfaces.C.Strings.Null_Ptr then diff --git a/body/fltk-images-pixmaps.adb b/body/fltk-images-pixmaps.adb index 80d6c03..8487459 100644 --- a/body/fltk-images-pixmaps.adb +++ b/body/fltk-images-pixmaps.adb @@ -6,8 +6,7 @@ with - FLTK.Pixmap_Marshal, - Interfaces.C.Strings; + FLTK.Pixmap_Marshal; package body FLTK.Images.Pixmaps is diff --git a/body/fltk-images-rgb.adb b/body/fltk-images-rgb.adb index f3dff61..ce512cd 100644 --- a/body/fltk-images-rgb.adb +++ b/body/fltk-images-rgb.adb @@ -275,7 +275,7 @@ package body FLTK.Images.RGB is (This : in RGB_Image) return Natural is - Per_Line : Natural := This.Get_Line_Size; + Per_Line : constant Natural := This.Get_Line_Size; begin if Per_Line = 0 then return This.Get_W * This.Get_D * This.Get_H; diff --git a/body/fltk-images-shared.adb b/body/fltk-images-shared.adb index e932a09..b8de511 100644 --- a/body/fltk-images-shared.adb +++ b/body/fltk-images-shared.adb @@ -287,7 +287,7 @@ package body FLTK.Images.Shared is (This : in Shared_Image) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/body/fltk-images.adb b/body/fltk-images.adb index 3ce3bee..3d5dce7 100644 --- a/body/fltk-images.adb +++ b/body/fltk-images.adb @@ -6,7 +6,7 @@ with - Interfaces.C.Strings; + Interfaces.C; use type @@ -181,7 +181,7 @@ package body FLTK.Images is procedure Raise_Fail_Errors (This : in Image'Class) is - Result : Interfaces.C.int := fl_image_fail (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_image_fail (This.Void_Ptr); begin if Result = fl_image_err_no_image and This.Is_Empty then raise No_Image_Error; diff --git a/body/fltk-labels.adb b/body/fltk-labels.adb index b105675..1cbf6fc 100644 --- a/body/fltk-labels.adb +++ b/body/fltk-labels.adb @@ -212,7 +212,7 @@ package body FLTK.Labels is (This : in Label) return String is - Text : Interfaces.C.Strings.chars_ptr := fl_label_get_value (This.Void_Ptr); + Text : constant Interfaces.C.Strings.chars_ptr := fl_label_get_value (This.Void_Ptr); begin if Text = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/body/fltk-menu_items.adb b/body/fltk-menu_items.adb index dfb579a..d75dd4a 100644 --- a/body/fltk-menu_items.adb +++ b/body/fltk-menu_items.adb @@ -419,7 +419,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -466,7 +466,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Font_Kind is - Result : Interfaces.C.int := fl_menu_item_get_labelfont (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labelfont (This.Void_Ptr); begin return Font_Kind'Val (Result); exception @@ -488,7 +488,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Font_Size is - Result : Interfaces.C.int := fl_menu_item_get_labelsize (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labelsize (This.Void_Ptr); begin return Font_Size (Result); exception @@ -510,7 +510,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Label_Kind is - Result : Interfaces.C.int := fl_menu_item_get_labeltype (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labeltype (This.Void_Ptr); begin return Label_Kind'Val (Result); exception diff --git a/body/fltk-pixmap_marshal.adb b/body/fltk-pixmap_marshal.adb index 768cd08..966e29b 100644 --- a/body/fltk-pixmap_marshal.adb +++ b/body/fltk-pixmap_marshal.adb @@ -9,8 +9,7 @@ with Ada.Strings.Fixed, Ada.Strings.Unbounded, Ada.Unchecked_Deallocation, - FLTK.Images.Pixmaps, - Interfaces.C.Strings; + FLTK.Images.Pixmaps; package body FLTK.Pixmap_Marshal is @@ -45,7 +44,7 @@ package body FLTK.Pixmap_Marshal is Pixels : in Pix.Pixmap_Data) return chars_ptr_array_access is - C_Data : chars_ptr_array_access := new CS.chars_ptr_array + C_Data : constant chars_ptr_array_access := new CS.chars_ptr_array (1 .. C.size_t (1 + Colors'Length + Pixels'Length (1))); begin -- Header values line diff --git a/body/fltk-static.adb b/body/fltk-static.adb index 5c2269f..663a7c7 100644 --- a/body/fltk-static.adb +++ b/body/fltk-static.adb @@ -8,7 +8,6 @@ with Ada.Assertions, Ada.Containers.Vectors, - Ada.Unchecked_Conversion, Interfaces.C.Strings, System.Address_To_Access_Conversions, FLTK.Box_Draw_Marshal, @@ -233,16 +232,6 @@ package body FLTK.Static is - -- System Events -- - - procedure fl_static_add_system_handler - (H, F : in Storage.Integer_Address); - pragma Import (C, fl_static_add_system_handler, "fl_static_add_system_handler"); - pragma Inline (fl_static_add_system_handler); - - - - -- Custom Colors -- function fl_static_get_color2 @@ -592,6 +581,7 @@ package body FLTK.Static is is Result : Natural; begin + pragma Assert (I < C and V /= Null_Pointer); Result := Current_Args_Handler (Positive (I)); I := I + Interfaces.C.int (Result); return Interfaces.C.int (Result); @@ -599,6 +589,9 @@ package body FLTK.Static is when Constraint_Error => raise Internal_FLTK_Error with "Args_Handler callback was supplied unexpected int i value of " & Interfaces.C.int'Image (I); + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Args_Handler callback was supplied irregular argc and argv values of " & + Interfaces.C.int'Image (C) & " and " & Storage.Integer_Address'Image (V); end Args_Hook; @@ -761,7 +754,7 @@ package body FLTK.Static is procedure Add_Awake_Handler (Func : in Awake_Handler) is - Result : Interfaces.C.int := fl_static_add_awake_handler + Result : constant Interfaces.C.int := fl_static_add_awake_handler (Storage.To_Integer (Awake_Hook'Address), Conv.To_Address (Func)); begin @@ -783,7 +776,7 @@ package body FLTK.Static is return Awake_Handler is Hook, Func : Storage.Integer_Address; - Result : Interfaces.C.int := fl_static_get_awake_handler (Hook, Func); + Result : constant Interfaces.C.int := fl_static_get_awake_handler (Hook, Func); begin pragma Assert (Result = 0); return Conv.To_Awake_Access (Func); @@ -803,7 +796,7 @@ package body FLTK.Static is procedure Awake (Func : in Awake_Handler) is - Result : Interfaces.C.int := fl_static_awake2 + Result : constant Interfaces.C.int := fl_static_awake2 (Storage.To_Integer (Awake_Hook'Address), Conv.To_Address (Func)); begin @@ -1158,7 +1151,7 @@ package body FLTK.Static is procedure Setup_Fonts (How_Many_Set_Up : out Natural) is - Result : Interfaces.C.int := fl_static_set_fonts; + Result : constant Interfaces.C.int := fl_static_set_fonts; begin How_Many_Set_Up := Natural (Result); exception @@ -1444,7 +1437,7 @@ package body FLTK.Static is function Get_Scheme return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_static_get_scheme; + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_static_get_scheme; begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1466,7 +1459,7 @@ package body FLTK.Static is (Scheme : in String) return Boolean is - Result : Interfaces.C.int := fl_static_is_scheme (Interfaces.C.To_C (Scheme)); + Result : constant Interfaces.C.int := fl_static_is_scheme (Interfaces.C.To_C (Scheme)); begin return Boolean'Val (Result); exception @@ -1503,7 +1496,7 @@ package body FLTK.Static is function Get_Default_Scrollbar_Size return Natural is - Result : Interfaces.C.int := fl_static_get_scrollbar_size; + Result : constant Interfaces.C.int := fl_static_get_scrollbar_size; begin return Natural (Result); exception diff --git a/body/fltk-text_buffers.adb b/body/fltk-text_buffers.adb index f113e22..a870ece 100644 --- a/body/fltk-text_buffers.adb +++ b/body/fltk-text_buffers.adb @@ -498,11 +498,11 @@ package body FLTK.Text_Buffers is UD : in Storage.Integer_Address) is Action : Modification; - Place : Position := Position (Pos); + Place : constant Position := Position (Pos); Length : Natural; Deleted_Text : Unbounded_String := To_Unbounded_String (""); - Ada_Text_Buffer : access Text_Buffer := + Ada_Text_Buffer : constant access Text_Buffer := Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); begin if Ada_Text_Buffer.CB_Active then @@ -534,10 +534,10 @@ package body FLTK.Text_Buffers is (Pos, Deleted : in Interfaces.C.int; UD : in Storage.Integer_Address) is - Place : Position := Position (Pos); - Length : Natural := Natural (Deleted); + Place : constant Position := Position (Pos); + Length : constant Natural := Natural (Deleted); - Ada_Text_Buffer : access Text_Buffer := + Ada_Text_Buffer : constant access Text_Buffer := Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); begin if Ada_Text_Buffer.CB_Active then @@ -682,10 +682,10 @@ package body FLTK.Text_Buffers is Name : in String; Buffer : in Natural := 128 * 1024) is - Err_No : Interfaces.C.int := fl_text_buffer_loadfile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Buffer)); + Err_No : constant Interfaces.C.int := fl_text_buffer_loadfile + (This.Void_Ptr, + Interfaces.C.To_C (Name), + Interfaces.C.int (Buffer)); begin if Err_No /= 0 then raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); @@ -698,7 +698,7 @@ package body FLTK.Text_Buffers is Name : in String; Buffer : in Natural := 128 * 1024) is - Err_No : Interfaces.C.int := fl_text_buffer_appendfile + Err_No : constant Interfaces.C.int := fl_text_buffer_appendfile (This.Void_Ptr, Interfaces.C.To_C (Name), Interfaces.C.int (Buffer)); @@ -715,7 +715,7 @@ package body FLTK.Text_Buffers is Place : in Position; Buffer : in Natural := 128 * 1024) is - Err_No : Interfaces.C.int := fl_text_buffer_insertfile + Err_No : constant Interfaces.C.int := fl_text_buffer_insertfile (This.Void_Ptr, Interfaces.C.To_C (Name), Interfaces.C.int (Place), @@ -733,7 +733,7 @@ package body FLTK.Text_Buffers is Start, Finish : in Position; Buffer : in Natural := 128 * 1024) is - Err_No : Interfaces.C.int := fl_text_buffer_outputfile + Err_No : constant Interfaces.C.int := fl_text_buffer_outputfile (This.Void_Ptr, Interfaces.C.To_C (Name), Interfaces.C.int (Start), @@ -751,10 +751,10 @@ package body FLTK.Text_Buffers is Name : in String; Buffer : in Natural := 128 * 1024) is - Err_No : Interfaces.C.int := fl_text_buffer_savefile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Buffer)); + Err_No : constant Interfaces.C.int := fl_text_buffer_savefile + (This.Void_Ptr, + Interfaces.C.To_C (Name), + Interfaces.C.int (Buffer)); begin if Err_No /= 0 then raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); @@ -772,9 +772,9 @@ package body FLTK.Text_Buffers is Text : in String) is begin fl_text_buffer_insert - (This.Void_Ptr, - Interfaces.C.int (Place), - Interfaces.C.To_C (Text)); + (This.Void_Ptr, + Interfaces.C.int (Place), + Interfaces.C.To_C (Text)); end Insert_Text; @@ -806,9 +806,9 @@ package body FLTK.Text_Buffers is Start, Finish : in Position) is begin fl_text_buffer_remove - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); end Remove_Text; @@ -823,7 +823,7 @@ package body FLTK.Text_Buffers is return ""; else declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); + Ada_String : constant String := Interfaces.C.Strings.Value (Raw); begin Interfaces.C.Strings.Free (Raw); return Ada_String; @@ -856,8 +856,8 @@ package body FLTK.Text_Buffers is return Character is begin return Character'Val (fl_text_buffer_char_at - (This.Void_Ptr, - Interfaces.C.int (Place))); + (This.Void_Ptr, + Interfaces.C.int (Place))); end Character_At; @@ -867,15 +867,15 @@ package body FLTK.Text_Buffers is return String is C_Str : Interfaces.C.Strings.chars_ptr := fl_text_buffer_text_range - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); begin if C_Str = Interfaces.C.Strings.Null_Ptr then return ""; else declare - The_Text : String := Interfaces.C.Strings.Value (C_Str); + The_Text : constant String := Interfaces.C.Strings.Value (C_Str); begin Interfaces.C.Strings.Free (C_Str); return The_Text; @@ -1001,9 +1001,9 @@ package body FLTK.Text_Buffers is Start, Finish : in Position) is begin fl_text_buffer_select - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); end Set_Selection; @@ -1045,7 +1045,7 @@ package body FLTK.Text_Buffers is return ""; else declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); + Ada_String : constant String := Interfaces.C.Strings.Value (Raw); begin Interfaces.C.Strings.Free (Raw); return Ada_String; @@ -1065,7 +1065,7 @@ package body FLTK.Text_Buffers is return ""; else declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); + Ada_String : constant String := Interfaces.C.Strings.Value (Raw); begin Interfaces.C.Strings.Free (Raw); return Ada_String; @@ -1155,7 +1155,7 @@ package body FLTK.Text_Buffers is return ""; else declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); + Ada_String : constant String := Interfaces.C.Strings.Value (Raw); begin Interfaces.C.Strings.Free (Raw); return Ada_String; @@ -1324,7 +1324,7 @@ package body FLTK.Text_Buffers is return ""; else declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); + Ada_String : constant String := Interfaces.C.Strings.Value (Raw); begin Interfaces.C.Strings.Free (Raw); return Ada_String; diff --git a/body/fltk-widgets-clocks-updated-round.adb b/body/fltk-widgets-clocks-updated-round.adb index 0b7590b..a91584e 100644 --- a/body/fltk-widgets-clocks-updated-round.adb +++ b/body/fltk-widgets-clocks-updated-round.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Clocks.Updated.Round is diff --git a/body/fltk-widgets-clocks-updated.adb b/body/fltk-widgets-clocks-updated.adb index 035ffda..63337f1 100644 --- a/body/fltk-widgets-clocks-updated.adb +++ b/body/fltk-widgets-clocks-updated.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Clocks.Updated is diff --git a/body/fltk-widgets-clocks.adb b/body/fltk-widgets-clocks.adb index 0d78df0..dc2ee6d 100644 --- a/body/fltk-widgets-clocks.adb +++ b/body/fltk-widgets-clocks.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Clocks is diff --git a/body/fltk-widgets-groups-browsers-check.adb b/body/fltk-widgets-groups-browsers-check.adb index 9890cdf..c519f31 100644 --- a/body/fltk-widgets-groups-browsers-check.adb +++ b/body/fltk-widgets-groups-browsers-check.adb @@ -321,7 +321,7 @@ package body FLTK.Widgets.Groups.Browsers.Check is Text : in String; Checked : in Boolean := False) is - Code : Interfaces.C.int := fl_check_browser_add + Ignore : Interfaces.C.int := fl_check_browser_add (This.Void_Ptr, Interfaces.C.To_C (Text), Boolean'Pos (Checked)); @@ -334,7 +334,7 @@ package body FLTK.Widgets.Groups.Browsers.Check is (This : in out Check_Browser; Index : in Positive) is - Code : Interfaces.C.int := fl_check_browser_remove + Ignore : Interfaces.C.int := fl_check_browser_remove (This.Void_Ptr, Interfaces.C.int (Index)); begin diff --git a/body/fltk-widgets-groups-browsers-textline-file.adb b/body/fltk-widgets-groups-browsers-textline-file.adb index b437bae..d22cfc1 100644 --- a/body/fltk-widgets-groups-browsers-textline-file.adb +++ b/body/fltk-widgets-groups-browsers-textline-file.adb @@ -266,7 +266,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is (DA, DB : in Storage.Integer_Address) return Interfaces.C.int is - Result : FLTK.Filenames.Comparison := Current_Sort + Result : constant FLTK.Filenames.Comparison := Current_Sort (Interfaces.C.Strings.Value (filename_dname (DA, 0)), Interfaces.C.Strings.Value (filename_dname (DB, 0))); begin @@ -411,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; @@ -425,7 +425,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is (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); @@ -448,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 ""; diff --git a/body/fltk-widgets-groups-browsers-textline.adb b/body/fltk-widgets-groups-browsers-textline.adb index c772a10..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 @@ -644,7 +643,8 @@ package body FLTK.Widgets.Groups.Browsers.Textline is 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; @@ -667,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 @@ -828,7 +828,7 @@ package body FLTK.Widgets.Groups.Browsers.Textline is 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)); @@ -846,7 +846,7 @@ 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)); @@ -863,7 +863,7 @@ 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 @@ -909,7 +909,7 @@ 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 @@ -1174,7 +1174,8 @@ 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); diff --git a/body/fltk-widgets-groups-browsers.adb b/body/fltk-widgets-groups-browsers.adb index d60ecca..e65dedc 100644 --- a/body/fltk-widgets-groups-browsers.adb +++ b/body/fltk-widgets-groups-browsers.adb @@ -7,7 +7,7 @@ with Ada.Assertions, - Interfaces.C.Strings, + Interfaces.C, System.Address_To_Access_Conversions; @@ -366,7 +366,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Full_List_Width); @@ -382,7 +382,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Full_List_Height); @@ -398,7 +398,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Average_Item_Height); @@ -414,7 +414,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Item_Quick_Height (Address_To_Cursor (Item_Ptr))); @@ -430,7 +430,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Item_Width (Address_To_Cursor (Item_Ptr))); @@ -446,7 +446,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Interfaces.C.int (Ada_Object.Item_Height (Address_To_Cursor (Item_Ptr))); @@ -462,7 +462,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr : in Storage.Integer_Address) return Storage.Integer_Address is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Cursor_To_Address (Ada_Object.Item_First); @@ -478,7 +478,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr : in Storage.Integer_Address) return Storage.Integer_Address is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Cursor_To_Address (Ada_Object.Item_Last); @@ -494,7 +494,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Storage.Integer_Address is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Cursor_To_Address (Ada_Object.Item_Next (Address_To_Cursor (Item_Ptr))); @@ -510,7 +510,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Storage.Integer_Address is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Cursor_To_Address (Ada_Object.Item_Previous (Address_To_Cursor (Item_Ptr))); @@ -528,7 +528,7 @@ package body FLTK.Widgets.Groups.Browsers is Index : in Interfaces.C.int) return Storage.Integer_Address is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); use type Interfaces.C.int; begin @@ -545,7 +545,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address; Int_State : in Interfaces.C.int) is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); use type Interfaces.C.int; begin @@ -564,7 +564,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Interfaces.C.int is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin return Boolean'Pos (Ada_Object.Item_Selected (Address_To_Cursor (Item_Ptr))); @@ -578,7 +578,7 @@ package body FLTK.Widgets.Groups.Browsers is procedure Item_Swap_Hook (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address) is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin Ada_Object.Item_Swap (Address_To_Cursor (A_Ptr), Address_To_Cursor (B_Ptr)); @@ -606,13 +606,13 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin Interfaces.C.Strings.Free (Ada_Object.Text_Store (Ada_Object.Current)); Ada_Object.Text_Store (Ada_Object.Current) := Interfaces.C.Strings.New_String (Ada_Object.Item_Text (Address_To_Cursor (Item_Ptr))); - return C_Char_Is_Not_A_String : Interfaces.C.Strings.chars_ptr := + return C_Char_Is_Not_A_String : constant Interfaces.C.Strings.chars_ptr := Ada_Object.Text_Store (Ada_Object.Current) do Ada_Object.Current := Ada_Object.Current + 1; @@ -632,7 +632,7 @@ package body FLTK.Widgets.Groups.Browsers is (Ada_Addr, Item_Ptr : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int) is - Ada_Object : access Browser'Class := + Ada_Object : constant access Browser'Class := Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); begin Ada_Object.Item_Draw @@ -803,7 +803,7 @@ package body FLTK.Widgets.Groups.Browsers is Do_Callbacks : in Boolean := False) return Boolean is - Code : Interfaces.C.int := fl_abstract_browser_select + Code : constant Interfaces.C.int := fl_abstract_browser_select (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (State), @@ -823,7 +823,7 @@ package body FLTK.Widgets.Groups.Browsers is State : in Boolean := True; Do_Callbacks : in Boolean := False) is - Code : Interfaces.C.int := fl_abstract_browser_select + Code : constant Interfaces.C.int := fl_abstract_browser_select (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (State), @@ -842,7 +842,7 @@ package body FLTK.Widgets.Groups.Browsers is Do_Callbacks : in Boolean := False) return Boolean is - Code : Interfaces.C.int := fl_abstract_browser_select_only + Code : constant Interfaces.C.int := fl_abstract_browser_select_only (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (Do_Callbacks)); @@ -861,7 +861,7 @@ package body FLTK.Widgets.Groups.Browsers is Item : in Item_Cursor; Do_Callbacks : in Boolean := False) is - Code : Interfaces.C.int := fl_abstract_browser_select_only + Code : constant Interfaces.C.int := fl_abstract_browser_select_only (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (Do_Callbacks)); @@ -887,7 +887,7 @@ package body FLTK.Widgets.Groups.Browsers is Do_Callbacks : in Boolean := False) return Boolean is - Code : Interfaces.C.int := fl_abstract_browser_deselect + Code : constant Interfaces.C.int := fl_abstract_browser_deselect (This.Void_Ptr, Boolean'Pos (Do_Callbacks)); begin @@ -904,7 +904,7 @@ package body FLTK.Widgets.Groups.Browsers is (This : in out Browser; Do_Callbacks : in Boolean := False) is - Code : Interfaces.C.int := fl_abstract_browser_deselect + Code : constant Interfaces.C.int := fl_abstract_browser_deselect (This.Void_Ptr, Boolean'Pos (Do_Callbacks)); begin @@ -929,7 +929,7 @@ package body FLTK.Widgets.Groups.Browsers is Item : in Item_Cursor) return Boolean is - Code : Interfaces.C.int := fl_abstract_browser_displayed + Code : constant Interfaces.C.int := fl_abstract_browser_displayed (This.Void_Ptr, Cursor_To_Address (Item)); begin pragma Assert (Code in 0 .. 1); @@ -964,7 +964,7 @@ package body FLTK.Widgets.Groups.Browsers is (This : in out Browser; Order : in Sort_Order) is - Code : Interfaces.C.int := + Code : constant Interfaces.C.int := (case Order is when Ascending => fl_sort_ascending, when Descending => fl_sort_descending); diff --git a/body/fltk-widgets-groups-color_choosers.adb b/body/fltk-widgets-groups-color_choosers.adb index 15c7000..cce0f08 100644 --- a/body/fltk-widgets-groups-color_choosers.adb +++ b/body/fltk-widgets-groups-color_choosers.adb @@ -268,7 +268,7 @@ package body FLTK.Widgets.Groups.Color_Choosers is (This : in out Color_Chooser; R, G, B : in Long_Float) is - Result : Interfaces.C.int := fl_color_chooser_rgb + Result : constant Interfaces.C.int := fl_color_chooser_rgb (This.Void_Ptr, Interfaces.C.double (R), Interfaces.C.double (G), @@ -287,7 +287,7 @@ package body FLTK.Widgets.Groups.Color_Choosers is R, G, B : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_color_chooser_rgb + Result : constant Interfaces.C.int := fl_color_chooser_rgb (This.Void_Ptr, Interfaces.C.double (R), Interfaces.C.double (G), @@ -333,7 +333,7 @@ package body FLTK.Widgets.Groups.Color_Choosers is (This : in out Color_Chooser; H, S, V : in Long_Float) is - Result : Interfaces.C.int := fl_color_chooser_hsv + Result : constant Interfaces.C.int := fl_color_chooser_hsv (This.Void_Ptr, Interfaces.C.double (H), Interfaces.C.double (S), @@ -352,7 +352,7 @@ package body FLTK.Widgets.Groups.Color_Choosers is H, S, V : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_color_chooser_hsv + Result : constant Interfaces.C.int := fl_color_chooser_hsv (This.Void_Ptr, Interfaces.C.double (H), Interfaces.C.double (S), diff --git a/body/fltk-widgets-groups-help_views.adb b/body/fltk-widgets-groups-help_views.adb index cdc0046..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 @@ -255,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); @@ -463,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; @@ -481,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 @@ -496,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 diff --git a/body/fltk-widgets-groups-input_choices.adb b/body/fltk-widgets-groups-input_choices.adb index 0479920..edd16db 100644 --- a/body/fltk-widgets-groups-input_choices.adb +++ b/body/fltk-widgets-groups-input_choices.adb @@ -468,7 +468,7 @@ package body FLTK.Widgets.Groups.Input_Choices is (This : in Input_Choice) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_choice_get_value (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_input_choice_get_value (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/body/fltk-widgets-groups-packed.adb b/body/fltk-widgets-groups-packed.adb index c5edda9..d832a35 100644 --- a/body/fltk-widgets-groups-packed.adb +++ b/body/fltk-widgets-groups-packed.adb @@ -173,7 +173,7 @@ package body FLTK.Widgets.Groups.Packed is (This : in Packed_Group) return Pack_Kind is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Pack_Kind'Val (Result); exception diff --git a/body/fltk-widgets-groups-scrolls.adb b/body/fltk-widgets-groups-scrolls.adb index a75d677..e280058 100644 --- a/body/fltk-widgets-groups-scrolls.adb +++ b/body/fltk-widgets-groups-scrolls.adb @@ -397,7 +397,7 @@ package body FLTK.Widgets.Groups.Scrolls is (This : in Scroll) return Scroll_Kind is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Scroll_Kind'Val (Result - 1); exception diff --git a/body/fltk-widgets-groups-spinners.adb b/body/fltk-widgets-groups-spinners.adb index 255daec..d9501ee 100644 --- a/body/fltk-widgets-groups-spinners.adb +++ b/body/fltk-widgets-groups-spinners.adb @@ -481,7 +481,7 @@ package body FLTK.Widgets.Groups.Spinners is (This : in Spinner) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_spinner_get_format (This.Void_Ptr); + Result : constant Interfaces.C.Strings.chars_ptr := fl_spinner_get_format (This.Void_Ptr); begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -505,7 +505,7 @@ package body FLTK.Widgets.Groups.Spinners is (This : in Spinner) return Spinner_Kind is - Result : Interfaces.C.unsigned_char := fl_spinner_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_spinner_get_type (This.Void_Ptr); begin return Spinner_Kind'Val (Result - 1); exception diff --git a/body/fltk-widgets-groups-tables-row.adb b/body/fltk-widgets-groups-tables-row.adb index 5848cb9..0a7250a 100644 --- a/body/fltk-widgets-groups-tables-row.adb +++ b/body/fltk-widgets-groups-tables-row.adb @@ -232,7 +232,7 @@ package body FLTK.Widgets.Groups.Tables.Row is (This : in Row_Table) return Natural is - Result : Interfaces.C.int := fl_table_row_get_rows (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_row_get_rows (This.Void_Ptr); begin return Natural (Result); exception @@ -259,7 +259,7 @@ package body FLTK.Widgets.Groups.Tables.Row is Row : in Positive) return Boolean is - Result : Interfaces.C.int := fl_table_row_row_selected + Result : constant Interfaces.C.int := fl_table_row_row_selected (This.Void_Ptr, Interfaces.C.int (Row) - 1); begin return Boolean'Val (Result); @@ -275,7 +275,7 @@ package body FLTK.Widgets.Groups.Tables.Row is Row : in Positive; Value : in Selection_State := Selected) is - Result : Interfaces.C.int := fl_table_row_select_row + Result : constant Interfaces.C.int := fl_table_row_select_row (This.Void_Ptr, Interfaces.C.int (Row) - 1, Selection_State'Pos (Value)); @@ -298,7 +298,7 @@ package body FLTK.Widgets.Groups.Tables.Row is Value : in Selection_State := Selected) return Boolean is - Result : Interfaces.C.int := fl_table_row_select_row + Result : constant Interfaces.C.int := fl_table_row_select_row (This.Void_Ptr, Interfaces.C.int (Row) - 1, Selection_State'Pos (Value)); @@ -327,7 +327,7 @@ package body FLTK.Widgets.Groups.Tables.Row is (This : in Row_Table) return Row_Select_Mode is - Result : Interfaces.C.int := fl_table_row_get_type (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_row_get_type (This.Void_Ptr); begin return Row_Select_Mode'Val (Result); exception @@ -355,7 +355,7 @@ package body FLTK.Widgets.Groups.Tables.Row is Row, Column : in Positive; X, Y, W, H : out Integer) is - Result : Interfaces.C.int := fl_table_row_find_cell + Result : constant Interfaces.C.int := fl_table_row_find_cell (This.Void_Ptr, To_Cint (Context), Interfaces.C.int (Row) - 1, diff --git a/body/fltk-widgets-groups-tables.adb b/body/fltk-widgets-groups-tables.adb index 74ed22d..b572b8e 100644 --- a/body/fltk-widgets-groups-tables.adb +++ b/body/fltk-widgets-groups-tables.adb @@ -1024,7 +1024,7 @@ package body FLTK.Widgets.Groups.Tables is Item : in Widget'Class) return Extended_Index is - Result : Interfaces.C.int := fl_table_find (This.Void_Ptr, Item.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_find (This.Void_Ptr, Item.Void_Ptr); begin if Result = fl_table_children (This.Void_Ptr) then return No_Index; @@ -1086,7 +1086,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_callback_col (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_callback_col (This.Void_Ptr); begin return Positive (Result + 1); exception @@ -1100,7 +1100,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_callback_row (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_callback_row (This.Void_Ptr); begin return Positive (Result + 1); exception @@ -1114,7 +1114,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Table_Context is - Result : Interfaces.C.int := fl_table_callback_context (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_callback_context (This.Void_Ptr); begin return To_Context (Result); exception @@ -1192,7 +1192,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_col_header_height (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_col_header_height (This.Void_Ptr); begin return Positive (Result); exception @@ -1215,7 +1215,7 @@ package body FLTK.Widgets.Groups.Tables is Column : in Positive) return Positive is - Result : Interfaces.C.int := fl_table_get_col_width + Result : constant Interfaces.C.int := fl_table_get_col_width (This.Void_Ptr, Interfaces.C.int (Column) - 1); begin return Positive (Result); @@ -1250,7 +1250,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Natural is - Result : Interfaces.C.int := fl_table_get_cols (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_cols (This.Void_Ptr); begin return Natural (Result); exception @@ -1272,7 +1272,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_col_position (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_col_position (This.Void_Ptr); begin return Positive (Result + 1); exception @@ -1321,7 +1321,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_col_resize_min (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_col_resize_min (This.Void_Ptr); begin return Positive (Result); exception @@ -1379,7 +1379,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_row_header_width (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_row_header_width (This.Void_Ptr); begin return Positive (Result); exception @@ -1402,7 +1402,7 @@ package body FLTK.Widgets.Groups.Tables is Row : in Positive) return Positive is - Result : Interfaces.C.int := fl_table_get_row_height + Result : constant Interfaces.C.int := fl_table_get_row_height (This.Void_Ptr, Interfaces.C.int (Row) - 1); begin return Positive (Result); @@ -1437,7 +1437,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Natural is - Result : Interfaces.C.int := fl_table_get_rows (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_rows (This.Void_Ptr); begin return Natural (Result); exception @@ -1459,7 +1459,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_row_position (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_row_position (This.Void_Ptr); begin return Positive (Result + 1); exception @@ -1508,7 +1508,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_row_resize_min (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_row_resize_min (This.Void_Ptr); begin return Positive (Result); exception @@ -1530,7 +1530,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Positive is - Result : Interfaces.C.int := fl_table_get_top_row (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_top_row (This.Void_Ptr); begin return Positive (Result + 1); exception @@ -1567,7 +1567,7 @@ package body FLTK.Widgets.Groups.Tables is Resize : out Resize_Flag) is C_Row, C_Column, C_Flag : Interfaces.C.int; - Result : Interfaces.C.int := fl_table_cursor2rowcol + Result : constant Interfaces.C.int := fl_table_cursor2rowcol (This.Void_Ptr, C_Row, C_Column, C_Flag); begin Row := Positive (C_Row + 1); @@ -1659,7 +1659,7 @@ package body FLTK.Widgets.Groups.Tables is Row, Column : in Positive) return Boolean is - Result : Interfaces.C.int := fl_table_is_selected + Result : constant Interfaces.C.int := fl_table_is_selected (This.Void_Ptr, Interfaces.C.int (Row) - 1, Interfaces.C.int (Column) - 1); @@ -1677,7 +1677,7 @@ package body FLTK.Widgets.Groups.Tables is Row, Column : in Positive; Shift_Select : in Boolean := True) is - Result : Interfaces.C.int := fl_table_move_cursor + Result : constant Interfaces.C.int := fl_table_move_cursor (This.Void_Ptr, Interfaces.C.int (Row) - 1, Interfaces.C.int (Column) - 1, @@ -1697,7 +1697,7 @@ package body FLTK.Widgets.Groups.Tables is Shift_Select : in Boolean := True) return Boolean is - Result : Interfaces.C.int := fl_table_move_cursor + Result : constant Interfaces.C.int := fl_table_move_cursor (This.Void_Ptr, Interfaces.C.int (Row) - 1, Interfaces.C.int (Column) - 1, @@ -1715,7 +1715,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Tab_Navigation is - Result : Interfaces.C.int := fl_table_get_tab_cell_nav (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_tab_cell_nav (This.Void_Ptr); begin return Tab_Navigation'Val (Result); exception @@ -1737,7 +1737,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Box_Kind is - Result : Interfaces.C.int := fl_table_get_table_box (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_get_table_box (This.Void_Ptr); begin return Box_Kind'Val (Result); exception @@ -1792,7 +1792,7 @@ package body FLTK.Widgets.Groups.Tables is (This : in Table) return Boolean is - Result : Interfaces.C.int := fl_table_is_interactive_resize (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_table_is_interactive_resize (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -1922,7 +1922,7 @@ package body FLTK.Widgets.Groups.Tables is Row, Column : in Positive; X, Y, W, H : out Integer) is - Result : Interfaces.C.int := fl_table_find_cell + Result : constant Interfaces.C.int := fl_table_find_cell (This.Void_Ptr, To_Cint (Context), Interfaces.C.int (Row) - 1, @@ -1967,7 +1967,7 @@ package body FLTK.Widgets.Groups.Tables is is C_Row : Interfaces.C.int := Interfaces.C.int (Row) - 1; C_Column : Interfaces.C.int := Interfaces.C.int (Column) - 1; - Result : Interfaces.C.int := fl_table_row_col_clamp + Result : constant Interfaces.C.int := fl_table_row_col_clamp (This.Void_Ptr, To_Cint (Context), C_Row, C_Column); @@ -1990,7 +1990,7 @@ package body FLTK.Widgets.Groups.Tables is is C_Row : Interfaces.C.int := Interfaces.C.int (Row) - 1; C_Column : Interfaces.C.int := Interfaces.C.int (Column) - 1; - Result : Interfaces.C.int := fl_table_row_col_clamp + Result : constant Interfaces.C.int := fl_table_row_col_clamp (This.Void_Ptr, To_Cint (Context), C_Row, C_Column); diff --git a/body/fltk-widgets-groups-text_displays-text_editors.adb b/body/fltk-widgets-groups-text_displays-text_editors.adb index 680d3be..c2722b6 100644 --- a/body/fltk-widgets-groups-text_displays-text_editors.adb +++ b/body/fltk-widgets-groups-text_displays-text_editors.adb @@ -8,8 +8,7 @@ with Ada.Assertions, Ada.Characters.Latin_1, - FLTK.Events, - Interfaces.C; + FLTK.Events; package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is @@ -385,12 +384,12 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is -- Key Binding Modification -- - procedure fl_text_editor_add_key_binding - (TE : in Storage.Integer_Address; - K, S : in Interfaces.C.int; - F : in Storage.Integer_Address); - pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding"); - pragma Inline (fl_text_editor_add_key_binding); + -- procedure fl_text_editor_add_key_binding + -- (TE : in Storage.Integer_Address; + -- K, S : in Interfaces.C.int; + -- F : in Storage.Integer_Address); + -- pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding"); + -- pragma Inline (fl_text_editor_add_key_binding); procedure fl_text_editor_remove_all_key_bindings (TE : in Storage.Integer_Address); @@ -473,12 +472,13 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is E : in Storage.Integer_Address) return Interfaces.C.int is - Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E); + Editor_Ptr : constant Storage.Integer_Address := fl_widget_get_user_data (E); Ada_Editor : access Text_Editor'Class; - Extra_Keys : Modifier := FLTK.Events.Last_Modifier; - Actual_Key : Keypress := FLTK.Events.Last_Key; -- fuck you FLTK, give me the real code - Ada_Key : Key_Combo := Extra_Keys + Actual_Key; + Extra_Keys : constant Modifier := FLTK.Events.Last_Modifier; + Actual_Key : constant Keypress := FLTK.Events.Last_Key; + -- fuck you FLTK, give me the real code + Ada_Key : constant Key_Combo := Extra_Keys + Actual_Key; -- For whatever reason, if a regular key function is used then FLTK will -- give you the key code, but if a default key function is used instead it @@ -577,9 +577,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function Create (X, Y, W, H : in Integer; Text : in String := "") - return Text_Editor - is - use type Interfaces.C.int; + return Text_Editor is begin return This : Text_Editor do This.Void_Ptr := new_fl_text_editor @@ -1198,7 +1196,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (This : in Text_Editor) return Insert_Mode is - Result : Interfaces.C.int := fl_text_editor_get_insert_mode (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_editor_get_insert_mode (This.Void_Ptr); begin return Insert_Mode'Val (Result); exception @@ -1220,7 +1218,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (This : in Text_Editor) return Tab_Navigation is - Result : Interfaces.C.int := fl_text_editor_get_tab_nav (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_editor_get_tab_nav (This.Void_Ptr); begin return Tab_Navigation'Val (Result); exception @@ -1255,7 +1253,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (This : in out Text_Editor) return Event_Outcome is - Result : Interfaces.C.int := fl_text_editor_handle_key (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_editor_handle_key (This.Void_Ptr); begin return Event_Outcome'Val (Result); exception diff --git a/body/fltk-widgets-groups-text_displays.adb b/body/fltk-widgets-groups-text_displays.adb index 601bde9..0b70bf6 100644 --- a/body/fltk-widgets-groups-text_displays.adb +++ b/body/fltk-widgets-groups-text_displays.adb @@ -9,8 +9,7 @@ with Ada.Assertions, Ada.Characters.Latin_1, Ada.Unchecked_Conversion, - Interfaces.C.Strings, - FLTK.Text_Buffers; + Interfaces.C.Strings; use type @@ -50,11 +49,11 @@ package body FLTK.Widgets.Groups.Text_Displays is -- Buffers -- - function fl_text_display_get_buffer - (TD : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); - pragma Inline (fl_text_display_get_buffer); + -- function fl_text_display_get_buffer + -- (TD : in Storage.Integer_Address) + -- return Storage.Integer_Address; + -- pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); + -- pragma Inline (fl_text_display_get_buffer); procedure fl_text_display_set_buffer (TD, TB : in Storage.Integer_Address); @@ -834,7 +833,7 @@ package body FLTK.Widgets.Groups.Text_Displays is is use Styles; -- for maximum stylin' - Ada_Widget : access Text_Display'Class := + Ada_Widget : constant access Text_Display'Class := Text_Display_Convert.To_Pointer (Storage.To_Address (D)); begin if Ada_Widget.Style_Callback /= null then @@ -1041,7 +1040,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Line_Index : in Natural) return Styles.Style_Info is - Result : Interfaces.C.int := fl_text_display_position_style + Result : constant Interfaces.C.int := fl_text_display_position_style (This.Void_Ptr, Interfaces.C.int (Line_Start), Interfaces.C.int (Line_Length), @@ -1134,7 +1133,7 @@ package body FLTK.Widgets.Groups.Text_Displays is X : in Integer) return Natural is - Result : Interfaces.C.int := fl_text_display_find_x + Result : constant Interfaces.C.int := fl_text_display_find_x (This.Void_Ptr, Interfaces.C.To_C (Text), Text'Length, @@ -1155,7 +1154,7 @@ package body FLTK.Widgets.Groups.Text_Displays is return Natural is C_Line_Num : Interfaces.C.int; - Result : Interfaces.C.int := fl_text_display_position_to_line + Result : constant Interfaces.C.int := fl_text_display_position_to_line (This.Void_Ptr, Interfaces.C.int (Position), C_Line_Num); @@ -1179,7 +1178,7 @@ package body FLTK.Widgets.Groups.Text_Displays is return Natural is C_Line_Num : Interfaces.C.int; - Result : Interfaces.C.int := fl_text_display_position_to_line + Result : constant Interfaces.C.int := fl_text_display_position_to_line (This.Void_Ptr, Interfaces.C.int (Position), C_Line_Num); @@ -1204,7 +1203,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Column : out Natural) is C_Line_Num, C_Column : Interfaces.C.int; - Result : Interfaces.C.int := fl_text_display_position_to_linecol + Result : constant Interfaces.C.int := fl_text_display_position_to_linecol (This.Void_Ptr, Interfaces.C.int (Position), C_Line_Num, C_Column); @@ -1231,7 +1230,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Displayed : out Boolean) is C_Line_Num, C_Column : Interfaces.C.int; - Result : Interfaces.C.int := fl_text_display_position_to_linecol + Result : constant Interfaces.C.int := fl_text_display_position_to_linecol (This.Void_Ptr, Interfaces.C.int (Position), C_Line_Num, C_Column); @@ -1257,7 +1256,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Kind : in Position_Kind := Character_Position) return Natural is - Result : Interfaces.C.int := fl_text_display_xy_to_position + Result : constant Interfaces.C.int := fl_text_display_xy_to_position (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1493,7 +1492,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Row : in Natural) return Natural is - Result : Interfaces.C.int := fl_text_display_wrapped_row + Result : constant Interfaces.C.int := fl_text_display_wrapped_row (This.Void_Ptr, Interfaces.C.int (Row)); begin @@ -1510,7 +1509,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Row, Column : in Natural) return Natural is - Result : Interfaces.C.int := fl_text_display_wrapped_column + Result : constant Interfaces.C.int := fl_text_display_wrapped_column (This.Void_Ptr, Interfaces.C.int (Row), Interfaces.C.int (Column)); @@ -1528,7 +1527,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Line_End : in Natural) return Boolean is - Result : Interfaces.C.int := fl_text_display_wrap_uses_character + Result : constant Interfaces.C.int := fl_text_display_wrap_uses_character (This.Void_Ptr, Interfaces.C.int (Line_End)); begin @@ -1693,7 +1692,8 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in Text_Display) return Natural is - Result : Interfaces.C.int := fl_text_display_get_absolute_top_line_number (This.Void_Ptr); + Result : constant Interfaces.C.int := + fl_text_display_get_absolute_top_line_number (This.Void_Ptr); begin return Natural (Result); exception @@ -1715,7 +1715,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_maintaining_absolute_top_line_number + Result : constant Interfaces.C.int := fl_text_display_maintaining_absolute_top_line_number (This.Void_Ptr); begin return Boolean'Val (Result); @@ -1741,7 +1741,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_empty_vlines (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_empty_vlines (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -1755,7 +1755,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in Text_Display) return Natural is - Result : Interfaces.C.int := fl_text_display_longest_vline (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_longest_vline (This.Void_Ptr); begin return Natural (Result); exception @@ -1770,7 +1770,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Line : in Natural) return Natural is - Result : Interfaces.C.int := fl_text_display_vline_length + Result : constant Interfaces.C.int := fl_text_display_vline_length (This.Void_Ptr, Interfaces.C.int (Line)); begin @@ -1898,7 +1898,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in Text_Display) return String is - Result : Interfaces.C.Strings.chars_ptr := + Result : constant Interfaces.C.Strings.chars_ptr := fl_text_display_get_linenumber_format (This.Void_Ptr); begin if Result = Interfaces.C.Strings.Null_Ptr then @@ -1941,7 +1941,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Line : in Natural) return Natural is - Result : Interfaces.C.int := fl_text_display_measure_vline + Result : constant Interfaces.C.int := fl_text_display_measure_vline (This.Void_Ptr, Interfaces.C.int (Line)); begin @@ -1974,7 +1974,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Move_Down (This : in out Text_Display) is - Result : Interfaces.C.int := fl_text_display_move_down (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_down (This.Void_Ptr); begin pragma Assert (Result in 0 .. 1); exception @@ -1988,7 +1988,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_move_down (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_down (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -2001,7 +2001,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Move_Left (This : in out Text_Display) is - Result : Interfaces.C.int := fl_text_display_move_left (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_left (This.Void_Ptr); begin pragma Assert (Result in 0 .. 1); exception @@ -2015,7 +2015,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_move_left (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_left (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -2028,7 +2028,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Move_Right (This : in out Text_Display) is - Result : Interfaces.C.int := fl_text_display_move_right (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_right (This.Void_Ptr); begin pragma Assert (Result in 0 .. 1); exception @@ -2042,7 +2042,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_move_right (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_right (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -2055,7 +2055,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Move_Up (This : in out Text_Display) is - Result : Interfaces.C.int := fl_text_display_move_up (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_up (This.Void_Ptr); begin pragma Assert (Result in 0 .. 1); exception @@ -2069,7 +2069,7 @@ package body FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display) return Boolean is - Result : Interfaces.C.int := fl_text_display_move_up (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_text_display_move_up (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -2101,7 +2101,7 @@ package body FLTK.Widgets.Groups.Text_Displays is Pixel : in Natural := 0) return Boolean is - Result : Interfaces.C.int := fl_text_display_scroll2 + Result : constant Interfaces.C.int := fl_text_display_scroll2 (This.Void_Ptr, Interfaces.C.int (Line), Interfaces.C.int (Pixel)); diff --git a/body/fltk-widgets-groups-windows-double-cairo.adb b/body/fltk-widgets-groups-windows-double-cairo.adb index 270a30e..1560c20 100644 --- a/body/fltk-widgets-groups-windows-double-cairo.adb +++ b/body/fltk-widgets-groups-windows-double-cairo.adb @@ -81,9 +81,9 @@ package body FLTK.Widgets.Groups.Windows.Double.Cairo is procedure Cairo_Draw_Hook (C_Addr, Cairo_Addr : in Storage.Integer_Address) is - Ada_Addr : System.Address := + Ada_Addr : constant System.Address := Storage.To_Address (fl_widget_get_user_data (C_Addr)); - Ada_Object : access Cairo_Window'Class := + Ada_Object : constant access Cairo_Window'Class := Cairo_Convert.To_Pointer (Ada_Addr); begin pragma Assert (Ada_Object /= null); diff --git a/body/fltk-widgets-groups-windows-double-overlay.adb b/body/fltk-widgets-groups-windows-double-overlay.adb index 2534d31..94542af 100644 --- a/body/fltk-widgets-groups-windows-double-overlay.adb +++ b/body/fltk-widgets-groups-windows-double-overlay.adb @@ -125,7 +125,7 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure Overlay_Window_Draw_Overlay_Hook (U : in Storage.Integer_Address) is - Overlay_Widget : access Overlay_Window'Class := + Overlay_Widget : constant access Overlay_Window'Class := Over_Convert.To_Pointer (Storage.To_Address (U)); begin Overlay_Widget.Draw_Overlay; diff --git a/body/fltk-widgets-groups-windows-opengl.adb b/body/fltk-widgets-groups-windows-opengl.adb index c2bf078..df61bd9 100644 --- a/body/fltk-widgets-groups-windows-opengl.adb +++ b/body/fltk-widgets-groups-windows-opengl.adb @@ -7,8 +7,7 @@ with FLTK.Args_Marshal, - Interfaces.C, - System; + Interfaces.C; use type diff --git a/body/fltk-widgets-groups-windows.adb b/body/fltk-widgets-groups-windows.adb index 76847db..4d73499 100644 --- a/body/fltk-widgets-groups-windows.adb +++ b/body/fltk-widgets-groups-windows.adb @@ -6,9 +6,7 @@ with - Ada.Command_Line, Interfaces.C.Strings, - FLTK.Images.RGB, FLTK.Args_Marshal; use type @@ -681,7 +679,7 @@ package body FLTK.Widgets.Groups.Windows is (This : in Window) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_iconlabel (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_window_get_iconlabel (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -842,7 +840,7 @@ package body FLTK.Widgets.Groups.Windows is (This : in Window) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_label (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_window_get_label (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -942,7 +940,7 @@ package body FLTK.Widgets.Groups.Windows is (This : in Window) return Boolean is - Result : Interfaces.C.int := fl_window_get_force_position (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_window_get_force_position (This.Void_Ptr); begin return Boolean'Val (Result); exception @@ -1000,7 +998,7 @@ package body FLTK.Widgets.Groups.Windows is (This : in Window) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_window_get_xclass (This.Void_Ptr); + Result : constant Interfaces.C.Strings.chars_ptr := fl_window_get_xclass (This.Void_Ptr); begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1021,7 +1019,7 @@ package body FLTK.Widgets.Groups.Windows is function Get_Default_X_Class return String is - Result : Interfaces.C.Strings.chars_ptr := fl_window_get_default_xclass; + Result : constant Interfaces.C.Strings.chars_ptr := fl_window_get_default_xclass; begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/body/fltk-widgets-groups.adb b/body/fltk-widgets-groups.adb index 6c94c4a..4c30dfb 100644 --- a/body/fltk-widgets-groups.adb +++ b/body/fltk-widgets-groups.adb @@ -411,7 +411,7 @@ package body FLTK.Widgets.Groups is Item : in Widget'Class) return Extended_Index is - Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr); + Result : constant Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr); begin if Result = fl_group_children (This.Void_Ptr) then return No_Index; @@ -436,7 +436,7 @@ package body FLTK.Widgets.Groups is (This : in Group) return Group_Iterators.Reversible_Iterator'Class is begin - return It : Iterator := (My_Container => This'Unrestricted_Access); + return It : constant Iterator := (My_Container => This'Unrestricted_Access); end Iterate; @@ -444,7 +444,7 @@ package body FLTK.Widgets.Groups is (Object : in Iterator) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Object.My_Container, My_Index => 1); end First; @@ -458,7 +458,7 @@ package body FLTK.Widgets.Groups is if Object.My_Container /= Place.My_Container then raise Program_Error; end if; - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Place.My_Container, My_Index => Place.My_Index + 1); end Next; @@ -468,7 +468,7 @@ package body FLTK.Widgets.Groups is (Object : in Iterator) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Object.My_Container, My_Index => Object.My_Container.Number_Of_Children); end Last; @@ -482,7 +482,7 @@ package body FLTK.Widgets.Groups is if Object.My_Container /= Place.My_Container then raise Program_Error; end if; - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Place.My_Container, My_Index => Place.My_Index - 1); end Previous; @@ -496,7 +496,7 @@ package body FLTK.Widgets.Groups is (This : in Group) return Clip_Mode is - Result : Interfaces.C.unsigned := fl_group_get_clip_children (This.Void_Ptr); + Result : constant Interfaces.C.unsigned := fl_group_get_clip_children (This.Void_Ptr); begin return Clip_Mode'Val (Result); exception diff --git a/body/fltk-widgets-inputs-text-file.adb b/body/fltk-widgets-inputs-text-file.adb index ac3cec7..42c4961 100644 --- a/body/fltk-widgets-inputs-text-file.adb +++ b/body/fltk-widgets-inputs-text-file.adb @@ -236,7 +236,7 @@ package body FLTK.Widgets.Inputs.Text.File is (This : in File_Input) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -251,7 +251,7 @@ package body FLTK.Widgets.Inputs.Text.File is (This : in out File_Input; To : in String) is - Result : Interfaces.C.int := fl_file_input_set_value + Result : constant Interfaces.C.int := fl_file_input_set_value (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); begin diff --git a/body/fltk-widgets-inputs-text-floating_point.adb b/body/fltk-widgets-inputs-text-floating_point.adb index 4bdcc0f..6a7925c 100644 --- a/body/fltk-widgets-inputs-text-floating_point.adb +++ b/body/fltk-widgets-inputs-text-floating_point.adb @@ -145,7 +145,7 @@ package body FLTK.Widgets.Inputs.Text.Floating_Point is (This : in Float_Input) return Long_Float is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr or else Interfaces.C.Strings.Value (Ptr) = "" diff --git a/body/fltk-widgets-inputs-text-multiline.adb b/body/fltk-widgets-inputs-text-multiline.adb index 4969082..b348ce5 100644 --- a/body/fltk-widgets-inputs-text-multiline.adb +++ b/body/fltk-widgets-inputs-text-multiline.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Inputs.Text.Multiline is diff --git a/body/fltk-widgets-inputs-text-outputs-multiline.adb b/body/fltk-widgets-inputs-text-outputs-multiline.adb index 3f01dc3..e18d9b3 100644 --- a/body/fltk-widgets-inputs-text-outputs-multiline.adb +++ b/body/fltk-widgets-inputs-text-outputs-multiline.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Inputs.Text.Outputs.Multiline is diff --git a/body/fltk-widgets-inputs-text-outputs.adb b/body/fltk-widgets-inputs-text-outputs.adb index eeb83fb..6be0738 100644 --- a/body/fltk-widgets-inputs-text-outputs.adb +++ b/body/fltk-widgets-inputs-text-outputs.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Inputs.Text.Outputs is diff --git a/body/fltk-widgets-inputs-text-secret.adb b/body/fltk-widgets-inputs-text-secret.adb index 72d9f77..146133f 100644 --- a/body/fltk-widgets-inputs-text-secret.adb +++ b/body/fltk-widgets-inputs-text-secret.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Inputs.Text.Secret is diff --git a/body/fltk-widgets-inputs-text-whole_number.adb b/body/fltk-widgets-inputs-text-whole_number.adb index b0a5aa5..070dc0f 100644 --- a/body/fltk-widgets-inputs-text-whole_number.adb +++ b/body/fltk-widgets-inputs-text-whole_number.adb @@ -145,7 +145,7 @@ package body FLTK.Widgets.Inputs.Text.Whole_Number is (This : in Integer_Input) return Long_Integer is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr or else Interfaces.C.Strings.Value (Ptr) = "" diff --git a/body/fltk-widgets-inputs.adb b/body/fltk-widgets-inputs.adb index ef791be..2057f96 100644 --- a/body/fltk-widgets-inputs.adb +++ b/body/fltk-widgets-inputs.adb @@ -429,7 +429,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; Destination : in Clipboard_Kind := Cut_Paste_Board) is - Result : Interfaces.C.int := fl_input_copy + Result : constant Interfaces.C.int := fl_input_copy (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); begin pragma Assert (Result in 0 .. 1); @@ -445,7 +445,7 @@ package body FLTK.Widgets.Inputs is Destination : in Clipboard_Kind := Cut_Paste_Board) return Boolean is - Result : Interfaces.C.int := fl_input_copy + Result : constant Interfaces.C.int := fl_input_copy (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); begin pragma Assert (Result in 0 .. 1); @@ -460,7 +460,7 @@ package body FLTK.Widgets.Inputs is procedure Cut (This : in out Input) is - Result : Interfaces.C.int := fl_input_cut (This.Void_Ptr); + Ignore : constant Interfaces.C.int := fl_input_cut (This.Void_Ptr); begin null; end Cut; @@ -478,7 +478,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; Num_Bytes : in Integer) is - Result : Interfaces.C.int := fl_input_cut2 + Ignore : constant Interfaces.C.int := fl_input_cut2 (This.Void_Ptr, Interfaces.C.int (Num_Bytes)); begin @@ -501,7 +501,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; Start, Finish : in Integer) is - Result : Interfaces.C.int := fl_input_cut3 + Ignore : constant Interfaces.C.int := fl_input_cut3 (This.Void_Ptr, Interfaces.C.int (Start), Interfaces.C.int (Finish)); @@ -525,7 +525,7 @@ package body FLTK.Widgets.Inputs is procedure Copy_Cuts (This : in out Input) is - Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); + Ignore : constant Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); begin null; end Copy_Cuts; @@ -535,7 +535,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input) return Boolean is - Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); begin return Result /= 0; end Copy_Cuts; @@ -544,7 +544,7 @@ package body FLTK.Widgets.Inputs is procedure Undo (This : in out Input) is - Result : Interfaces.C.int := fl_input_undo (This.Void_Ptr); + Ignore : constant Interfaces.C.int := fl_input_undo (This.Void_Ptr); begin null; end Undo; @@ -618,7 +618,7 @@ package body FLTK.Widgets.Inputs is (This : in Input) return Input_Kind is - C_Val : Interfaces.C.int := fl_input_get_input_type (This.Void_Ptr); + C_Val : constant Interfaces.C.int := fl_input_get_input_type (This.Void_Ptr); begin for V in Input_Kind loop if Input_Kind_Values (V) = C_Val then @@ -657,7 +657,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; To : in Natural) is - Result : Interfaces.C.int := fl_input_set_mark + Ignore : constant Interfaces.C.int := fl_input_set_mark (This.Void_Ptr, Interfaces.C.int (To)); begin @@ -688,7 +688,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; To : in Natural) is - Result : Interfaces.C.int := fl_input_set_position + Ignore : constant Interfaces.C.int := fl_input_set_position (This.Void_Ptr, Interfaces.C.int (To)); begin @@ -712,7 +712,7 @@ package body FLTK.Widgets.Inputs is Place : in Natural; Mark : in Natural) is - Result : Interfaces.C.int := fl_input_set_position2 + Ignore : constant Interfaces.C.int := fl_input_set_position2 (This.Void_Ptr, Interfaces.C.int (Place), Interfaces.C.int (Mark)); @@ -751,7 +751,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; Str : in String) is - Result : Interfaces.C.int := fl_input_insert + Ignore : constant Interfaces.C.int := fl_input_insert (This.Void_Ptr, Interfaces.C.To_C (Str, False), Str'Length); @@ -777,7 +777,7 @@ package body FLTK.Widgets.Inputs is From, To : in Natural; New_Text : in String) is - Result : Interfaces.C.int := fl_input_replace + Ignore : constant Interfaces.C.int := fl_input_replace (This.Void_Ptr, Interfaces.C.int (From), Interfaces.C.int (To), @@ -807,7 +807,7 @@ package body FLTK.Widgets.Inputs is (This : in Input) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -822,7 +822,7 @@ package body FLTK.Widgets.Inputs is (This : in out Input; To : in String) is - Result : Interfaces.C.int := fl_input_set_value + Ignore : constant Interfaces.C.int := fl_input_set_value (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); begin null; diff --git a/body/fltk-widgets-menus-choices.adb b/body/fltk-widgets-menus-choices.adb index 80168f9..ac4564c 100644 --- a/body/fltk-widgets-menus-choices.adb +++ b/body/fltk-widgets-menus-choices.adb @@ -7,8 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C, - System; + Interfaces.C; use type diff --git a/body/fltk-widgets-menus-menu_bars-systemwide.adb b/body/fltk-widgets-menus-menu_bars-systemwide.adb index 47ef6d9..88792bb 100644 --- a/body/fltk-widgets-menus-menu_bars-systemwide.adb +++ b/body/fltk-widgets-menus-menu_bars-systemwide.adb @@ -308,7 +308,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is (This : in out System_Menu_Bar; Text : in String) is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add + Ignore : constant Interfaces.C.int := fl_sys_menu_bar_add (This.Void_Ptr, Interfaces.C.To_C (Text)); begin This.Adjust_Item_Store; @@ -320,7 +320,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Text : in String) return Index is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add + Added_Spot : constant Interfaces.C.int := fl_sys_menu_bar_add (This.Void_Ptr, Interfaces.C.To_C (Text)); begin This.Adjust_Item_Store; @@ -335,7 +335,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2 + Ignore : constant Interfaces.C.int := fl_sys_menu_bar_add2 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.int (To_C (Shortcut)), @@ -354,7 +354,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2 + Added_Spot : constant Interfaces.C.int := fl_sys_menu_bar_add2 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.int (To_C (Shortcut)), @@ -373,7 +373,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Shortcut : in String; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3 + Ignore : constant Interfaces.C.int := fl_sys_menu_bar_add3 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), @@ -392,7 +392,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3 + Added_Spot : constant Interfaces.C.int := fl_sys_menu_bar_add3 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), @@ -412,7 +412,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert + Ignore : constant Interfaces.C.int := fl_sys_menu_bar_insert (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -433,7 +433,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert + Added_Spot : constant Interfaces.C.int := fl_sys_menu_bar_insert (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -454,7 +454,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Shortcut : in String; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2 + Ignore : constant Interfaces.C.int := fl_sys_menu_bar_insert2 (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -475,7 +475,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2 + Added_Spot : constant Interfaces.C.int := fl_sys_menu_bar_insert2 (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -522,7 +522,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is (This : in out System_Menu_Bar; Place : in Index) is - Result : Interfaces.C.int := fl_sys_menu_bar_clear_submenu + Result : constant Interfaces.C.int := fl_sys_menu_bar_clear_submenu (This.Void_Ptr, Interfaces.C.int (Place) - 1); begin diff --git a/body/fltk-widgets-menus-menu_buttons.adb b/body/fltk-widgets-menus-menu_buttons.adb index 3c4614c..949403c 100644 --- a/body/fltk-widgets-menus-menu_buttons.adb +++ b/body/fltk-widgets-menus-menu_buttons.adb @@ -218,7 +218,7 @@ package body FLTK.Widgets.Menus.Menu_Buttons is (This : in Menu_Button) return Popup_Buttons is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Popup_Buttons'Val (Result); exception @@ -241,7 +241,7 @@ package body FLTK.Widgets.Menus.Menu_Buttons is return Extended_Index is use type Interfaces.C.int; - Ptr : Storage.Integer_Address := fl_menu_button_popup (This.Void_Ptr); + Ptr : constant Storage.Integer_Address := fl_menu_button_popup (This.Void_Ptr); begin return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); end Popup; diff --git a/body/fltk-widgets-menus.adb b/body/fltk-widgets-menus.adb index 1e690f3..2837921 100644 --- a/body/fltk-widgets-menus.adb +++ b/body/fltk-widgets-menus.adb @@ -415,7 +415,7 @@ package body FLTK.Widgets.Menus is procedure Adjust_Item_Store (This : in out Menu) is - Target : Natural := This.Number_Of_Items; + Target : constant Natural := This.Number_Of_Items; begin while Natural (This.My_Items.Length) > Target loop Free_Item (This.My_Items.Reference (This.My_Items.Last_Index)); @@ -446,9 +446,9 @@ package body FLTK.Widgets.Menus is procedure Item_Hook (C_Obj, User_Data : in Storage.Integer_Address) is - Ada_Ptr : Storage.Integer_Address := fl_widget_get_user_data (C_Obj); + Ada_Ptr : constant Storage.Integer_Address := fl_widget_get_user_data (C_Obj); Ada_Widget : access Widget'Class; - Action : Widget_Callback := Callback_Convert.To_Access (User_Data); + Action : constant Widget_Callback := Callback_Convert.To_Access (User_Data); begin pragma Assert (Ada_Ptr /= Null_Pointer); Ada_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Ada_Ptr)); @@ -568,7 +568,7 @@ package body FLTK.Widgets.Menus is (This : in out Menu; Text : in String) is - Added_Spot : Interfaces.C.int := fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text)); + Ignore : constant Interfaces.C.int := fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text)); begin This.Adjust_Item_Store; end Add; @@ -579,7 +579,8 @@ package body FLTK.Widgets.Menus is Text : in String) return Index is - Added_Spot : Interfaces.C.int := fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text)); + Added_Spot : constant Interfaces.C.int := + fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -593,7 +594,7 @@ package body FLTK.Widgets.Menus is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_menu_add2 + Ignore : constant Interfaces.C.int := fl_menu_add2 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.int (To_C (Shortcut)), @@ -612,7 +613,7 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_menu_add2 + Added_Spot : constant Interfaces.C.int := fl_menu_add2 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.int (To_C (Shortcut)), @@ -631,7 +632,7 @@ package body FLTK.Widgets.Menus is Shortcut : in String; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_menu_add3 + Ignore : constant Interfaces.C.int := fl_menu_add3 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), @@ -650,7 +651,7 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_menu_add3 + Added_Spot : constant Interfaces.C.int := fl_menu_add3 (This.Void_Ptr, Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), @@ -670,7 +671,7 @@ package body FLTK.Widgets.Menus is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_menu_insert + Ignore : constant Interfaces.C.int := fl_menu_insert (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -691,7 +692,7 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_menu_insert + Added_Spot : constant Interfaces.C.int := fl_menu_insert (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -712,7 +713,7 @@ package body FLTK.Widgets.Menus is Shortcut : in String; Flags : in Menu_Flag := Flag_Normal) is - Added_Spot : Interfaces.C.int := fl_menu_insert2 + Ignore : constant Interfaces.C.int := fl_menu_insert2 (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -733,7 +734,7 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) return Index is - Added_Spot : Interfaces.C.int := fl_menu_insert2 + Added_Spot : constant Interfaces.C.int := fl_menu_insert2 (This.Void_Ptr, Interfaces.C.int (Place) - 1, Interfaces.C.To_C (Text), @@ -796,7 +797,7 @@ package body FLTK.Widgets.Menus is (This : in out Menu; Place : in Index) is - Result : Interfaces.C.int := fl_menu_clear_submenu + Result : constant Interfaces.C.int := fl_menu_clear_submenu (This.Void_Ptr, Interfaces.C.int (Place) - 1); begin @@ -866,7 +867,7 @@ package body FLTK.Widgets.Menus is Name : in String) return FLTK.Menu_Items.Menu_Item_Reference is - Place : Extended_Index := This.Find_Index (Name); + Place : constant Extended_Index := This.Find_Index (Name); begin if Place = No_Index then raise No_Reference_Error; @@ -880,7 +881,7 @@ package body FLTK.Widgets.Menus is Action : in Widget_Callback) return FLTK.Menu_Items.Menu_Item_Reference is - Place : Extended_Index := This.Find_Index (Action); + Place : constant Extended_Index := This.Find_Index (Action); begin if Place = No_Index then raise No_Reference_Error; @@ -894,7 +895,8 @@ package body FLTK.Widgets.Menus is Name : in String) return Extended_Index is - Result : Interfaces.C.int := fl_menu_find_index (This.Void_Ptr, Interfaces.C.To_C (Name)); + Result : constant Interfaces.C.int := + fl_menu_find_index (This.Void_Ptr, Interfaces.C.To_C (Name)); begin return Extended_Index (Result + 1); end Find_Index; @@ -905,7 +907,8 @@ package body FLTK.Widgets.Menus is Item : in FLTK.Menu_Items.Menu_Item) return Extended_Index is - Result : Interfaces.C.int := fl_menu_find_index2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); + Result : constant Interfaces.C.int := + fl_menu_find_index2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); begin return Extended_Index (Result + 1); end Find_Index; @@ -931,7 +934,7 @@ package body FLTK.Widgets.Menus is is Buffer : Interfaces.C.char_array := (0 .. Interfaces.C.size_t (Item_Path_Max) => Interfaces.C.nul); - Result : Interfaces.C.int := fl_menu_item_pathname + Result : constant Interfaces.C.int := fl_menu_item_pathname (This.Void_Ptr, Buffer, Interfaces.C.int (Item_Path_Max), @@ -959,7 +962,7 @@ package body FLTK.Widgets.Menus is is Buffer : Interfaces.C.char_array := (0 .. Interfaces.C.size_t (Item_Path_Max) => Interfaces.C.nul); - Result : Interfaces.C.int := fl_menu_item_pathname + Result : constant Interfaces.C.int := fl_menu_item_pathname (This.Void_Ptr, Buffer, Interfaces.C.int (Item_Path_Max), @@ -999,7 +1002,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return Menu_Iterators.Reversible_Iterator'Class is begin - return It : Iterator := (My_Container => This'Unrestricted_Access); + return It : constant Iterator := (My_Container => This'Unrestricted_Access); end Iterate; @@ -1007,7 +1010,7 @@ package body FLTK.Widgets.Menus is (Object : in Iterator) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Object.My_Container, My_Index => 1); end First; @@ -1018,7 +1021,7 @@ package body FLTK.Widgets.Menus is Place : in Cursor) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Place.My_Container, My_Index => Place.My_Index + 1); end Next; @@ -1028,7 +1031,7 @@ package body FLTK.Widgets.Menus is (Object : in Iterator) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Object.My_Container, My_Index => Object.My_Container.Number_Of_Items); end Last; @@ -1039,7 +1042,7 @@ package body FLTK.Widgets.Menus is Place : in Cursor) return Cursor is begin - return Cu : Cursor := + return Cu : constant Cursor := (My_Container => Place.My_Container, My_Index => Place.My_Index - 1); end Previous; @@ -1053,7 +1056,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return FLTK.Menu_Items.Menu_Item_Reference is - Place : Extended_Index := This.Chosen_Index; + Place : constant Extended_Index := This.Chosen_Index; begin if Place = No_Index then raise No_Reference_Error; @@ -1066,7 +1069,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_text (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_menu_text (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1145,7 +1148,7 @@ package body FLTK.Widgets.Menus is Place : in Index) return String is - Result : Interfaces.C.Strings.chars_ptr := fl_menu_text2 + Result : constant Interfaces.C.Strings.chars_ptr := fl_menu_text2 (This.Void_Ptr, Interfaces.C.int (Place) - 1); begin @@ -1226,7 +1229,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return Font_Kind is - Result : Interfaces.C.int := fl_menu_get_textfont (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_get_textfont (This.Void_Ptr); begin return Font_Kind'Val (Result); exception @@ -1248,7 +1251,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return Font_Size is - Result : Interfaces.C.int := fl_menu_get_textsize (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_get_textsize (This.Void_Ptr); begin return Font_Size (Result); exception @@ -1274,7 +1277,7 @@ package body FLTK.Widgets.Menus is (This : in Menu) return Box_Kind is - Result : Interfaces.C.int := fl_menu_get_down_box (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_get_down_box (This.Void_Ptr); begin return Box_Kind'Val (Result); exception @@ -1323,7 +1326,7 @@ package body FLTK.Widgets.Menus is return Extended_Index is C_Title : aliased Interfaces.C.char_array := Interfaces.C.To_C (Title); - Ptr : Storage.Integer_Address := fl_menu_popup + Ptr : constant Storage.Integer_Address := fl_menu_popup (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1342,7 +1345,7 @@ package body FLTK.Widgets.Menus is Initial : in Extended_Index := No_Index) return Extended_Index is - Ptr : Storage.Integer_Address := fl_menu_pulldown + Ptr : constant Storage.Integer_Address := fl_menu_pulldown (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1371,7 +1374,7 @@ package body FLTK.Widgets.Menus is Require_Alt : in Boolean := False) return access FLTK.Menu_Items.Menu_Item'Class is - Tentative_Result : Storage.Integer_Address := fl_menu_find_shortcut + Tentative_Result : constant Storage.Integer_Address := fl_menu_find_shortcut (This.Void_Ptr, Null_Pointer, Boolean'Pos (Require_Alt)); @@ -1392,7 +1395,7 @@ package body FLTK.Widgets.Menus is return access FLTK.Menu_Items.Menu_Item'Class is C_Place : Interfaces.C.int; - Tentative_Result : Storage.Integer_Address := fl_menu_find_shortcut + Tentative_Result : constant Storage.Integer_Address := fl_menu_find_shortcut (This.Void_Ptr, Storage.To_Integer (C_Place'Address), Boolean'Pos (Require_Alt)); @@ -1412,7 +1415,7 @@ package body FLTK.Widgets.Menus is (This : in out Menu) return access FLTK.Menu_Items.Menu_Item'Class is - Tentative_Pick : Storage.Integer_Address := fl_menu_test_shortcut (This.Void_Ptr); + Tentative_Pick : constant Storage.Integer_Address := fl_menu_test_shortcut (This.Void_Ptr); begin if Tentative_Pick = Null_Pointer then return null; diff --git a/body/fltk-widgets-positioners.adb b/body/fltk-widgets-positioners.adb index 91e948e..29246cd 100644 --- a/body/fltk-widgets-positioners.adb +++ b/body/fltk-widgets-positioners.adb @@ -289,7 +289,7 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; X, Y : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_value + Result : constant Interfaces.C.int := fl_positioner_set_value (This.Void_Ptr, Interfaces.C.double (X), Interfaces.C.double (Y)); @@ -307,7 +307,7 @@ package body FLTK.Widgets.Positioners is X, Y : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_value + Result : constant Interfaces.C.int := fl_positioner_set_value (This.Void_Ptr, Interfaces.C.double (X), Interfaces.C.double (Y)); @@ -387,7 +387,7 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; Value : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_xvalue + Result : constant Interfaces.C.int := fl_positioner_set_xvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin @@ -404,7 +404,7 @@ package body FLTK.Widgets.Positioners is Value : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_xvalue + Result : constant Interfaces.C.int := fl_positioner_set_xvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin @@ -483,7 +483,7 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; Value : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_yvalue + Result : constant Interfaces.C.int := fl_positioner_set_yvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin @@ -500,7 +500,7 @@ package body FLTK.Widgets.Positioners is Value : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_yvalue + Result : constant Interfaces.C.int := fl_positioner_set_yvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin @@ -551,7 +551,7 @@ package body FLTK.Widgets.Positioners is X, Y, W, H : in Integer) return Event_Outcome is - Result : Interfaces.C.int := fl_positioner_handle2 + Result : constant Interfaces.C.int := fl_positioner_handle2 (This.Void_Ptr, Event_Kind'Pos (Event), Interfaces.C.int (X), diff --git a/body/fltk-widgets-progress_bars.adb b/body/fltk-widgets-progress_bars.adb index 8dc24ee..d04c275 100644 --- a/body/fltk-widgets-progress_bars.adb +++ b/body/fltk-widgets-progress_bars.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Progress_Bars is diff --git a/body/fltk-widgets-valuators-adjusters.adb b/body/fltk-widgets-valuators-adjusters.adb index 2ffad15..d740da5 100644 --- a/body/fltk-widgets-valuators-adjusters.adb +++ b/body/fltk-widgets-valuators-adjusters.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; use type diff --git a/body/fltk-widgets-valuators-counters-simple.adb b/body/fltk-widgets-valuators-counters-simple.adb index 9f41321..cd9a8f4 100644 --- a/body/fltk-widgets-valuators-counters-simple.adb +++ b/body/fltk-widgets-valuators-counters-simple.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Counters.Simple is diff --git a/body/fltk-widgets-valuators-counters.adb b/body/fltk-widgets-valuators-counters.adb index 1c5426f..f05df69 100644 --- a/body/fltk-widgets-valuators-counters.adb +++ b/body/fltk-widgets-valuators-counters.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Counters is @@ -331,7 +330,7 @@ package body FLTK.Widgets.Valuators.Counters is (This : in out Counter) return Counter_Kind is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Counter_Kind'Val (Result); exception diff --git a/body/fltk-widgets-valuators-dials-fill.adb b/body/fltk-widgets-valuators-dials-fill.adb index 44f87fe..a1d1066 100644 --- a/body/fltk-widgets-valuators-dials-fill.adb +++ b/body/fltk-widgets-valuators-dials-fill.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Dials.Fill is diff --git a/body/fltk-widgets-valuators-dials-line.adb b/body/fltk-widgets-valuators-dials-line.adb index 707b85d..8f6914c 100644 --- a/body/fltk-widgets-valuators-dials-line.adb +++ b/body/fltk-widgets-valuators-dials-line.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Dials.Line is diff --git a/body/fltk-widgets-valuators-dials.adb b/body/fltk-widgets-valuators-dials.adb index 9e2d885..43d943f 100644 --- a/body/fltk-widgets-valuators-dials.adb +++ b/body/fltk-widgets-valuators-dials.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Dials is @@ -284,7 +283,7 @@ package body FLTK.Widgets.Valuators.Dials is X, Y, W, H : in Integer) return Event_Outcome is - Result : Interfaces.C.int := fl_dial_handle2 + Result : constant Interfaces.C.int := fl_dial_handle2 (This.Void_Ptr, Event_Kind'Pos (Event), Interfaces.C.int (X), @@ -308,7 +307,7 @@ package body FLTK.Widgets.Valuators.Dials is (This : in Dial) return Dial_Kind is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Dial_Kind'Val (Result); exception diff --git a/body/fltk-widgets-valuators-rollers.adb b/body/fltk-widgets-valuators-rollers.adb index c04e274..45939fb 100644 --- a/body/fltk-widgets-valuators-rollers.adb +++ b/body/fltk-widgets-valuators-rollers.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Rollers is diff --git a/body/fltk-widgets-valuators-sliders-fill.adb b/body/fltk-widgets-valuators-sliders-fill.adb index 2cb4c18..c9b0d82 100644 --- a/body/fltk-widgets-valuators-sliders-fill.adb +++ b/body/fltk-widgets-valuators-sliders-fill.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Sliders.Fill is diff --git a/body/fltk-widgets-valuators-sliders-horizontal.adb b/body/fltk-widgets-valuators-sliders-horizontal.adb index c774a3b..1fb5114 100644 --- a/body/fltk-widgets-valuators-sliders-horizontal.adb +++ b/body/fltk-widgets-valuators-sliders-horizontal.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Sliders.Horizontal is diff --git a/body/fltk-widgets-valuators-sliders-horizontal_fill.adb b/body/fltk-widgets-valuators-sliders-horizontal_fill.adb index 6a91d4b..2ecf088 100644 --- a/body/fltk-widgets-valuators-sliders-horizontal_fill.adb +++ b/body/fltk-widgets-valuators-sliders-horizontal_fill.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Sliders.Horizontal_Fill is diff --git a/body/fltk-widgets-valuators-sliders-horizontal_nice.adb b/body/fltk-widgets-valuators-sliders-horizontal_nice.adb index e12113a..5efb3ca 100644 --- a/body/fltk-widgets-valuators-sliders-horizontal_nice.adb +++ b/body/fltk-widgets-valuators-sliders-horizontal_nice.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Sliders.Horizontal_Nice is diff --git a/body/fltk-widgets-valuators-sliders-nice.adb b/body/fltk-widgets-valuators-sliders-nice.adb index 995a585..4b24754 100644 --- a/body/fltk-widgets-valuators-sliders-nice.adb +++ b/body/fltk-widgets-valuators-sliders-nice.adb @@ -6,8 +6,7 @@ with - FLTK.Widgets.Groups, - Interfaces.C.Strings; + FLTK.Widgets.Groups; package body FLTK.Widgets.Valuators.Sliders.Nice is diff --git a/body/fltk-widgets-valuators-sliders-value-horizontal.adb b/body/fltk-widgets-valuators-sliders-value-horizontal.adb index a126b4c..9e3d946 100644 --- a/body/fltk-widgets-valuators-sliders-value-horizontal.adb +++ b/body/fltk-widgets-valuators-sliders-value-horizontal.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is diff --git a/body/fltk-widgets-valuators-sliders-value.adb b/body/fltk-widgets-valuators-sliders-value.adb index 17e9591..28a932e 100644 --- a/body/fltk-widgets-valuators-sliders-value.adb +++ b/body/fltk-widgets-valuators-sliders-value.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Sliders.Value is diff --git a/body/fltk-widgets-valuators-sliders.adb b/body/fltk-widgets-valuators-sliders.adb index 00153dc..b670ba2 100644 --- a/body/fltk-widgets-valuators-sliders.adb +++ b/body/fltk-widgets-valuators-sliders.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; package body FLTK.Widgets.Valuators.Sliders is @@ -367,7 +367,7 @@ package body FLTK.Widgets.Valuators.Sliders is (This : in Slider) return Slider_Kind is - Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); + Result : constant Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr); begin return Slider_Kind'Val (Result); exception diff --git a/body/fltk-widgets-valuators-value_inputs.adb b/body/fltk-widgets-valuators-value_inputs.adb index b107e3a..ded1096 100644 --- a/body/fltk-widgets-valuators-value_inputs.adb +++ b/body/fltk-widgets-valuators-value_inputs.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; use type diff --git a/body/fltk-widgets-valuators-value_outputs.adb b/body/fltk-widgets-valuators-value_outputs.adb index 471e58d..82259a6 100644 --- a/body/fltk-widgets-valuators-value_outputs.adb +++ b/body/fltk-widgets-valuators-value_outputs.adb @@ -7,7 +7,7 @@ with FLTK.Widgets.Groups, - Interfaces.C.Strings; + Interfaces.C; use type diff --git a/body/fltk-widgets-valuators.adb b/body/fltk-widgets-valuators.adb index 69aa150..c762fe4 100644 --- a/body/fltk-widgets-valuators.adb +++ b/body/fltk-widgets-valuators.adb @@ -210,7 +210,7 @@ package body FLTK.Widgets.Valuators is declare -- God this whole Format method is sketchy as hell. -- ...what? This is the area to declare things and that needed declaring. - String_Result : String := Ada_Obj.Format; + String_Result : constant String := Ada_Obj.Format; begin if String_Result'Length <= FLTK.Buffer_Size then Interfaces.C.Strings.Update (Buffer, 0, Interfaces.C.To_C (String_Result), False); @@ -321,7 +321,7 @@ package body FLTK.Widgets.Valuators is is Buffer : Interfaces.C.char_array := (1 .. Interfaces.C.size_t (FLTK.Buffer_Size) => Interfaces.C.To_C (Character'Val (0))); - Result : Interfaces.C.int := fl_valuator_format (This.Void_Ptr, Buffer); + Result : constant Interfaces.C.int := fl_valuator_format (This.Void_Ptr, Buffer); begin return Interfaces.C.To_Ada (Buffer (1 .. Interfaces.C.size_t (Result)), False); end Format; diff --git a/body/fltk-widgets.adb b/body/fltk-widgets.adb index f5ae433..d446a93 100644 --- a/body/fltk-widgets.adb +++ b/body/fltk-widgets.adb @@ -8,9 +8,7 @@ with Ada.Assertions, Interfaces.C.Strings, - System.Address_To_Access_Conversions, - FLTK.Widgets.Groups.Windows, - FLTK.Images; + FLTK.Widgets.Groups.Windows; use type @@ -601,7 +599,7 @@ package body FLTK.Widgets is procedure Callback_Hook (W, U : in Storage.Integer_Address) is - Ada_Widget : access Widget'Class := + Ada_Widget : constant access Widget'Class := Widget_Convert.To_Pointer (Storage.To_Address (U)); begin Ada_Widget.Callback.all (Ada_Widget.all); @@ -611,7 +609,7 @@ package body FLTK.Widgets is procedure Draw_Hook (U : in Storage.Integer_Address) is - Ada_Widget : access Widget'Class := + Ada_Widget : constant access Widget'Class := Widget_Convert.To_Pointer (Storage.To_Address (U)); begin Ada_Widget.Draw; @@ -623,7 +621,7 @@ package body FLTK.Widgets is E : in Interfaces.C.int) return Interfaces.C.int is - Ada_Widget : access Widget'Class := + Ada_Widget : constant access Widget'Class := Widget_Convert.To_Pointer (Storage.To_Address (U)); begin return Event_Outcome'Pos (Ada_Widget.Handle (Event_Kind'Val (E))); @@ -639,7 +637,7 @@ package body FLTK.Widgets is procedure Extra_Final (This : in out Widget) is - Maybe_Parent : access FLTK.Widgets.Groups.Group'Class := This.Parent; + Maybe_Parent : constant access FLTK.Widgets.Groups.Group'Class := This.Parent; begin if Maybe_Parent /= null then Maybe_Parent.Remove (This); @@ -1136,7 +1134,7 @@ package body FLTK.Widgets is (This : in Widget) return Box_Kind is - Result : Interfaces.C.int := fl_widget_get_box (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_widget_get_box (This.Void_Ptr); begin return Box_Kind'Val (Result); exception @@ -1158,7 +1156,7 @@ package body FLTK.Widgets is (This : in Widget) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_tooltip (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_widget_tooltip (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1185,7 +1183,7 @@ package body FLTK.Widgets is (This : in Widget) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_get_label (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_widget_get_label (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -1265,7 +1263,7 @@ package body FLTK.Widgets is (This : in Widget) return Label_Kind is - Result : Interfaces.C.int := fl_widget_get_labeltype (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_widget_get_labeltype (This.Void_Ptr); begin return Label_Kind'Val (Result); exception @@ -1663,7 +1661,7 @@ package body FLTK.Widgets is for my_handle'Address use This.Handle_Ptr; pragma Import (Ada, my_handle); - Result : Interfaces.C.int := my_handle (This.Void_Ptr, Event_Kind'Pos (Event)); + Result : constant Interfaces.C.int := my_handle (This.Void_Ptr, Event_Kind'Pos (Event)); begin return Event_Outcome'Val (Result); exception diff --git a/body/fltk.adb b/body/fltk.adb index c7a8fe4..49d9048 100644 --- a/body/fltk.adb +++ b/body/fltk.adb @@ -12,8 +12,7 @@ use type Interfaces.C.int, Interfaces.C.unsigned, - Interfaces.C.unsigned_char, - Interfaces.C.unsigned_long; + Interfaces.C.unsigned_char; package body FLTK is @@ -566,7 +565,7 @@ package body FLTK is (Box : in Box_Kind) return Box_Kind is - Result : Interfaces.C.int := fl_enum_box (Box_Kind'Pos (Box)); + Result : constant Interfaces.C.int := fl_enum_box (Box_Kind'Pos (Box)); begin return Box_Kind'Val (Result); exception @@ -580,7 +579,7 @@ package body FLTK is (Box : in Box_Kind) return Box_Kind is - Result : Interfaces.C.int := fl_enum_frame (Box_Kind'Pos (Box)); + Result : constant Interfaces.C.int := fl_enum_frame (Box_Kind'Pos (Box)); begin return Box_Kind'Val (Result); exception @@ -594,7 +593,7 @@ package body FLTK is (Box : in Box_Kind) return Box_Kind is - Result : Interfaces.C.int := fl_enum_down (Box_Kind'Pos (Box)); + Result : constant Interfaces.C.int := fl_enum_down (Box_Kind'Pos (Box)); begin return Box_Kind'Val (Result); exception diff --git a/fltkada.gpr b/fltkada.gpr index d09f775..3c493bb 100644 --- a/fltkada.gpr +++ b/fltkada.gpr @@ -10,13 +10,15 @@ library project FLTKAda is for Languages use ("Ada", "C++"); - for Source_Dirs use ("body", "spec"); - for Object_Dir use "obj"; - for Library_Dir use "lib"; + for Source_Dirs use ("body", "spec"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; for Library_Name use "fltkada"; for Library_Kind use "dynamic"; + package Builder renames Common.Builder; package Compiler renames Common.Compiler; + package Binder renames Common.Binder; end FLTKAda; diff --git a/proj/common.gpr b/proj/common.gpr index 64c4dc1..c4bea2f 100644 --- a/proj/common.gpr +++ b/proj/common.gpr @@ -3,12 +3,101 @@ abstract project Common is + type Build_Kind is ("release", "debug"); + + Ver : Build_Kind := external ("build", "release"); + + + package Builder is + for Default_Switches ("Ada") use ("-j4", "-m"); + for Global_Compilation_Switches ("Ada") use ("-shared"); + + case Ver is + + when "release" => + null; + + when "debug" => + for Default_Switches ("Ada") use Builder'Default_Switches ("Ada") & "-g"; + + end case; + end Builder; + + + Ada_Common := + ("-gnaty" + & "4" -- indentation + & "a" -- attribute casing + & "A" -- array attribute indices + & "b" -- blanks at end of lines + & "c" -- two space comments + & "e" -- end/exit labels + & "f" -- no form feeds or vertical tabs + & "h" -- no horizontal tabs + & "i" -- if/then layout + & "k" -- keyword casing + & "l" -- reference manual layout + & "M100" -- max line length + & "n" -- package Standard casing + & "p" -- pragma casing + & "r" -- identifier casing + & "t", -- token separation + "-gnatw" + & "a" -- various warning modes + & "F" -- don't check for unreferenced formal parameters + & "J" -- don't check for obsolescent feature use + & "U"); -- don't check for unused entities + + CPP_Common := + ("-Wall", + "-Werror", + "-Wextra", + "-Wpedantic", + "-std=c++11"); + package Compiler is - for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt"); - for Default_Switches("C++") use ("-Wall","-Wextra","-std=c++11"); + case Ver is + + when "release" => + for Default_Switches ("Ada") use Ada_Common & "-O3" & "-Os" & "-gnatn"; + for Default_Switches ("C++") use CPP_Common & "-O3" & "-Os"; + + when "debug" => + for Default_Switches ("Ada") use Ada_Common & "-O0" & "-gnata" & "-gnato" & "-g"; + for Default_Switches ("C++") use CPP_Common & "-O0"; + + end case; end Compiler; + package Binder is + for Default_Switches ("Ada") use ("-shared"); + + case Ver is + + when "release" => + null; + + when "debug" => + for Default_Switches ("Ada") use Binder'Default_Switches ("Ada") & "-E"; + + end case; + end Binder; + + + package Linker is + case Ver is + + when "release" => + null; + + when "debug" => + for Default_Switches ("Ada") use ("-g"); + + end case; + end Linker; + + end Common; diff --git a/spec/fltk-environment.ads b/spec/fltk-environment.ads index d4a1322..9ab7f7c 100644 --- a/spec/fltk-environment.ads +++ b/spec/fltk-environment.ads @@ -317,7 +317,6 @@ private pragma Convention (C, Binary_Data); - pragma Pack (Binary_Data); for Binary_Data'Component_Size use Interfaces.C.CHAR_BIT; diff --git a/spec/fltk-widgets-groups-windows.ads b/spec/fltk-widgets-groups-windows.ads index dfa51d6..e2f9b3e 100644 --- a/spec/fltk-widgets-groups-windows.ads +++ b/spec/fltk-widgets-groups-windows.ads @@ -8,10 +8,6 @@ with FLTK.Images.RGB; -private with - - Interfaces.C.Strings; - package FLTK.Widgets.Groups.Windows is diff --git a/spec/fltk-widgets-inputs.ads b/spec/fltk-widgets-inputs.ads index 12fcb77..6de80da 100644 --- a/spec/fltk-widgets-inputs.ads +++ b/spec/fltk-widgets-inputs.ads @@ -10,8 +10,7 @@ limited with private with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; package FLTK.Widgets.Inputs is diff --git a/spec/fltk-widgets-menus-menu_buttons.ads b/spec/fltk-widgets-menus-menu_buttons.ads index 033e3e5..7a93a6d 100644 --- a/spec/fltk-widgets-menus-menu_buttons.ads +++ b/spec/fltk-widgets-menus-menu_buttons.ads @@ -4,10 +4,6 @@ -- Released into the public domain -with - - FLTK.Menu_Items; - limited with FLTK.Widgets.Groups; diff --git a/spec/fltk.ads b/spec/fltk.ads index 2a38434..f5add9b 100644 --- a/spec/fltk.ads +++ b/spec/fltk.ads @@ -593,7 +593,6 @@ private for Color_Component_Array'Component_Size use Interfaces.C.CHAR_BIT; pragma Convention (C, Color_Component_Array); - pragma Pack (Color_Component_Array); diff --git a/test/animated.adb b/test/animated.adb index 42d2a49..4a5b570 100644 --- a/test/animated.adb +++ b/test/animated.adb @@ -130,7 +130,7 @@ is Frame_Image_Data : constant Image_Data_Array := Make_Image_Data; -- This syntax requires Ada 2022, but it allows all overt heap usage to be avoided - Frame_Images : array (Positive range <>) of RGB.RGB_Image := + Frame_Images : constant array (Positive range <>) of RGB.RGB_Image := (for Index in Frame_Image_Data'Range => RGB.Forge.Create (Frame_Image_Data (Index), Dimension, Dimension, Channels)); diff --git a/test/ask.adb b/test/ask.adb index cb12fff..81ab104 100644 --- a/test/ask.adb +++ b/test/ask.adb @@ -16,7 +16,6 @@ with FLTK.Widgets.Boxes, FLTK.Widgets.Buttons, FLTK.Widgets.Buttons.Enter, - FLTK.Widgets.Inputs.Text, FLTK.Widgets.Groups.Windows.Double; use type @@ -38,7 +37,6 @@ is package BX renames FLTK.Widgets.Boxes; package BTN renames FLTK.Widgets.Buttons; package ENT renames FLTK.Widgets.Buttons.Enter; - package INP renames FLTK.Widgets.Inputs.Text; package WD renames FLTK.Widgets.Groups.Windows.Double; @@ -54,7 +52,7 @@ is procedure Rename_Me (Item : in out FLTK.Widgets.Widget'Class) is - Input : String := AK.Text_Input ("Input:", Item.Get_Label); + Input : constant String := AK.Text_Input ("Input:", Item.Get_Label); begin Update_Input_Text (Item, Input); end Rename_Me; @@ -63,7 +61,7 @@ is procedure Rename_Me_Pwd (Item : in out FLTK.Widgets.Widget'Class) is - Input : String := AK.Password ("Input PWD:", Item.Get_Label); + Input : constant String := AK.Password ("Input PWD:", Item.Get_Label); begin Update_Input_Text (Item, Input); end Rename_Me_Pwd; @@ -72,7 +70,7 @@ is procedure Window_Callback (Item : in out FLTK.Widgets.Widget'Class) is - Hotspot : Boolean := AK.Get_Message_Hotspot; + Hotspot : constant Boolean := AK.Get_Message_Hotspot; Reply : AK.Choice_Result; begin AK.Set_Message_Hotspot (False); @@ -91,7 +89,7 @@ is Stop : Boolean := False; procedure Timer_Callback is - Message_Icon : BX.Box_Reference := AK.Get_Message_Icon; + Message_Icon : constant BX.Box_Reference := AK.Get_Message_Icon; My_Color : FLTK.Color; begin if Stop then diff --git a/test/bitmap.adb b/test/bitmap.adb index 86c1406..04f4793 100644 --- a/test/bitmap.adb +++ b/test/bitmap.adb @@ -117,7 +117,7 @@ is procedure Button_Callback - (Item : in out FLTK.Widgets.Widget'Class) + (Ignore : in out FLTK.Widgets.Widget'Class) is New_Align : FLTK.Alignment; begin diff --git a/test/button.adb b/test/button.adb index 9ca6102..1cd6557 100644 --- a/test/button.adb +++ b/test/button.adb @@ -29,7 +29,7 @@ is procedure Beep_Callback - (This : in out Wdg.Widget'Class) is + (Ignore : in out Wdg.Widget'Class) is begin Ask.Beep; end Beep_Callback; @@ -39,7 +39,7 @@ is procedure Exit_Callback - (This : in out Wdg.Widget'Class) is + (Ignore : in out Wdg.Widget'Class) is begin ACom.Set_Exit_Status (ACom.Success); The_Window.Hide; diff --git a/test/buttons.adb b/test/buttons.adb index e93da8e..a502f44 100644 --- a/test/buttons.adb +++ b/test/buttons.adb @@ -9,7 +9,6 @@ with - FLTK.Tooltips, FLTK.Widgets.Buttons.Enter, FLTK.Widgets.Buttons.Light.Check, FLTK.Widgets.Buttons.Light.Round, diff --git a/test/clock.adb b/test/clock.adb index b4d8f40..e550941 100644 --- a/test/clock.adb +++ b/test/clock.adb @@ -23,11 +23,11 @@ is package WD renames FLTK.Widgets.Groups.Windows.Double; - Window_One : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Clock"); - Clock_One : CL.Updated_Clock := CL.Forge.Create (Window_One, 0, 0, 220, 220); + Window_One : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Clock"); + Clock_One : constant CL.Updated_Clock := CL.Forge.Create (Window_One, 0, 0, 220, 220); - Window_Two : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Round_Clock"); - Clock_Two : CR.Round_Clock := CR.Forge.Create (Window_Two, 0, 0, 220, 220); + Window_Two : WD.Double_Window := WD.Forge.Create (220, 220, "Fl_Round_Clock"); + Clock_Two : constant CR.Round_Clock := CR.Forge.Create (Window_Two, 0, 0, 220, 220); begin diff --git a/test/color_chooser.adb b/test/color_chooser.adb index 09003b9..b77283c 100644 --- a/test/color_chooser.adb +++ b/test/color_chooser.adb @@ -66,7 +66,8 @@ is Image_Width, Image_Height : constant Natural := 100; - The_Image_Data : FLTK.Color_Component_Array := Make_Image_Data (Image_Width, Image_Height); + The_Image_Data : constant FLTK.Color_Component_Array := + Make_Image_Data (Image_Width, Image_Height); type Pens is new Bx.Box with null record; @@ -108,7 +109,7 @@ is procedure Callback_One - (This : in out FLTK.Widgets.Widget'Class) is + (Ignore : in out FLTK.Widgets.Widget'Class) is begin My_Color := Ask.Show_Colormap (My_Color); The_Box.Set_Background_Color (My_Color); @@ -118,7 +119,7 @@ is procedure Callback_Two - (This : in out FLTK.Widgets.Widget'Class) + (Ignore : in out FLTK.Widgets.Widget'Class) is R, G, B : FLTK.Color_Component; begin diff --git a/test/compare.adb b/test/compare.adb index 2273414..a631416 100644 --- a/test/compare.adb +++ b/test/compare.adb @@ -15,11 +15,11 @@ procedure Compare is package TIO renames Ada.Text_IO; package FFN renames FLTK.Filenames; - Aardvark : String := "aardvark"; - Zebra : String := "Zebra"; - Two : String := "item_2"; - Ten : String := "item_10"; - Cap_Ten : String := "Item_10"; + Aardvark : constant String := "aardvark"; + Zebra : constant String := "Zebra"; + Two : constant String := "item_2"; + Ten : constant String := "item_10"; + Cap_Ten : constant String := "Item_10"; begin diff --git a/test/dirlist.adb b/test/dirlist.adb index 1a07515..a7c159a 100644 --- a/test/dirlist.adb +++ b/test/dirlist.adb @@ -39,7 +39,7 @@ begin end if; declare - Name : Fil.Path_String := Fil.Expand (ACom.Argument (1)); + Name : constant Fil.Path_String := Fil.Expand (ACom.Argument (1)); begin if not Fil.Is_Directory (Name) then TIO.Put_Line ("Error: " & Name & " is not a valid directory."); @@ -48,7 +48,7 @@ begin end if; declare - The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Alpha_Sort'Access); + The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Alpha_Sort'Access); begin TIO.Put_Line ("Alphabetical Sort:"); for Index in 1 .. The_List.Length loop @@ -58,7 +58,7 @@ begin end; declare - The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Alpha_Sort'Access); + The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Alpha_Sort'Access); begin TIO.Put_Line ("Case Insensitive Alphabetical Sort:"); for Index in 1 .. The_List.Length loop @@ -68,7 +68,7 @@ begin end; declare - The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Numeric_Sort'Access); + The_List : constant Fil.File_List := Fil.Get_Listing (Name, Fil.Numeric_Sort'Access); begin TIO.Put_Line ("Numeric Sort:"); for Index in 1 .. The_List.Length loop @@ -78,7 +78,8 @@ begin end; declare - The_List : Fil.File_List := Fil.Get_Listing (Name, Fil.Case_Numeric_Sort'Access); + The_List : constant Fil.File_List := + Fil.Get_Listing (Name, Fil.Case_Numeric_Sort'Access); begin TIO.Put_Line ("Case Insensitive Numeric Sort:"); for Index in 1 .. The_List.Length loop diff --git a/test/filename.adb b/test/filename.adb new file mode 100644 index 0000000..937fba4 --- /dev/null +++ b/test/filename.adb @@ -0,0 +1,40 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Command_Line, + Ada.Text_IO, + FLTK.Filenames; + + +procedure Filename is + + package ACom renames Ada.Command_Line; + package TIO renames Ada.Text_IO; + package Fil renames FLTK.Filenames; + +begin + + TIO.Put_Line ("Test program for FLTK filename absolute and expand functions."); + TIO.New_Line; + TIO.Put ("Input: "); + + if ACom.Argument_Count /= 1 then + TIO.Put_Line ("Error: Need exactly one filename argument."); + ACom.Set_Exit_Status (ACom.Failure); + return; + end if; + + TIO.Put_Line (ACom.Argument (1)); + TIO.New_Line; + + TIO.Put_Line ("Absolute: " & Fil.Absolute (ACom.Argument (1))); + TIO.Put_Line ("Expanded: " & Fil.Expand (ACom.Argument (1))); + +end Filename; + + diff --git a/test/pixmap.adb b/test/pixmap.adb index 0ca3982..a9cf6b7 100644 --- a/test/pixmap.adb +++ b/test/pixmap.adb @@ -34,15 +34,15 @@ is package WD renames FLTK.Widgets.Groups.Windows.Double; - Porsche_Header : Pix.Header := (64, 64, 4, 1); + Porsche_Header : constant Pix.Header := (64, 64, 4, 1); - Porsche_Colors : Pix.Color_Definition_Array := + Porsche_Colors : constant Pix.Color_Definition_Array := ((Name => +" ", Kind => Pix.Colorful, Value => +"#background"), (Name => +".", Kind => Pix.Colorful, Value => +"#000000000000"), (Name => +"X", Kind => Pix.Colorful, Value => +"#ffd100"), (Name => +"o", Kind => Pix.Colorful, Value => +"#FFFF00000000")); - Porsche_Data : Pix.Pixmap_Data := + Porsche_Data : constant Pix.Pixmap_Data := (" ", " .......................... ", " ..................................... ", @@ -126,7 +126,7 @@ is procedure Button_Callback - (Item : in out FLTK.Widgets.Widget'Class) + (Ignore : in out FLTK.Widgets.Widget'Class) is New_Align : FLTK.Alignment; begin @@ -12,8 +12,8 @@ project Tests is for Languages use ("Ada"); for Source_Dirs use ("test"); - for Object_Dir use "obj"; - for Exec_Dir use "bin"; + for Object_Dir use "obj"; + for Exec_Dir use "bin"; for Main use ("adjuster.adb", @@ -26,6 +26,7 @@ project Tests is "color_chooser.adb", "cursor.adb", "dirlist.adb", + "filename.adb", "hello.adb", "page_formats.adb", "pixmap.adb"); @@ -41,12 +42,20 @@ project Tests is for Executable ("color_chooser.adb") use "color_chooser"; for Executable ("cursor.adb") use "cursor"; for Executable ("dirlist.adb") use "dirlist"; + for Executable ("filename.adb") use "filename"; for Executable ("hello.adb") use "hello"; for Executable ("page_formats.adb") use "page_formats"; for Executable ("pixmap.adb") use "pixmap"; + + for Default_Switches ("Ada") use + Common.Builder'Default_Switches ("Ada"); + for Global_Compilation_Switches ("Ada") use + Common.Builder'Global_Compilation_Switches ("Ada"); end Builder; package Compiler renames Common.Compiler; + package Binder renames Common.Binder; + package Linker renames Common.Linker; end Tests; diff --git a/tests_2022.gpr b/tests_2022.gpr index 84ed425..3c3fd92 100644 --- a/tests_2022.gpr +++ b/tests_2022.gpr @@ -12,8 +12,8 @@ project Tests_2022 is for Languages use ("Ada"); for Source_Dirs use ("test"); - for Object_Dir use "obj"; - for Exec_Dir use "bin"; + for Object_Dir use "obj"; + for Exec_Dir use "bin"; for Main use ("animated.adb", @@ -24,9 +24,16 @@ project Tests_2022 is for Executable ("animated.adb") use "animated"; for Executable ("arc.adb") use "arc"; for Executable ("curve.adb") use "curve"; + + for Default_Switches ("Ada") use + Common.Builder'Default_Switches ("Ada"); + for Global_Compilation_Switches ("Ada") use + Common.Builder'Global_Compilation_Switches ("Ada"); end Builder; package Compiler renames Common.Compiler; + package Binder renames Common.Binder; + package Linker renames Common.Linker; end Tests_2022; diff --git a/tool/template.adb b/tool/template.adb index a28fff8..4da7da6 100644 --- a/tool/template.adb +++ b/tool/template.adb @@ -19,7 +19,6 @@ with - Ada.Characters.Latin_1, Ada.Command_Line, Ada.Containers.Indefinite_Ordered_Maps, Ada.Direct_IO, @@ -32,7 +31,6 @@ with procedure Template is - package Latin renames Ada.Characters.Latin_1; package ACom renames Ada.Command_Line; package ADir renames Ada.Directories; package SMap renames Ada.Strings.Maps; @@ -11,16 +11,23 @@ project Tools is for Languages use ("Ada"); for Source_Dirs use ("tool"); - for Object_Dir use "obj"; - for Exec_Dir use "bin"; + for Object_Dir use "obj"; + for Exec_Dir use "bin"; for Main use ("template.adb"); package Builder is for Executable ("template.adb") use "template"; + + for Default_Switches ("Ada") use + Common.Builder'Default_Switches ("Ada"); + for Global_Compilation_Switches ("Ada") use + Common.Builder'Global_Compilation_Switches ("Ada"); end Builder; package Compiler renames Common.Compiler; + package Binder renames Common.Binder; + package Linker renames Common.Linker; end Tools; |