diff options
Diffstat (limited to 'body/fltk-text_buffers.adb')
| -rw-r--r-- | body/fltk-text_buffers.adb | 145 |
1 files changed, 103 insertions, 42 deletions
diff --git a/body/fltk-text_buffers.adb b/body/fltk-text_buffers.adb index 1afa2a7..a870ece 100644 --- a/body/fltk-text_buffers.adb +++ b/body/fltk-text_buffers.adb @@ -24,6 +24,12 @@ use type package body FLTK.Text_Buffers is + ------------------------ + -- Functions From C -- + ------------------------ + + -- Errors -- + function strerror (Errnum : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; @@ -32,6 +38,8 @@ package body FLTK.Text_Buffers is + -- Allocation -- + function new_fl_text_buffer (RS, PGS : in Interfaces.C.int) return Storage.Integer_Address; @@ -46,6 +54,8 @@ package body FLTK.Text_Buffers is + -- Callbacks -- + procedure fl_text_buffer_add_modify_callback (TB, CB, UD : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_add_modify_callback, @@ -73,6 +83,8 @@ package body FLTK.Text_Buffers is + -- Files -- + function fl_text_buffer_loadfile (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; @@ -117,6 +129,8 @@ package body FLTK.Text_Buffers is + -- Modification -- + procedure fl_text_buffer_insert (TB : in Storage.Integer_Address; P : in Interfaces.C.int; @@ -193,6 +207,8 @@ package body FLTK.Text_Buffers is + -- Measurement -- + function fl_text_buffer_count_displayed_characters (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int) @@ -229,6 +245,8 @@ package body FLTK.Text_Buffers is + -- Selection -- + function fl_text_buffer_selection_position (TB : in Storage.Integer_Address; S, E : out Interfaces.C.int) @@ -318,6 +336,8 @@ package body FLTK.Text_Buffers is + -- Highlighting -- + procedure fl_text_buffer_highlight (TB : in Storage.Integer_Address; F, T : in Interfaces.C.int); @@ -338,6 +358,8 @@ package body FLTK.Text_Buffers is + -- Search -- + function fl_text_buffer_findchar_forward (TB : in Storage.Integer_Address; SP : in Interfaces.C.int; @@ -379,6 +401,8 @@ package body FLTK.Text_Buffers is + -- Navigation -- + function fl_text_buffer_word_start (TB : in Storage.Integer_Address; P : in Interfaces.C.int) @@ -439,6 +463,8 @@ package body FLTK.Text_Buffers is + -- Miscellaneous -- + procedure fl_text_buffer_canundo (TB : in Storage.Integer_Address; F : in Interfaces.C.char); @@ -461,6 +487,10 @@ package body FLTK.Text_Buffers is + ---------------------- + -- Callback Hooks -- + ---------------------- + procedure Modify_Callback_Hook (Pos : in Interfaces.C.int; Inserted, Deleted, Restyled : in Interfaces.C.int; @@ -468,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 @@ -504,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 @@ -520,6 +550,10 @@ package body FLTK.Text_Buffers is + ------------------- + -- Destructors -- + ------------------- + procedure Finalize (This : in out Text_Buffer) is begin @@ -532,6 +566,10 @@ package body FLTK.Text_Buffers is + -------------------- + -- Constructors -- + -------------------- + package body Forge is function Create @@ -559,6 +597,12 @@ package body FLTK.Text_Buffers is + ----------------------- + -- API Subprograms -- + ----------------------- + + -- Callbacks -- + procedure Add_Modify_Callback (This : in out Text_Buffer; Func : in Modify_Callback) is @@ -631,15 +675,17 @@ package body FLTK.Text_Buffers is + -- Files -- + 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)); + 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)); @@ -652,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)); @@ -669,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), @@ -687,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), @@ -705,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)); @@ -718,15 +764,17 @@ package body FLTK.Text_Buffers is + -- Modification -- + 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)); + (This.Void_Ptr, + Interfaces.C.int (Place), + Interfaces.C.To_C (Text)); end Insert_Text; @@ -758,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; @@ -775,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; @@ -808,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; @@ -819,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; @@ -860,6 +908,8 @@ package body FLTK.Text_Buffers is + -- Measurement -- + function Count_Displayed_Characters (This : in Text_Buffer; Start, Finish : in Position) @@ -910,6 +960,8 @@ package body FLTK.Text_Buffers is + -- Selection -- + function Get_Selection (This : in Text_Buffer; Start, Finish : out Position) @@ -949,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; @@ -993,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; @@ -1013,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; @@ -1068,6 +1120,8 @@ package body FLTK.Text_Buffers is + -- Highlighting -- + procedure Get_Highlight (This : in Text_Buffer; Start, Finish : out Position) is @@ -1101,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; @@ -1119,6 +1173,8 @@ package body FLTK.Text_Buffers is + -- Search -- + function Findchar_Forward (This : in Text_Buffer; Start_At : in Position; @@ -1217,6 +1273,8 @@ package body FLTK.Text_Buffers is + -- Navigation -- + function Word_Start (This : in Text_Buffer; Place : in Position) @@ -1266,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; @@ -1282,9 +1340,9 @@ package body FLTK.Text_Buffers is return Position is begin return Natural (fl_text_buffer_skip_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); end Skip_Lines; @@ -1295,9 +1353,9 @@ package body FLTK.Text_Buffers is return Position is begin return Natural (fl_text_buffer_rewind_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); end Rewind_Lines; @@ -1316,6 +1374,8 @@ package body FLTK.Text_Buffers is + -- Miscellaneous -- + procedure Can_Undo (This : in out Text_Buffer; Flag : in Boolean) is @@ -1350,3 +1410,4 @@ package body FLTK.Text_Buffers is end FLTK.Text_Buffers; + |