From b4438b2fbe895694be98e6e8426103deefc51448 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 21 Jan 2025 21:04:54 +1300 Subject: Split public API and private implementation files into different directories --- body/fltk-text_buffers.adb | 1352 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1352 insertions(+) create mode 100644 body/fltk-text_buffers.adb (limited to 'body/fltk-text_buffers.adb') diff --git a/body/fltk-text_buffers.adb b/body/fltk-text_buffers.adb new file mode 100644 index 0000000..1afa2a7 --- /dev/null +++ b/body/fltk-text_buffers.adb @@ -0,0 +1,1352 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings, + Ada.Strings.Unbounded, + Ada.Containers; + +use + + Ada.Strings.Unbounded; + +use type + + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, + Ada.Containers.Count_Type; + + +package body FLTK.Text_Buffers is + + + function strerror + (Errnum : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, strerror, "strerror"); + + + + + function new_fl_text_buffer + (RS, PGS : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); + pragma Inline (new_fl_text_buffer); + + procedure free_fl_text_buffer + (TB : in Storage.Integer_Address); + pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); + pragma Inline (free_fl_text_buffer); + + + + + procedure fl_text_buffer_add_modify_callback + (TB, CB, UD : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_add_modify_callback, + "fl_text_buffer_add_modify_callback"); + pragma Inline (fl_text_buffer_add_modify_callback); + + procedure fl_text_buffer_add_predelete_callback + (TB, CB, UD : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_add_predelete_callback, + "fl_text_buffer_add_predelete_callback"); + pragma Inline (fl_text_buffer_add_predelete_callback); + + procedure fl_text_buffer_call_modify_callbacks + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_call_modify_callbacks, + "fl_text_buffer_call_modify_callbacks"); + pragma Inline (fl_text_buffer_call_modify_callbacks); + + procedure fl_text_buffer_call_predelete_callbacks + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_call_predelete_callbacks, + "fl_text_buffer_call_predelete_callbacks"); + pragma Inline (fl_text_buffer_call_predelete_callbacks); + + + + + function fl_text_buffer_loadfile + (TB : in Storage.Integer_Address; + N : in Interfaces.C.char_array; + B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); + pragma Inline (fl_text_buffer_loadfile); + + function fl_text_buffer_appendfile + (TB : in Storage.Integer_Address; + N : in Interfaces.C.char_array; + B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_appendfile, "fl_text_buffer_appendfile"); + pragma Inline (fl_text_buffer_appendfile); + + function fl_text_buffer_insertfile + (TB : in Storage.Integer_Address; + N : in Interfaces.C.char_array; + P, B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_insertfile, "fl_text_buffer_insertfile"); + pragma Inline (fl_text_buffer_insertfile); + + function fl_text_buffer_outputfile + (TB : in Storage.Integer_Address; + N : in Interfaces.C.char_array; + F, T : in Interfaces.C.int; + B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_outputfile, "fl_text_buffer_outputfile"); + pragma Inline (fl_text_buffer_outputfile); + + function fl_text_buffer_savefile + (TB : in Storage.Integer_Address; + N : in Interfaces.C.char_array; + B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); + pragma Inline (fl_text_buffer_savefile); + + + + + procedure fl_text_buffer_insert + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int; + I : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); + pragma Inline (fl_text_buffer_insert); + + procedure fl_text_buffer_append + (TB : in Storage.Integer_Address; + I : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_append, "fl_text_buffer_append"); + pragma Inline (fl_text_buffer_append); + + procedure fl_text_buffer_replace + (TB : in Storage.Integer_Address; + S, F : in Interfaces.C.int; + T : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_replace, "fl_text_buffer_replace"); + pragma Inline (fl_text_buffer_replace); + + procedure fl_text_buffer_remove + (TB : in Storage.Integer_Address; + S, F : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); + pragma Inline (fl_text_buffer_remove); + + function fl_text_buffer_get_text + (TB : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_get_text, "fl_text_buffer_get_text"); + pragma Inline (fl_text_buffer_get_text); + + procedure fl_text_buffer_set_text + (TB : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_set_text, "fl_text_buffer_set_text"); + pragma Inline (fl_text_buffer_set_text); + + function fl_text_buffer_byte_at + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.char; + pragma Import (C, fl_text_buffer_byte_at, "fl_text_buffer_byte_at"); + pragma Inline (fl_text_buffer_byte_at); + + function fl_text_buffer_char_at + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); + pragma Inline (fl_text_buffer_char_at); + + function fl_text_buffer_text_range + (TB : in Storage.Integer_Address; + S, F : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); + pragma Inline (fl_text_buffer_text_range); + + function fl_text_buffer_next_char + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_next_char, "fl_text_buffer_next_char"); + pragma Inline (fl_text_buffer_next_char); + + function fl_text_buffer_prev_char + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_prev_char, "fl_text_buffer_prev_char"); + pragma Inline (fl_text_buffer_prev_char); + + + + + function fl_text_buffer_count_displayed_characters + (TB : in Storage.Integer_Address; + S, F : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_count_displayed_characters, + "fl_text_buffer_count_displayed_characters"); + pragma Inline (fl_text_buffer_count_displayed_characters); + + function fl_text_buffer_count_lines + (TB : in Storage.Integer_Address; + S, F : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_count_lines, "fl_text_buffer_count_lines"); + pragma Inline (fl_text_buffer_count_lines); + + function fl_text_buffer_length + (TB : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); + pragma Inline (fl_text_buffer_length); + + function fl_text_buffer_get_tab_distance + (TB : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_get_tab_distance, "fl_text_buffer_get_tab_distance"); + pragma Inline (fl_text_buffer_get_tab_distance); + + procedure fl_text_buffer_set_tab_distance + (TB : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_set_tab_distance, "fl_text_buffer_set_tab_distance"); + pragma Inline (fl_text_buffer_set_tab_distance); + + + + + function fl_text_buffer_selection_position + (TB : in Storage.Integer_Address; + S, E : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); + pragma Inline (fl_text_buffer_selection_position); + + function fl_text_buffer_secondary_selection_position + (TB : in Storage.Integer_Address; + S, E : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_secondary_selection_position, + "fl_text_buffer_secondary_selection_position"); + pragma Inline (fl_text_buffer_secondary_selection_position); + + procedure fl_text_buffer_select + (TB : in Storage.Integer_Address; + S, E : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); + pragma Inline (fl_text_buffer_select); + + procedure fl_text_buffer_secondary_select + (TB : in Storage.Integer_Address; + S, E : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_secondary_select, "fl_text_buffer_secondary_select"); + pragma Inline (fl_text_buffer_secondary_select); + + function fl_text_buffer_selected + (TB : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); + pragma Inline (fl_text_buffer_selected); + + function fl_text_buffer_secondary_selected + (TB : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_secondary_selected, "fl_text_buffer_secondary_selected"); + pragma Inline (fl_text_buffer_secondary_selected); + + function fl_text_buffer_selection_text + (TB : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_selection_text, "fl_text_buffer_selection_text"); + pragma Inline (fl_text_buffer_selection_text); + + function fl_text_buffer_secondary_selection_text + (TB : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_secondary_selection_text, + "fl_text_buffer_secondary_selection_text"); + pragma Inline (fl_text_buffer_secondary_selection_text); + + procedure fl_text_buffer_replace_selection + (TB : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_replace_selection, "fl_text_buffer_replace_selection"); + pragma Inline (fl_text_buffer_replace_selection); + + procedure fl_text_buffer_replace_secondary_selection + (TB : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_replace_secondary_selection, + "fl_text_buffer_replace_secondary_selection"); + pragma Inline (fl_text_buffer_replace_secondary_selection); + + procedure fl_text_buffer_remove_selection + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); + pragma Inline (fl_text_buffer_remove_selection); + + procedure fl_text_buffer_remove_secondary_selection + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_remove_secondary_selection, + "fl_text_buffer_remove_secondary_selection"); + pragma Inline (fl_text_buffer_remove_secondary_selection); + + procedure fl_text_buffer_unselect + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_unselect, "fl_text_buffer_unselect"); + pragma Inline (fl_text_buffer_unselect); + + procedure fl_text_buffer_secondary_unselect + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_secondary_unselect, "fl_text_buffer_secondary_unselect"); + pragma Inline (fl_text_buffer_secondary_unselect); + + + + + procedure fl_text_buffer_highlight + (TB : in Storage.Integer_Address; + F, T : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_highlight, "fl_text_buffer_highlight"); + pragma Inline (fl_text_buffer_highlight); + + function fl_text_buffer_highlight_text + (TB : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_highlight_text, "fl_text_buffer_highlight_text"); + pragma Inline (fl_text_buffer_highlight_text); + + procedure fl_text_buffer_unhighlight + (TB : in Storage.Integer_Address); + pragma Import (C, fl_text_buffer_unhighlight, "fl_text_buffer_unhighlight"); + pragma Inline (fl_text_buffer_unhighlight); + + + + + function fl_text_buffer_findchar_forward + (TB : in Storage.Integer_Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.unsigned; + FP : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_findchar_forward, "fl_text_buffer_findchar_forward"); + pragma Inline (fl_text_buffer_findchar_forward); + + function fl_text_buffer_findchar_backward + (TB : in Storage.Integer_Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.unsigned; + FP : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_findchar_backward, "fl_text_buffer_findchar_backward"); + pragma Inline (fl_text_buffer_findchar_backward); + + function fl_text_buffer_search_forward + (TB : in Storage.Integer_Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); + pragma Inline (fl_text_buffer_search_forward); + + function fl_text_buffer_search_backward + (TB : in Storage.Integer_Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); + pragma Inline (fl_text_buffer_search_backward); + + + + + function fl_text_buffer_word_start + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_word_start, "fl_text_buffer_word_start"); + pragma Inline (fl_text_buffer_word_start); + + function fl_text_buffer_word_end + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_word_end, "fl_text_buffer_word_end"); + pragma Inline (fl_text_buffer_word_end); + + function fl_text_buffer_line_start + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_line_start, "fl_text_buffer_line_start"); + pragma Inline (fl_text_buffer_line_start); + + function fl_text_buffer_line_end + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_line_end, "fl_text_buffer_line_end"); + pragma Inline (fl_text_buffer_line_end); + + function fl_text_buffer_line_text + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_line_text, "fl_text_buffer_line_text"); + pragma Inline (fl_text_buffer_line_text); + + function fl_text_buffer_skip_lines + (TB : in Storage.Integer_Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); + pragma Inline (fl_text_buffer_skip_lines); + + function fl_text_buffer_rewind_lines + (TB : in Storage.Integer_Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); + pragma Inline (fl_text_buffer_rewind_lines); + + function fl_text_buffer_skip_displayed_characters + (TB : in Storage.Integer_Address; + S, N : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_skip_displayed_characters, + "fl_text_buffer_skip_displayed_characters"); + pragma Inline (fl_text_buffer_skip_displayed_characters); + + + + + procedure fl_text_buffer_canundo + (TB : in Storage.Integer_Address; + F : in Interfaces.C.char); + pragma Import (C, fl_text_buffer_canundo, "fl_text_buffer_canundo"); + pragma Inline (fl_text_buffer_canundo); + + procedure fl_text_buffer_copy + (TB, TB2 : in Storage.Integer_Address; + S, F, I : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_copy, "fl_text_buffer_copy"); + pragma Inline (fl_text_buffer_copy); + + function fl_text_buffer_utf8_align + (TB : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_utf8_align, "fl_text_buffer_utf8_align"); + pragma Inline (fl_text_buffer_utf8_align); + + + + + procedure Modify_Callback_Hook + (Pos : in Interfaces.C.int; + Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in Storage.Integer_Address) + is + Action : Modification; + Place : Position := Position (Pos); + Length : Natural; + Deleted_Text : Unbounded_String := To_Unbounded_String (""); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); + begin + if Ada_Text_Buffer.CB_Active then + if Inserted > 0 then + Length := Natural (Inserted); + Action := Insert; + elsif Deleted > 0 then + Length := Natural (Deleted); + Action := Delete; + if Text /= Interfaces.C.Strings.Null_Ptr then + Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); + end if; + elsif Restyled > 0 then + Length := Natural (Restyled); + Action := Restyle; + else + Length := 0; + Action := None; + end if; + + for CB of Ada_Text_Buffer.Modify_CBs loop + CB.all (Action, Place, Length, To_String (Deleted_Text)); + end loop; + end if; + end Modify_Callback_Hook; + + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in Storage.Integer_Address) + is + Place : Position := Position (Pos); + Length : Natural := Natural (Deleted); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); + begin + if Ada_Text_Buffer.CB_Active then + for CB of Ada_Text_Buffer.Predelete_CBs loop + CB.all (Place, Length); + end loop; + end if; + end Predelete_Callback_Hook; + + + + + procedure Finalize + (This : in out Text_Buffer) is + begin + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_text_buffer (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + package body Forge is + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer is + begin + return This : Text_Buffer do + This.Void_Ptr := new_fl_text_buffer + (Interfaces.C.int (Requested_Size), + Interfaces.C.int (Preferred_Gap_Size)); + fl_text_buffer_add_modify_callback + (This.Void_Ptr, + Storage.To_Integer (Modify_Callback_Hook'Address), + Storage.To_Integer (This'Address)); + fl_text_buffer_add_predelete_callback + (This.Void_Ptr, + Storage.To_Integer (Predelete_Callback_Hook'Address), + Storage.To_Integer (This'Address)); + end return; + end Create; + + end Forge; + + + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback) is + begin + This.Modify_CBs.Append (Func); + end Add_Modify_Callback; + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback) is + begin + This.Predelete_CBs.Append (Func); + end Add_Predelete_Callback; + + + procedure Remove_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback) is + begin + for I in reverse This.Modify_CBs.First_Index .. This.Modify_CBs.Last_Index loop + if This.Modify_CBs.Element (I) = Func then + This.Modify_CBs.Delete (I); + return; + end if; + end loop; + end Remove_Modify_Callback; + + + procedure Remove_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback) is + begin + for I in reverse This.Predelete_CBs.First_Index .. This.Predelete_CBs.Last_Index loop + if This.Predelete_CBs.Element (I) = Func then + This.Predelete_CBs.Delete (I); + return; + end if; + end loop; + end Remove_Predelete_Callback; + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_modify_callbacks (This.Void_Ptr); + end Call_Modify_Callbacks; + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); + end Call_Predelete_Callbacks; + + + procedure Enable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := True; + end Enable_Callbacks; + + + procedure Disable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := False; + end Disable_Callbacks; + + + + + procedure Load_File + (This : in out Text_Buffer; + 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)); + begin + if Err_No /= 0 then + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); + end if; + end Load_File; + + + procedure Append_File + (This : in out Text_Buffer; + Name : in String; + Buffer : in Natural := 128 * 1024) + is + Err_No : Interfaces.C.int := fl_text_buffer_appendfile + (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)); + end if; + end Append_File; + + + procedure Insert_File + (This : in out Text_Buffer; + Name : in String; + Place : in Position; + Buffer : in Natural := 128 * 1024) + is + Err_No : Interfaces.C.int := fl_text_buffer_insertfile + (This.Void_Ptr, + Interfaces.C.To_C (Name), + Interfaces.C.int (Place), + Interfaces.C.int (Buffer)); + begin + if Err_No /= 0 then + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); + end if; + end Insert_File; + + + procedure Output_File + (This : in Text_Buffer; + Name : in String; + Start, Finish : in Position; + Buffer : in Natural := 128 * 1024) + is + Err_No : Interfaces.C.int := fl_text_buffer_outputfile + (This.Void_Ptr, + Interfaces.C.To_C (Name), + Interfaces.C.int (Start), + Interfaces.C.int (Finish), + Interfaces.C.int (Buffer)); + begin + if Err_No /= 0 then + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); + end if; + end Output_File; + + + procedure Save_File + (This : in Text_Buffer; + 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)); + begin + if Err_No /= 0 then + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); + end if; + end Save_File; + + + + + procedure Insert_Text + (This : in out Text_Buffer; + Place : in Position; + Text : in String) is + begin + fl_text_buffer_insert + (This.Void_Ptr, + Interfaces.C.int (Place), + Interfaces.C.To_C (Text)); + end Insert_Text; + + + procedure Append_Text + (This : in out Text_Buffer; + Text : in String) is + begin + fl_text_buffer_append + (This.Void_Ptr, + Interfaces.C.To_C (Text)); + end Append_Text; + + + procedure Replace_Text + (This : in out Text_Buffer; + Start, Finish : in Position; + Text : in String) is + begin + fl_text_buffer_replace + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish), + Interfaces.C.To_C (Text)); + end Replace_Text; + + + procedure Remove_Text + (This : in out Text_Buffer; + Start, Finish : in Position) is + begin + fl_text_buffer_remove + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Remove_Text; + + + function Get_Entire_Text + (This : in Text_Buffer) + return String + is + Raw : Interfaces.C.Strings.chars_ptr := + fl_text_buffer_get_text (This.Void_Ptr); + begin + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; + end Get_Entire_Text; + + + procedure Set_Entire_Text + (This : in out Text_Buffer; + Text : in String) is + begin + fl_text_buffer_set_text (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Entire_Text; + + + function Byte_At + (This : in Text_Buffer; + Place : in Position) + return Character is + begin + return Character'Val (Interfaces.C.char'Pos + (fl_text_buffer_byte_at (This.Void_Ptr, Interfaces.C.int (Place)))); + end Byte_At; + + + function Character_At + (This : in Text_Buffer; + Place : in Position) + return Character is + begin + return Character'Val (fl_text_buffer_char_at + (This.Void_Ptr, + Interfaces.C.int (Place))); + end Character_At; + + + function Text_At + (This : in Text_Buffer; + Start, Finish : in Position) + 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)); + begin + if C_Str = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + The_Text : String := Interfaces.C.Strings.Value (C_Str); + begin + Interfaces.C.Strings.Free (C_Str); + return The_Text; + end; + end if; + end Text_At; + + + function Next_Char + (This : in Text_Buffer; + Place : in Position) + return Character is + begin + return Character'Val (fl_text_buffer_next_char + (This.Void_Ptr, + Interfaces.C.int (Place))); + end Next_Char; + + + function Prev_Char + (This : in Text_Buffer; + Place : in Position) + return Character is + begin + return Character'Val (fl_text_buffer_prev_char + (This.Void_Ptr, + Interfaces.C.int (Place))); + end Prev_Char; + + + + + function Count_Displayed_Characters + (This : in Text_Buffer; + Start, Finish : in Position) + return Integer is + begin + return Integer (fl_text_buffer_count_displayed_characters + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish))); + end Count_Displayed_Characters; + + + function Count_Lines + (This : in Text_Buffer; + Start, Finish : in Position) + return Integer is + begin + return Integer (fl_text_buffer_count_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish))); + end Count_Lines; + + + function Length + (This : in Text_Buffer) + return Natural is + begin + return Natural (fl_text_buffer_length (This.Void_Ptr)); + end Length; + + + function Get_Tab_Width + (This : in Text_Buffer) + return Natural is + begin + return Natural (fl_text_buffer_get_tab_distance (This.Void_Ptr)); + end Get_Tab_Width; + + + procedure Set_Tab_Width + (This : in out Text_Buffer; + To : in Natural) is + begin + fl_text_buffer_set_tab_distance (This.Void_Ptr, Interfaces.C.int (To)); + end Set_Tab_Width; + + + + + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Position) + return Boolean + is + S, F : Interfaces.C.int; + begin + if fl_text_buffer_selection_position (This.Void_Ptr, S, F) /= 0 then + Start := Position (S); + Finish := Position (F); + return True; + else + return False; + end if; + end Get_Selection; + + + function Get_Secondary_Selection + (This : in Text_Buffer; + Start, Finish : out Position) + return Boolean + is + S, F : Interfaces.C.int; + begin + if fl_text_buffer_secondary_selection_position (This.Void_Ptr, S, F) /= 0 then + Start := Position (S); + Finish := Position (F); + return True; + else + return False; + end if; + end Get_Secondary_Selection; + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Position) is + begin + fl_text_buffer_select + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Selection; + + + procedure Set_Secondary_Selection + (This : in out Text_Buffer; + Start, Finish : in Position) is + begin + fl_text_buffer_secondary_select + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Secondary_Selection; + + + function Has_Selection + (This : in Text_Buffer) + return Boolean is + begin + return fl_text_buffer_selected (This.Void_Ptr) /= 0; + end Has_Selection; + + + function Has_Secondary_Selection + (This : in Text_Buffer) + return Boolean is + begin + return fl_text_buffer_secondary_selected (This.Void_Ptr) /= 0; + end Has_Secondary_Selection; + + + function Selection_Text + (This : in Text_Buffer) + return String + is + Raw : Interfaces.C.Strings.chars_ptr := + fl_text_buffer_selection_text (This.Void_Ptr); + begin + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; + end Selection_Text; + + + function Secondary_Selection_Text + (This : in Text_Buffer) + return String + is + Raw : Interfaces.C.Strings.chars_ptr := + fl_text_buffer_secondary_selection_text (This.Void_Ptr); + begin + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; + end Secondary_Selection_Text; + + + procedure Replace_Selection + (This : in out Text_Buffer; + Text : in String) is + begin + fl_text_buffer_replace_selection (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Replace_Selection; + + + procedure Replace_Secondary_Selection + (This : in out Text_Buffer; + Text : in String) is + begin + fl_text_buffer_replace_secondary_selection (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Replace_Secondary_Selection; + + + procedure Remove_Selection + (This : in out Text_Buffer) is + begin + fl_text_buffer_remove_selection (This.Void_Ptr); + end Remove_Selection; + + + procedure Remove_Secondary_Selection + (This : in out Text_Buffer) is + begin + fl_text_buffer_remove_secondary_selection (This.Void_Ptr); + end Remove_Secondary_Selection; + + + procedure Unselect + (This : in out Text_Buffer) is + begin + fl_text_buffer_unselect (This.Void_Ptr); + end Unselect; + + + procedure Secondary_Unselect + (This : in out Text_Buffer) is + begin + fl_text_buffer_secondary_unselect (This.Void_Ptr); + end Secondary_Unselect; + + + + + procedure Get_Highlight + (This : in Text_Buffer; + Start, Finish : out Position) is + begin + Start := This.High_From; + Finish := This.High_To; + end Get_Highlight; + + + procedure Set_Highlight + (This : in out Text_Buffer; + Start, Finish : in Position) is + begin + This.High_From := Start; + This.High_To := Finish; + fl_text_buffer_highlight + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Highlight; + + + function Get_Highlighted_Text + (This : in Text_Buffer) + return String + is + Raw : Interfaces.C.Strings.chars_ptr := + fl_text_buffer_highlight_text (This.Void_Ptr); + begin + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; + end Get_Highlighted_Text; + + + procedure Unhighlight + (This : in out Text_Buffer) is + begin + fl_text_buffer_unhighlight (This.Void_Ptr); + end Unhighlight; + + + + + function Findchar_Forward + (This : in Text_Buffer; + Start_At : in Position; + Item : in Character; + Found_At : out Position) + return Boolean + is + Place : Interfaces.C.int; + begin + if fl_text_buffer_findchar_forward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Character'Pos (Item), + Place) /= 0 + then + Found_At := Position (Place); + return True; + else + return False; + end if; + end Findchar_Forward; + + + function Findchar_Backward + (This : in Text_Buffer; + Start_At : in Position; + Item : in Character; + Found_At : out Position) + return Boolean + is + Place : Interfaces.C.int; + begin + if fl_text_buffer_findchar_backward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Character'Pos (Item), + Place) /= 0 + then + Found_At := Position (Place); + return True; + else + return False; + end if; + end Findchar_Backward; + + + function Search_Forward + (This : in Text_Buffer; + Start_At : in Position; + Item : in String; + Found_At : out Position; + Match_Case : in Boolean := False) + return Boolean + is + Place : Interfaces.C.int; + begin + if fl_text_buffer_search_forward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Place, + Boolean'Pos (Match_Case)) /= 0 + then + Found_At := Position (Place); + return True; + else + return False; + end if; + end Search_Forward; + + + function Search_Backward + (This : in Text_Buffer; + Start_At : in Position; + Item : in String; + Found_At : out Position; + Match_Case : in Boolean := False) + return Boolean + is + Place : Interfaces.C.int; + begin + if fl_text_buffer_search_backward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Place, + Boolean'Pos (Match_Case)) /= 0 + then + Found_At := Position (Place); + return True; + else + return False; + end if; + end Search_Backward; + + + + + function Word_Start + (This : in Text_Buffer; + Place : in Position) + return Position is + begin + return Position (fl_text_buffer_word_start (This.Void_Ptr, Interfaces.C.int (Place))); + end Word_Start; + + + function Word_End + (This : in Text_Buffer; + Place : in Position) + return Position is + begin + return Position (fl_text_buffer_word_end (This.Void_Ptr, Interfaces.C.int (Place))); + end Word_End; + + + function Line_Start + (This : in Text_Buffer; + Place : in Position) + return Position is + begin + return Position (fl_text_buffer_line_start (This.Void_Ptr, Interfaces.C.int (Place))); + end Line_Start; + + + function Line_End + (This : in Text_Buffer; + Place : in Position) + return Position is + begin + return Position (fl_text_buffer_line_end (This.Void_Ptr, Interfaces.C.int (Place))); + end Line_End; + + + function Line_Text + (This : in Text_Buffer; + Place : in Position) + return String + is + Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_line_text + (This.Void_Ptr, + Interfaces.C.int (Place)); + begin + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; + end Line_Text; + + + function Skip_Lines + (This : in out Text_Buffer; + Start : in Position; + Lines : in Natural) + return Position is + begin + return Natural (fl_text_buffer_skip_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Skip_Lines; + + + function Rewind_Lines + (This : in out Text_Buffer; + Start : in Position; + Lines : in Natural) + return Position is + begin + return Natural (fl_text_buffer_rewind_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Rewind_Lines; + + + function Skip_Displayed_Characters + (This : in Text_Buffer; + Start : in Position; + Chars : in Natural) + return Position is + begin + return Natural (fl_text_buffer_skip_displayed_characters + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Chars))); + end Skip_Displayed_Characters; + + + + + procedure Can_Undo + (This : in out Text_Buffer; + Flag : in Boolean) is + begin + fl_text_buffer_canundo (This.Void_Ptr, Interfaces.C.char'Val (Boolean'Pos (Flag))); + end Can_Undo; + + + procedure Copy + (This : in out Text_Buffer; + From : in Text_Buffer; + Start, Finish : in Position; + Insert_Pos : in Position) is + begin + fl_text_buffer_copy + (This.Void_Ptr, + From.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish), + Interfaces.C.int (Insert_Pos)); + end Copy; + + + function UTF8_Align + (This : in Text_Buffer; + Place : in Position) + return Position is + begin + return Position (fl_text_buffer_utf8_align (This.Void_Ptr, Interfaces.C.int (Place))); + end UTF8_Align; + + +end FLTK.Text_Buffers; + -- cgit