diff options
Diffstat (limited to 'body/fltk-widgets-groups-text_displays-text_editors.adb')
| -rw-r--r-- | body/fltk-widgets-groups-text_displays-text_editors.adb | 1232 |
1 files changed, 1232 insertions, 0 deletions
diff --git a/body/fltk-widgets-groups-text_displays-text_editors.adb b/body/fltk-widgets-groups-text_displays-text_editors.adb new file mode 100644 index 0000000..15066f9 --- /dev/null +++ b/body/fltk-widgets-groups-text_displays-text_editors.adb @@ -0,0 +1,1232 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + Ada.Characters.Latin_1, + FLTK.Event, + Interfaces.C; + + +package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + package Chk renames Ada.Assertions; + package Latin renames Ada.Characters.Latin_1; + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_text_editor + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); + pragma Inline (new_fl_text_editor); + + procedure free_fl_text_editor + (TE : in Storage.Integer_Address); + pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + pragma Inline (free_fl_text_editor); + + + + + procedure fl_text_editor_default + (TE : in Storage.Integer_Address; + K : in Interfaces.C.int); + pragma Import (C, fl_text_editor_default, "fl_text_editor_default"); + pragma Inline (fl_text_editor_default); + + + + + procedure fl_text_editor_undo + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); + pragma Inline (fl_text_editor_undo); + + procedure fl_text_editor_cut + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); + pragma Inline (fl_text_editor_cut); + + procedure fl_text_editor_copy + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); + pragma Inline (fl_text_editor_copy); + + procedure fl_text_editor_paste + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); + pragma Inline (fl_text_editor_paste); + + procedure fl_text_editor_delete + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); + pragma Inline (fl_text_editor_delete); + + procedure fl_text_editor_select_all + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_select_all, "fl_text_editor_select_all"); + pragma Inline (fl_text_editor_select_all); + + + + + procedure fl_text_editor_backspace + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_backspace, "fl_text_editor_backspace"); + pragma Inline (fl_text_editor_backspace); + + procedure fl_text_editor_insert + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_insert, "fl_text_editor_insert"); + pragma Inline (fl_text_editor_insert); + + procedure fl_text_editor_enter + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_enter, "fl_text_editor_enter"); + pragma Inline (fl_text_editor_enter); + + procedure fl_text_editor_ignore + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ignore, "fl_text_editor_ignore"); + pragma Inline (fl_text_editor_ignore); + + + + + procedure fl_text_editor_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_home, "fl_text_editor_home"); + pragma Inline (fl_text_editor_home); + + procedure fl_text_editor_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_end, "fl_text_editor_end"); + pragma Inline (fl_text_editor_end); + + procedure fl_text_editor_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_page_down, "fl_text_editor_page_down"); + pragma Inline (fl_text_editor_page_down); + + procedure fl_text_editor_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_page_up, "fl_text_editor_page_up"); + pragma Inline (fl_text_editor_page_up); + + procedure fl_text_editor_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_down, "fl_text_editor_down"); + pragma Inline (fl_text_editor_down); + + procedure fl_text_editor_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_left, "fl_text_editor_left"); + pragma Inline (fl_text_editor_left); + + procedure fl_text_editor_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_right, "fl_text_editor_right"); + pragma Inline (fl_text_editor_right); + + procedure fl_text_editor_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_up, "fl_text_editor_up"); + pragma Inline (fl_text_editor_up); + + + + + procedure fl_text_editor_shift_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_home, "fl_text_editor_shift_home"); + pragma Inline (fl_text_editor_shift_home); + + procedure fl_text_editor_shift_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_end, "fl_text_editor_shift_end"); + pragma Inline (fl_text_editor_shift_end); + + procedure fl_text_editor_shift_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_page_down, "fl_text_editor_shift_page_down"); + pragma Inline (fl_text_editor_shift_page_down); + + procedure fl_text_editor_shift_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_page_up, "fl_text_editor_shift_page_up"); + pragma Inline (fl_text_editor_shift_page_up); + + procedure fl_text_editor_shift_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_down, "fl_text_editor_shift_down"); + pragma Inline (fl_text_editor_shift_down); + + procedure fl_text_editor_shift_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_left, "fl_text_editor_shift_left"); + pragma Inline (fl_text_editor_shift_left); + + procedure fl_text_editor_shift_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_right, "fl_text_editor_shift_right"); + pragma Inline (fl_text_editor_shift_right); + + procedure fl_text_editor_shift_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_shift_up, "fl_text_editor_shift_up"); + pragma Inline (fl_text_editor_shift_up); + + + + + procedure fl_text_editor_ctrl_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_home, "fl_text_editor_ctrl_home"); + pragma Inline (fl_text_editor_ctrl_home); + + procedure fl_text_editor_ctrl_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_end, "fl_text_editor_ctrl_end"); + pragma Inline (fl_text_editor_ctrl_end); + + procedure fl_text_editor_ctrl_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_page_down, "fl_text_editor_ctrl_page_down"); + pragma Inline (fl_text_editor_ctrl_page_down); + + procedure fl_text_editor_ctrl_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_page_up, "fl_text_editor_ctrl_page_up"); + pragma Inline (fl_text_editor_ctrl_page_up); + + procedure fl_text_editor_ctrl_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_down, "fl_text_editor_ctrl_down"); + pragma Inline (fl_text_editor_ctrl_down); + + procedure fl_text_editor_ctrl_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_left, "fl_text_editor_ctrl_left"); + pragma Inline (fl_text_editor_ctrl_left); + + procedure fl_text_editor_ctrl_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_right, "fl_text_editor_ctrl_right"); + pragma Inline (fl_text_editor_ctrl_right); + + procedure fl_text_editor_ctrl_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_up, "fl_text_editor_ctrl_up"); + pragma Inline (fl_text_editor_ctrl_up); + + + + + procedure fl_text_editor_ctrl_shift_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_home, "fl_text_editor_ctrl_shift_home"); + pragma Inline (fl_text_editor_ctrl_shift_home); + + procedure fl_text_editor_ctrl_shift_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_end, "fl_text_editor_ctrl_shift_end"); + pragma Inline (fl_text_editor_ctrl_shift_end); + + procedure fl_text_editor_ctrl_shift_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_page_down, "fl_text_editor_ctrl_shift_page_down"); + pragma Inline (fl_text_editor_ctrl_shift_page_down); + + procedure fl_text_editor_ctrl_shift_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_page_up, "fl_text_editor_ctrl_shift_page_up"); + pragma Inline (fl_text_editor_ctrl_shift_page_up); + + procedure fl_text_editor_ctrl_shift_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_down, "fl_text_editor_ctrl_shift_down"); + pragma Inline (fl_text_editor_ctrl_shift_down); + + procedure fl_text_editor_ctrl_shift_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_left, "fl_text_editor_ctrl_shift_left"); + pragma Inline (fl_text_editor_ctrl_shift_left); + + procedure fl_text_editor_ctrl_shift_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_right, "fl_text_editor_ctrl_shift_right"); + pragma Inline (fl_text_editor_ctrl_shift_right); + + procedure fl_text_editor_ctrl_shift_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_ctrl_shift_up, "fl_text_editor_ctrl_shift_up"); + pragma Inline (fl_text_editor_ctrl_shift_up); + + + + + procedure fl_text_editor_meta_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_home, "fl_text_editor_meta_home"); + pragma Inline (fl_text_editor_meta_home); + + procedure fl_text_editor_meta_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_end, "fl_text_editor_meta_end"); + pragma Inline (fl_text_editor_meta_end); + + procedure fl_text_editor_meta_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_page_down, "fl_text_editor_meta_page_down"); + pragma Inline (fl_text_editor_meta_page_down); + + procedure fl_text_editor_meta_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_page_up, "fl_text_editor_meta_page_up"); + pragma Inline (fl_text_editor_meta_page_up); + + procedure fl_text_editor_meta_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_down, "fl_text_editor_meta_down"); + pragma Inline (fl_text_editor_meta_down); + + procedure fl_text_editor_meta_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_left, "fl_text_editor_meta_left"); + pragma Inline (fl_text_editor_meta_left); + + procedure fl_text_editor_meta_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_right, "fl_text_editor_meta_right"); + pragma Inline (fl_text_editor_meta_right); + + procedure fl_text_editor_meta_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_up, "fl_text_editor_meta_up"); + pragma Inline (fl_text_editor_meta_up); + + + + + procedure fl_text_editor_meta_shift_home + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_home, "fl_text_editor_meta_shift_home"); + pragma Inline (fl_text_editor_meta_shift_home); + + procedure fl_text_editor_meta_shift_end + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_end, "fl_text_editor_meta_shift_end"); + pragma Inline (fl_text_editor_meta_shift_end); + + procedure fl_text_editor_meta_shift_page_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_page_down, "fl_text_editor_meta_shift_page_down"); + pragma Inline (fl_text_editor_meta_shift_page_down); + + procedure fl_text_editor_meta_shift_page_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_page_up, "fl_text_editor_meta_shift_page_up"); + pragma Inline (fl_text_editor_meta_shift_page_up); + + procedure fl_text_editor_meta_shift_down + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_down, "fl_text_editor_meta_shift_down"); + pragma Inline (fl_text_editor_meta_shift_down); + + procedure fl_text_editor_meta_shift_left + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_left, "fl_text_editor_meta_shift_left"); + pragma Inline (fl_text_editor_meta_shift_left); + + procedure fl_text_editor_meta_shift_right + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_right, "fl_text_editor_meta_shift_right"); + pragma Inline (fl_text_editor_meta_shift_right); + + procedure fl_text_editor_meta_shift_up + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_meta_shift_up, "fl_text_editor_meta_shift_up"); + pragma Inline (fl_text_editor_meta_shift_up); + + + + + 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); + pragma Import (C, fl_text_editor_remove_all_key_bindings, + "fl_text_editor_remove_all_key_bindings"); + pragma Inline (fl_text_editor_remove_all_key_bindings); + + procedure fl_text_editor_set_default_key_function + (TE, F : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_set_default_key_function, + "fl_text_editor_set_default_key_function"); + pragma Inline (fl_text_editor_set_default_key_function); + + + + + function fl_text_editor_get_insert_mode + (TE : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_get_insert_mode, "fl_text_editor_get_insert_mode"); + pragma Inline (fl_text_editor_get_insert_mode); + + procedure fl_text_editor_set_insert_mode + (TE : in Storage.Integer_Address; + I : in Interfaces.C.int); + pragma Import (C, fl_text_editor_set_insert_mode, "fl_text_editor_set_insert_mode"); + pragma Inline (fl_text_editor_set_insert_mode); + + + + + function fl_text_editor_get_tab_nav + (TE : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav"); + pragma Inline (fl_text_editor_get_tab_nav); + + procedure fl_text_editor_set_tab_nav + (TE : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav"); + pragma Inline (fl_text_editor_set_tab_nav); + + + + + procedure fl_text_editor_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw"); + pragma Inline (fl_text_editor_draw); + + function fl_text_editor_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle"); + pragma Inline (fl_text_editor_handle); + + function fl_text_editor_handle_key + (TE : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_handle_key, "fl_text_editor_handle_key"); + pragma Inline (fl_text_editor_handle_key); + + procedure fl_text_editor_maybe_do_callback + (TE : in Storage.Integer_Address); + pragma Import (C, fl_text_editor_maybe_do_callback, "fl_text_editor_maybe_do_callback"); + pragma Inline (fl_text_editor_maybe_do_callback); + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + function Key_Func_Hook + (K : in Interfaces.C.int; + E : in Storage.Integer_Address) + return Interfaces.C.int + is + Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E); + Ada_Editor : access Text_Editor'Class; + + Extra_Keys : Modifier := FLTK.Event.Last_Modifier; + Actual_Key : Keypress := FLTK.Event.Last_Key; -- fuck you FLTK, give me the real code + Ada_Key : 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 + -- will give you the first character in the textual representation, which + -- is not ideal. This is why we have to grab the Last_Key manually. + begin + pragma Assert (Editor_Ptr /= Null_Pointer); + Ada_Editor := Editor_Convert.To_Pointer (Storage.To_Address (Editor_Ptr)); + for B of Global_Key_Bindings loop + if B.Key = Ada_Key and B.Func /= null then + B.Func (Ada_Editor.all); + return Event_Outcome'Pos (Handled); + end if; + end loop; + for B of Ada_Editor.Bindings loop + if B.Key = Ada_Key then + B.Func (Ada_Editor.all); + return Event_Outcome'Pos (Handled); + end if; + end loop; + if Ada_Editor.Default_Func /= null then + Ada_Editor.Default_Func (Ada_Editor.all, Ada_Key); + return Event_Outcome'Pos (Handled); + end if; + return Event_Outcome'Pos (Not_Handled); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Text_Editor C++ object had no user data reference back to the " & + "corresponding Ada object in the Key_Func hook"; + end Key_Func_Hook; + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Text_Editor) is + begin + Extra_Final (Text_Display (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Text_Editor) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_text_editor (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + if This.Raw_Buffer /= Null_Pointer then + free_fl_text_buffer (This.Raw_Buffer); -- buffer is reference counted + This.Raw_Buffer := Null_Pointer; + end if; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Text_Editor; + X, Y, W, H : in Integer; + Text : in String) is + begin + for B of Default_Key_Bindings loop + This.Bindings.Append (B); + end loop; + This.Default_Func := KF_Default'Access; + + -- change things over so key bindings are all handled from the Ada side + fl_text_editor_remove_all_key_bindings (This.Void_Ptr); + fl_text_editor_set_default_key_function + (This.Void_Ptr, Storage.To_Integer (Key_Func_Hook'Address)); + + Extra_Init (Text_Display (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Text_Editor) is + begin + This.Draw_Ptr := fl_text_editor_draw'Address; + This.Handle_Ptr := fl_text_editor_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Text_Editor + is + use type Interfaces.C.int; + begin + return This : Text_Editor do + This.Void_Ptr := new_fl_text_editor + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + + function Create + (Parent : in out Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Text_Editor is + begin + return This : Text_Editor := Create (X, Y, W, H, Text) do + Parent.Add (This); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + procedure KF_Default + (This : in out Text_Editor'Class; + Key : in Key_Combo) is + begin + fl_text_editor_default + (This.Void_Ptr, + Interfaces.C.int (Key.Keycode)); + end KF_Default; + + + + + procedure KF_Undo + (This : in out Text_Editor'Class) is + begin + fl_text_editor_undo (This.Void_Ptr); + end KF_Undo; + + + procedure KF_Cut + (This : in out Text_Editor'Class) is + begin + fl_text_editor_cut (This.Void_Ptr); + end KF_Cut; + + + procedure KF_Copy + (This : in out Text_Editor'Class) is + begin + fl_text_editor_copy (This.Void_Ptr); + end KF_Copy; + + + procedure KF_Paste + (This : in out Text_Editor'Class) is + begin + fl_text_editor_paste (This.Void_Ptr); + end KF_Paste; + + + procedure KF_Delete + (This : in out Text_Editor'Class) is + begin + fl_text_editor_delete (This.Void_Ptr); + end KF_Delete; + + + procedure KF_Select_All + (This : in out Text_Editor'Class) is + begin + fl_text_editor_select_all (This.Void_Ptr); + end KF_Select_All; + + + + + procedure KF_Backspace + (This : in out Text_Editor'Class) is + begin + fl_text_editor_backspace (This.Void_Ptr); + end KF_Backspace; + + + procedure KF_Insert + (This : in out Text_Editor'Class) is + begin + fl_text_editor_insert (This.Void_Ptr); + end KF_Insert; + + + procedure KF_Enter + (This : in out Text_Editor'Class) is + begin + fl_text_editor_enter (This.Void_Ptr); + end KF_Enter; + + + procedure KF_Ignore + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ignore (This.Void_Ptr); + end KF_Ignore; + + + procedure KF_Tab + (This : in out Text_Editor'Class) is + begin + This.Insert_Text (Latin.HT & ""); + end KF_Tab; + + + + + procedure KF_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_home (This.Void_Ptr); + end KF_Home; + + + procedure KF_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_end (This.Void_Ptr); + end KF_End; + + + procedure KF_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_page_down (This.Void_Ptr); + end KF_Page_Down; + + + procedure KF_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_page_up (This.Void_Ptr); + end KF_Page_Up; + + + procedure KF_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_down (This.Void_Ptr); + end KF_Down; + + + procedure KF_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_left (This.Void_Ptr); + end KF_Left; + + + procedure KF_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_right (This.Void_Ptr); + end KF_Right; + + + procedure KF_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_up (This.Void_Ptr); + end KF_Up; + + + + + procedure KF_Shift_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_home (This.Void_Ptr); + end KF_Shift_Home; + + + procedure KF_Shift_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_end (This.Void_Ptr); + end KF_Shift_End; + + + procedure KF_Shift_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_page_down (This.Void_Ptr); + end KF_Shift_Page_Down; + + + procedure KF_Shift_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_page_up (This.Void_Ptr); + end KF_Shift_Page_Up; + + + procedure KF_Shift_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_down (This.Void_Ptr); + end KF_Shift_Down; + + + procedure KF_Shift_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_left (This.Void_Ptr); + end KF_Shift_Left; + + + procedure KF_Shift_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_right (This.Void_Ptr); + end KF_Shift_Right; + + + procedure KF_Shift_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_shift_up (This.Void_Ptr); + end KF_Shift_Up; + + + + + procedure KF_Ctrl_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_home (This.Void_Ptr); + end KF_Ctrl_Home; + + + procedure KF_Ctrl_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_end (This.Void_Ptr); + end KF_Ctrl_End; + + + procedure KF_Ctrl_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_page_down (This.Void_Ptr); + end KF_Ctrl_Page_Down; + + + procedure KF_Ctrl_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_page_up (This.Void_Ptr); + end KF_Ctrl_Page_Up; + + + procedure KF_Ctrl_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_down (This.Void_Ptr); + end KF_Ctrl_Down; + + + procedure KF_Ctrl_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_left (This.Void_Ptr); + end KF_Ctrl_Left; + + + procedure KF_Ctrl_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_right (This.Void_Ptr); + end KF_Ctrl_Right; + + + procedure KF_Ctrl_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_up (This.Void_Ptr); + end KF_Ctrl_Up; + + + + + procedure KF_Ctrl_Shift_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_home (This.Void_Ptr); + end KF_Ctrl_Shift_Home; + + + procedure KF_Ctrl_Shift_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_end (This.Void_Ptr); + end KF_Ctrl_Shift_End; + + + procedure KF_Ctrl_Shift_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_page_down (This.Void_Ptr); + end KF_Ctrl_Shift_Page_Down; + + + procedure KF_Ctrl_Shift_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_page_up (This.Void_Ptr); + end KF_Ctrl_Shift_Page_Up; + + + procedure KF_Ctrl_Shift_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_down (This.Void_Ptr); + end KF_Ctrl_Shift_Down; + + + procedure KF_Ctrl_Shift_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_left (This.Void_Ptr); + end KF_Ctrl_Shift_Left; + + + procedure KF_Ctrl_Shift_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_right (This.Void_Ptr); + end KF_Ctrl_Shift_Right; + + + procedure KF_Ctrl_Shift_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_ctrl_shift_up (This.Void_Ptr); + end KF_Ctrl_Shift_Up; + + + + + procedure KF_Meta_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_home (This.Void_Ptr); + end KF_Meta_Home; + + + procedure KF_Meta_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_end (This.Void_Ptr); + end KF_Meta_End; + + + procedure KF_Meta_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_page_down (This.Void_Ptr); + end KF_Meta_Page_Down; + + + procedure KF_Meta_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_page_up (This.Void_Ptr); + end KF_Meta_Page_Up; + + + procedure KF_Meta_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_down (This.Void_Ptr); + end KF_Meta_Down; + + + procedure KF_Meta_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_left (This.Void_Ptr); + end KF_Meta_Left; + + + procedure KF_Meta_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_right (This.Void_Ptr); + end KF_Meta_Right; + + + procedure KF_Meta_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_up (This.Void_Ptr); + end KF_Meta_Up; + + + + + procedure KF_Meta_Shift_Home + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_home (This.Void_Ptr); + end KF_Meta_Shift_Home; + + + procedure KF_Meta_Shift_End + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_end (This.Void_Ptr); + end KF_Meta_Shift_End; + + + procedure KF_Meta_Shift_Page_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_page_down (This.Void_Ptr); + end KF_Meta_Shift_Page_Down; + + + procedure KF_Meta_Shift_Page_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_page_up (This.Void_Ptr); + end KF_Meta_Shift_Page_Up; + + + procedure KF_Meta_Shift_Down + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_down (This.Void_Ptr); + end KF_Meta_Shift_Down; + + + procedure KF_Meta_Shift_Left + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_left (This.Void_Ptr); + end KF_Meta_Shift_Left; + + + procedure KF_Meta_Shift_Right + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_right (This.Void_Ptr); + end KF_Meta_Shift_Right; + + + procedure KF_Meta_Shift_Up + (This : in out Text_Editor'Class) is + begin + fl_text_editor_meta_shift_up (This.Void_Ptr); + end KF_Meta_Shift_Up; + + + + + procedure Add_Key_Binding + (This : in out Text_Editor; + Key : in Key_Combo; + Func : in Key_Func) is + begin + if Func /= null then + This.Bindings.Append ((Key, Func)); + end if; + end Add_Key_Binding; + + + procedure Add_Key_Binding + (This : in out Text_Editor; + Bind : in Key_Binding) is + begin + if Bind.Func /= null then + This.Bindings.Append (Bind); + end if; + end Add_Key_Binding; + + + procedure Add_Key_Bindings + (This : in out Text_Editor; + Bind : in Key_Binding_Array) is + begin + for Item of Bind loop + if Item.Func /= null then + This.Bindings.Append (Item); + end if; + end loop; + end Add_Key_Bindings; + + + function Get_Bound_Key_Function + (This : in Text_Editor; + Key : in Key_Combo) + return Key_Func is + begin + for I in 1 .. Integer (This.Bindings.Length) loop + if This.Bindings.Element (I).Key = Key then + return This.Bindings.Element (I).Func; + end if; + end loop; + return null; + end Get_Bound_Key_Function; + + + function Get_All_Bound_Key_Functions + (This : in Text_Editor) + return Key_Binding_Array is + begin + return Result : Key_Binding_Array (1 .. Integer (This.Bindings.Length)) do + for Place in Result'Range loop + Result (Place) := This.Bindings.Element (Place); + end loop; + end return; + end Get_All_Bound_Key_Functions; + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Key : in Key_Combo) is + begin + for I in reverse 1 .. Integer (This.Bindings.Length) loop + if This.Bindings.Element (I).Key = Key then + This.Bindings.Delete (I); + end if; + end loop; + end Remove_Key_Binding; + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Bind : in Key_Binding) is + begin + for I in reverse 1 .. Integer (This.Bindings.Length) loop + if This.Bindings.Element (I) = Bind then + This.Bindings.Delete (I); + end if; + end loop; + end Remove_Key_Binding; + + + procedure Remove_Key_Bindings + (This : in out Text_Editor; + Bind : in Key_Binding_Array) is + begin + for Item of Bind loop + This.Remove_Key_Binding (Item); + end loop; + end Remove_Key_Bindings; + + + procedure Remove_All_Key_Bindings + (This : in out Text_Editor) is + begin + This.Bindings.Clear; + end Remove_All_Key_Bindings; + + + function Get_Default_Key_Function + (This : in Text_Editor) + return Default_Key_Func is + begin + return This.Default_Func; + end Get_Default_Key_Function; + + + procedure Set_Default_Key_Function + (This : in out Text_Editor; + Func : in Default_Key_Func) is + begin + This.Default_Func := Func; + end Set_Default_Key_Function; + + + + + function Get_Insert_Mode + (This : in Text_Editor) + return Insert_Mode + is + Result : Interfaces.C.int := fl_text_editor_get_insert_mode (This.Void_Ptr); + begin + return Insert_Mode'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Text_Editor::insert_mode returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Insert_Mode; + + + procedure Set_Insert_Mode + (This : in out Text_Editor; + To : in Insert_Mode) is + begin + fl_text_editor_set_insert_mode (This.Void_Ptr, Insert_Mode'Pos (To)); + end Set_Insert_Mode; + + + + + function Get_Tab_Mode + (This : in Text_Editor) + return Tab_Navigation + is + Result : Interfaces.C.int := fl_text_editor_get_tab_nav (This.Void_Ptr); + begin + return Tab_Navigation'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Text_Editor::tab_nav returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Tab_Mode; + + + procedure Set_Tab_Mode + (This : in out Text_Editor; + To : in Tab_Navigation) is + begin + fl_text_editor_set_tab_nav (This.Void_Ptr, Tab_Navigation'Pos (To)); + end Set_Tab_Mode; + + + + + function Handle + (This : in out Text_Editor; + Event : in Event_Kind) + return Event_Outcome is + begin + return Text_Display (This).Handle (Event); + end Handle; + + + function Handle_Key + (This : in out Text_Editor) + return Event_Outcome + is + Result : Interfaces.C.int := fl_text_editor_handle_key (This.Void_Ptr); + begin + return Event_Outcome'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Text_Editor::handle_key returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Handle_Key; + + + procedure Maybe_Do_Callback + (This : in out Text_Editor) is + begin + fl_text_editor_maybe_do_callback (This.Void_Ptr); + end Maybe_Do_Callback; + + +end FLTK.Widgets.Groups.Text_Displays.Text_Editors; + + |