--  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 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);
        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;
        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;
        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;
        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;
        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;
        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;