From 260c988ea3f73d194643df1e871a2a40949c2763 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 11 Jun 2017 18:27:34 +1000 Subject: Key binding functions and procedures added to Text_Editor package --- src/c_fl_text_editor.cpp | 8 +- src/c_fl_text_editor.h | 3 +- ...k-widgets-groups-text_displays-text_editors.adb | 276 ++++++++++++++------- ...k-widgets-groups-text_displays-text_editors.ads | 180 +++++++++++--- src/fltk.adb | 21 +- src/fltk.ads | 43 +++- 6 files changed, 396 insertions(+), 135 deletions(-) diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp index b023981..9518f01 100644 --- a/src/c_fl_text_editor.cpp +++ b/src/c_fl_text_editor.cpp @@ -263,8 +263,12 @@ void fl_text_editor_ctrl_shift_up(TEXTEDITOR te) { -void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m) { - reinterpret_cast(te)->remove_key_binding(k, m); +void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te) { + reinterpret_cast(te)->remove_all_key_bindings(); +} + +void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f) { + reinterpret_cast(te)->default_key_function(reinterpret_cast(f)); } diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h index e827428..d1c46d0 100644 --- a/src/c_fl_text_editor.h +++ b/src/c_fl_text_editor.h @@ -80,7 +80,8 @@ extern "C" void fl_text_editor_ctrl_shift_right(TEXTEDITOR te); extern "C" void fl_text_editor_ctrl_shift_up(TEXTEDITOR te); -extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m); +extern "C" void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te); +extern "C" void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f); extern "C" int fl_text_editor_get_insert_mode(TEXTEDITOR te); diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 73744ca..db04d4f 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -226,11 +226,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - procedure fl_text_editor_remove_key_binding - (TE : in System.Address; - K : in Interfaces.C.unsigned; - M : in Interfaces.C.unsigned_long); - pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); + procedure fl_text_editor_remove_all_key_bindings + (TE : in System.Address); + pragma Import (C, fl_text_editor_remove_all_key_bindings, + "fl_text_editor_remove_all_key_bindings"); + + procedure fl_text_editor_set_default_key_function + (TE, F : in System.Address); + pragma Import (C, fl_text_editor_set_default_key_function, + "fl_text_editor_set_default_key_function"); @@ -274,6 +278,33 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + function Key_Func_Hook + (K : in Interfaces.C.int; + U : in System.Address) + return Interfaces.C.int + is + Ada_Editor : access Text_Editor'Class := + Editor_Convert.To_Pointer (U); + Ada_Key : Shortcut_Key := + C_To_Key (Interfaces.C.unsigned_long (K)); + + Found_Binding : Boolean := False; + begin + for B of Ada_Editor.Bindings loop + if B.Key = Ada_Key then + B.Func (Ada_Editor.all); + Found_Binding := True; + end if; + end loop; + if not Found_Binding and then Ada_Editor.Default_Func /= null then + Ada_Editor.Default_Func (Ada_Editor.all, Ada_Key); + end if; + return 1; + end Key_Func_Hook; + + + + procedure Finalize (This : in out Text_Editor) is begin @@ -308,6 +339,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is Widget_Convert.To_Address (This'Unchecked_Access)); text_editor_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); text_editor_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + + This.Bindings := Binding_Vectors.Empty_Vector; + for B of Default_Key_Bindings loop + This.Bindings.Append (B); + end loop; + This.Default_Func := Default'Access; + + fl_text_editor_remove_all_key_bindings (This.Void_Ptr); + fl_text_editor_set_default_key_function (This.Void_Ptr, Key_Func_Hook'Address); end return; end Create; @@ -320,7 +360,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is begin fl_text_editor_default (This.Void_Ptr, - Character'Pos (Key.Keypress)); + Interfaces.C.int (Key.Keypress)); end Default; @@ -370,281 +410,347 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - procedure Backspace_Key + procedure KF_Backspace (This : in out Text_Editor'Class) is begin fl_text_editor_backspace (This.Void_Ptr); - end Backspace_Key; + end KF_Backspace; - procedure Insert_Key + procedure KF_Insert (This : in out Text_Editor'Class) is begin fl_text_editor_insert (This.Void_Ptr); - end Insert_Key; + end KF_Insert; - procedure Enter_Key + procedure KF_Enter (This : in out Text_Editor'Class) is begin fl_text_editor_enter (This.Void_Ptr); - end Enter_Key; + end KF_Enter; - procedure Ignore_Key + procedure KF_Ignore (This : in out Text_Editor'Class) is begin fl_text_editor_ignore (This.Void_Ptr); - end Ignore_Key; + end KF_Ignore; - procedure Home_Key + procedure KF_Home (This : in out Text_Editor'Class) is begin fl_text_editor_home (This.Void_Ptr); - end Home_Key; + end KF_Home; - procedure End_Key + procedure KF_End (This : in out Text_Editor'Class) is begin fl_text_editor_end (This.Void_Ptr); - end End_Key; + end KF_End; - procedure Page_Down_Key + procedure KF_Page_Down (This : in out Text_Editor'Class) is begin fl_text_editor_page_down (This.Void_Ptr); - end Page_Down_Key; + end KF_Page_Down; - procedure Page_Up_Key + procedure KF_Page_Up (This : in out Text_Editor'Class) is begin fl_text_editor_page_up (This.Void_Ptr); - end Page_Up_Key; + end KF_Page_Up; - procedure Down_Key + procedure KF_Down (This : in out Text_Editor'Class) is begin fl_text_editor_down (This.Void_Ptr); - end Down_Key; + end KF_Down; - procedure Left_Key + procedure KF_Left (This : in out Text_Editor'Class) is begin fl_text_editor_left (This.Void_Ptr); - end Left_Key; + end KF_Left; - procedure Right_Key + procedure KF_Right (This : in out Text_Editor'Class) is begin fl_text_editor_right (This.Void_Ptr); - end Right_Key; + end KF_Right; - procedure Up_Key + procedure KF_Up (This : in out Text_Editor'Class) is begin fl_text_editor_up (This.Void_Ptr); - end Up_Key; + end KF_Up; - procedure Shift_Home_Key + procedure KF_Shift_Home (This : in out Text_Editor'Class) is begin fl_text_editor_shift_home (This.Void_Ptr); - end Shift_Home_Key; + end KF_Shift_Home; - procedure Shift_End_Key + procedure KF_Shift_End (This : in out Text_Editor'Class) is begin fl_text_editor_shift_end (This.Void_Ptr); - end Shift_End_Key; + end KF_Shift_End; - procedure Shift_Page_Down_Key + procedure KF_Shift_Page_Down (This : in out Text_Editor'Class) is begin fl_text_editor_shift_page_down (This.Void_Ptr); - end Shift_Page_Down_Key; + end KF_Shift_Page_Down; - procedure Shift_Page_Up_Key + procedure KF_Shift_Page_Up (This : in out Text_Editor'Class) is begin fl_text_editor_shift_page_up (This.Void_Ptr); - end Shift_Page_Up_Key; + end KF_Shift_Page_Up; - procedure Shift_Down_Key + procedure KF_Shift_Down (This : in out Text_Editor'Class) is begin fl_text_editor_shift_down (This.Void_Ptr); - end Shift_Down_Key; + end KF_Shift_Down; - procedure Shift_Left_Key + procedure KF_Shift_Left (This : in out Text_Editor'Class) is begin fl_text_editor_shift_left (This.Void_Ptr); - end Shift_Left_Key; + end KF_Shift_Left; - procedure Shift_Right_Key + procedure KF_Shift_Right (This : in out Text_Editor'Class) is begin fl_text_editor_shift_right (This.Void_Ptr); - end Shift_Right_Key; + end KF_Shift_Right; - procedure Shift_Up_Key + procedure KF_Shift_Up (This : in out Text_Editor'Class) is begin fl_text_editor_shift_up (This.Void_Ptr); - end Shift_Up_Key; + end KF_Shift_Up; - procedure Ctrl_Home_Key + procedure KF_Ctrl_Home (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_home (This.Void_Ptr); - end Ctrl_Home_Key; + end KF_Ctrl_Home; - procedure Ctrl_End_Key + procedure KF_Ctrl_End (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_end (This.Void_Ptr); - end Ctrl_End_Key; + end KF_Ctrl_End; - procedure Ctrl_Page_Down_Key + procedure KF_Ctrl_Page_Down (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_page_down (This.Void_Ptr); - end Ctrl_Page_Down_Key; + end KF_Ctrl_Page_Down; - procedure Ctrl_Page_Up_Key + procedure KF_Ctrl_Page_Up (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_page_up (This.Void_Ptr); - end Ctrl_Page_Up_Key; + end KF_Ctrl_Page_Up; - procedure Ctrl_Down_Key + procedure KF_Ctrl_Down (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_down (This.Void_Ptr); - end Ctrl_Down_Key; + end KF_Ctrl_Down; - procedure Ctrl_Left_Key + procedure KF_Ctrl_Left (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_left (This.Void_Ptr); - end Ctrl_Left_Key; + end KF_Ctrl_Left; - procedure Ctrl_Right_Key + procedure KF_Ctrl_Right (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_right (This.Void_Ptr); - end Ctrl_Right_Key; + end KF_Ctrl_Right; - procedure Ctrl_Up_Key + procedure KF_Ctrl_Up (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_up (This.Void_Ptr); - end Ctrl_Up_Key; + end KF_Ctrl_Up; - procedure Ctrl_Shift_Home_Key + procedure KF_Ctrl_Shift_Home (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_home (This.Void_Ptr); - end Ctrl_Shift_Home_Key; + end KF_Ctrl_Shift_Home; - procedure Ctrl_Shift_End_Key + procedure KF_Ctrl_Shift_End (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_end (This.Void_Ptr); - end Ctrl_Shift_End_Key; + end KF_Ctrl_Shift_End; - procedure Ctrl_Shift_Page_Down_Key + 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 Ctrl_Shift_Page_Down_Key; + end KF_Ctrl_Shift_Page_Down; - procedure Ctrl_Shift_Page_Up_Key + 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 Ctrl_Shift_Page_Up_Key; + end KF_Ctrl_Shift_Page_Up; - procedure Ctrl_Shift_Down_Key + procedure KF_Ctrl_Shift_Down (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_down (This.Void_Ptr); - end Ctrl_Shift_Down_Key; + end KF_Ctrl_Shift_Down; - procedure Ctrl_Shift_Left_Key + procedure KF_Ctrl_Shift_Left (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_left (This.Void_Ptr); - end Ctrl_Shift_Left_Key; + end KF_Ctrl_Shift_Left; - procedure Ctrl_Shift_Right_Key + procedure KF_Ctrl_Shift_Right (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_right (This.Void_Ptr); - end Ctrl_Shift_Right_Key; + end KF_Ctrl_Shift_Right; - procedure Ctrl_Shift_Up_Key + procedure KF_Ctrl_Shift_Up (This : in out Text_Editor'Class) is begin fl_text_editor_ctrl_shift_up (This.Void_Ptr); - end Ctrl_Shift_Up_Key; + end KF_Ctrl_Shift_Up; + procedure Add_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key; + Func : in Key_Func) is + begin + This.Bindings.Append ((Key, Func)); + end Add_Key_Binding; + + + procedure Add_Key_Binding + (This : in out Text_Editor; + Bind : in Key_Binding) is + begin + This.Bindings.Append (Bind); + end Add_Key_Binding; + + + function Get_Bound_Key_Function + (This : in Text_Editor; + Key : in Shortcut_Key) + 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; + + procedure Remove_Key_Binding (This : in out Text_Editor; - Key : in Shortcut_Key) - is - use type Interfaces.C.unsigned_long; + Key : in Shortcut_Key) is begin - fl_text_editor_remove_key_binding - (This.Void_Ptr, - Character'Pos (Key.Keypress), - Interfaces.C.unsigned_long (Key.Modifier) * 65536); + for I in reverse 1 .. Integer (This.Bindings.Length) loop + if This.Bindings.Reference (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.Reference (I).Key = Bind.Key then + This.Bindings.Delete (I); + end if; + end loop; + end Remove_Key_Binding; + + + procedure Remove_All_Key_Bindings + (This : in out Text_Editor) is + begin + This.Bindings := Binding_Vectors.Empty_Vector; + This.Default_Func := null; + 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 diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 1e9aeb6..3aa916b 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -1,5 +1,9 @@ +private with Interfaces.C; +private with Ada.Containers.Vectors; + + package FLTK.Widgets.Groups.Text_Displays.Text_Editors is @@ -20,7 +24,7 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is Func : Key_Func; end record; - type Key_Binding_List is array (Positive) of Key_Binding; + type Key_Binding_List is array (Positive range <>) of Key_Binding; @@ -61,133 +65,214 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - procedure Backspace_Key + procedure KF_Backspace (This : in out Text_Editor'Class); - procedure Insert_Key + procedure KF_Insert (This : in out Text_Editor'Class); - procedure Enter_Key + procedure KF_Enter (This : in out Text_Editor'Class); - procedure Ignore_Key + procedure KF_Ignore (This : in out Text_Editor'Class); - procedure Home_Key + procedure KF_Home (This : in out Text_Editor'Class); - procedure End_Key + procedure KF_End (This : in out Text_Editor'Class); - procedure Page_Down_Key + procedure KF_Page_Down (This : in out Text_Editor'Class); - procedure Page_Up_Key + procedure KF_Page_Up (This : in out Text_Editor'Class); - procedure Down_Key + procedure KF_Down (This : in out Text_Editor'Class); - procedure Left_Key + procedure KF_Left (This : in out Text_Editor'Class); - procedure Right_Key + procedure KF_Right (This : in out Text_Editor'Class); - procedure Up_Key + procedure KF_Up (This : in out Text_Editor'Class); - procedure Shift_Home_Key + procedure KF_Shift_Home (This : in out Text_Editor'Class); - procedure Shift_End_Key + procedure KF_Shift_End (This : in out Text_Editor'Class); - procedure Shift_Page_Down_Key + procedure KF_Shift_Page_Down (This : in out Text_Editor'Class); - procedure Shift_Page_Up_Key + procedure KF_Shift_Page_Up (This : in out Text_Editor'Class); - procedure Shift_Down_Key + procedure KF_Shift_Down (This : in out Text_Editor'Class); - procedure Shift_Left_Key + procedure KF_Shift_Left (This : in out Text_Editor'Class); - procedure Shift_Right_Key + procedure KF_Shift_Right (This : in out Text_Editor'Class); - procedure Shift_Up_Key + procedure KF_Shift_Up (This : in out Text_Editor'Class); - procedure Ctrl_Home_Key + procedure KF_Ctrl_Home (This : in out Text_Editor'Class); - procedure Ctrl_End_Key + procedure KF_Ctrl_End (This : in out Text_Editor'Class); - procedure Ctrl_Page_Down_Key + procedure KF_Ctrl_Page_Down (This : in out Text_Editor'Class); - procedure Ctrl_Page_Up_Key + procedure KF_Ctrl_Page_Up (This : in out Text_Editor'Class); - procedure Ctrl_Down_Key + procedure KF_Ctrl_Down (This : in out Text_Editor'Class); - procedure Ctrl_Left_Key + procedure KF_Ctrl_Left (This : in out Text_Editor'Class); - procedure Ctrl_Right_Key + procedure KF_Ctrl_Right (This : in out Text_Editor'Class); - procedure Ctrl_Up_Key + procedure KF_Ctrl_Up (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Home_Key + procedure KF_Ctrl_Shift_Home (This : in out Text_Editor'Class); - procedure Ctrl_Shift_End_Key + procedure KF_Ctrl_Shift_End (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Page_Down_Key + procedure KF_Ctrl_Shift_Page_Down (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Page_Up_Key + procedure KF_Ctrl_Shift_Page_Up (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Down_Key + procedure KF_Ctrl_Shift_Down (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Left_Key + procedure KF_Ctrl_Shift_Left (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Right_Key + procedure KF_Ctrl_Shift_Right (This : in out Text_Editor'Class); - procedure Ctrl_Shift_Up_Key + procedure KF_Ctrl_Shift_Up (This : in out Text_Editor'Class); + Default_Key_Bindings : constant Key_Binding_List := + ((Enter_Key, KF_Enter'Access), + (Keypad_Enter_Key, KF_Enter'Access), + (Backspace_Key, KF_Backspace'Access), + (Insert_Key, KF_Insert'Access), + + (Delete_Key, Delete'Access), + (Mod_Ctrl + 'c', Copy'Access), + (Mod_Ctrl + 'v', Paste'Access), + (Mod_Ctrl + 'x', Cut'Access), + (Mod_Ctrl + 'z', Undo'Access), + (Mod_Ctrl + 'a', Select_All'Access), + + (Home_Key, KF_Home'Access), + (End_Key, KF_End'Access), + (Page_Down_Key, KF_Page_Down'Access), + (Page_Up_Key, KF_Page_Up'Access), + (Down_Key, KF_Down'Access), + (Left_Key, KF_Left'Access), + (Right_Key, KF_Right'Access), + (Up_Key, KF_Up'Access), + + (Mod_Shift + Home_Key, KF_Shift_Home'Access), + (Mod_Shift + End_Key, KF_Shift_End'Access), + (Mod_Shift + Page_Down_Key, KF_Shift_Page_Down'Access), + (Mod_Shift + Page_Up_Key, KF_Shift_Page_Up'Access), + (Mod_Shift + Down_Key, KF_Shift_Down'Access), + (Mod_Shift + Left_Key, KF_Shift_Left'Access), + (Mod_Shift + Right_Key, KF_Shift_Right'Access), + (Mod_Shift + Up_Key, KF_Shift_Up'Access), + + (Mod_Ctrl + Home_Key, KF_Ctrl_Home'Access), + (Mod_Ctrl + End_Key, KF_Ctrl_End'Access), + (Mod_Ctrl + Page_Down_Key, KF_Ctrl_Page_Down'Access), + (Mod_Ctrl + Page_Up_Key, KF_Ctrl_Page_Up'Access), + (Mod_Ctrl + Down_Key, KF_Ctrl_Down'Access), + (Mod_Ctrl + Left_Key, KF_Ctrl_Left'Access), + (Mod_Ctrl + Right_Key, KF_Ctrl_Right'Access), + (Mod_Ctrl + Up_Key, KF_Ctrl_Up'Access), + + (Mod_Ctrl + Mod_Shift + Home_Key, KF_Ctrl_Shift_Home'Access), + (Mod_Ctrl + Mod_Shift + End_Key, KF_Ctrl_Shift_End'Access), + (Mod_Ctrl + Mod_Shift + Page_Down_Key, KF_Ctrl_Shift_Page_Down'Access), + (Mod_Ctrl + Mod_Shift + Page_Up_Key, KF_Ctrl_Shift_Page_Up'Access), + (Mod_Ctrl + Mod_Shift + Down_Key, KF_Ctrl_Shift_Down'Access), + (Mod_Ctrl + Mod_Shift + Left_Key, KF_Ctrl_Shift_Left'Access), + (Mod_Ctrl + Mod_Shift + Right_Key, KF_Ctrl_Shift_Right'Access), + (Mod_Ctrl + Mod_Shift + Up_Key, KF_Ctrl_Shift_Up'Access)); + + + + + procedure Add_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key; + Func : in Key_Func); + + procedure Add_Key_Binding + (This : in out Text_Editor; + Bind : in Key_Binding); + + function Get_Bound_Key_Function + (This : in Text_Editor; + Key : in Shortcut_Key) + return Key_Func; + procedure Remove_Key_Binding (This : in out Text_Editor; Key : in Shortcut_Key); + procedure Remove_Key_Binding + (This : in out Text_Editor; + Bind : in Key_Binding); + + procedure Remove_All_Key_Bindings + (This : in out Text_Editor); + + function Get_Default_Key_Function + (This : in Text_Editor) + return Default_Key_Func; + + procedure Set_Default_Key_Function + (This : in out Text_Editor; + Func : in Default_Key_Func); + @@ -225,11 +310,30 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is private - type Text_Editor is new Text_Display with null record; + package Binding_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, Element_Type => Key_Binding); + + + type Text_Editor is new Text_Display with + record + Bindings : Binding_Vectors.Vector; + Default_Func : Default_Key_Func; + end record; + overriding procedure Finalize (This : in out Text_Editor); + function Key_Func_Hook + (K : in Interfaces.C.int; + U : in System.Address) + return Interfaces.C.int; + pragma Convention (C, Key_Func_Hook); + + + package Editor_Convert is new System.Address_To_Access_Conversions (Text_Editor'Class); + + end FLTK.Widgets.Groups.Text_Displays.Text_Editors; diff --git a/src/fltk.adb b/src/fltk.adb index 8591ac2..ad70379 100644 --- a/src/fltk.adb +++ b/src/fltk.adb @@ -50,7 +50,7 @@ package body FLTK is begin return This : Shortcut_Key do This.Modifier := Mod_None; - This.Keypress := Key; + This.Keypress := Character'Pos (Key); end return; end Shortcut; @@ -74,7 +74,7 @@ package body FLTK is begin return This : Shortcut_Key do This.Modifier := Left; - This.Keypress := Right; + This.Keypress := Character'Pos (Right); end return; end "+"; @@ -96,13 +96,26 @@ package body FLTK is function Key_To_C - (Key : Shortcut_Key) + (Key : in Shortcut_Key) return Interfaces.C.unsigned_long is begin return Interfaces.C.unsigned_long (Key.Modifier) * - 65536 + Character'Pos (Key.Keypress); + 65536 + Interfaces.C.unsigned_long (Key.Keypress); end Key_To_C; + + + function C_To_Key + (Key : in Interfaces.C.unsigned_long) + return Shortcut_Key is + begin + return Result : Shortcut_Key do + Result.Modifier := Modifier_Key (Key / 65536); + Result.Keypress := Interfaces.Unsigned_16 (Key mod 65536); + end return; + end C_To_Key; + + end FLTK; diff --git a/src/fltk.ads b/src/fltk.ads index 757eaf7..12ed6b1 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -32,7 +32,20 @@ package FLTK is type Shortcut_Key is private; subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); function Shortcut (Key : Pressable_Key) return Shortcut_Key; - No_Key : constant Shortcut_Key; + No_Key : constant Shortcut_Key; + Enter_Key : constant Shortcut_Key; + Keypad_Enter_Key : constant Shortcut_Key; + Backspace_Key : constant Shortcut_Key; + Insert_Key : constant Shortcut_Key; + Delete_Key : constant Shortcut_Key; + Home_Key : constant Shortcut_Key; + End_Key : constant Shortcut_Key; + Page_Down_Key : constant Shortcut_Key; + Page_Up_Key : constant Shortcut_Key; + Down_Key : constant Shortcut_Key; + Left_Key : constant Shortcut_Key; + Right_Key : constant Shortcut_Key; + Up_Key : constant Shortcut_Key; type Modifier_Key is private; @@ -202,15 +215,20 @@ private type Shortcut_Key is record Modifier : Modifier_Key; - Keypress : Character; + Keypress : Interfaces.Unsigned_16; end record; function Key_To_C - (Key : Shortcut_Key) + (Key : in Shortcut_Key) return Interfaces.C.unsigned_long; + function C_To_Key + (Key : in Interfaces.C.unsigned_long) + return Shortcut_Key; + + -- these values designed to align with FLTK enumeration types Mod_None : constant Modifier_Key := 2#00000000#; Mod_Shift : constant Modifier_Key := 2#00000001#; @@ -218,8 +236,23 @@ private Mod_Alt : constant Modifier_Key := 2#00001000#; - No_Key : constant Shortcut_Key := - (Modifier => Mod_None, Keypress => Character'Val (0)); + No_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 0); + + + -- these values correspond to constants defined in FLTK Enumerations.H + Enter_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff0d#); + Keypad_Enter_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff8d#); + Backspace_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff08#); + Insert_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff63#); + Delete_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ffff#); + Home_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff50#); + End_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff57#); + Page_Down_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff56#); + Page_Up_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff55#); + Down_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff54#); + Left_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff51#); + Right_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff53#); + Up_Key : constant Shortcut_Key := (Modifier => Mod_None, Keypress => 16#ff52#); end FLTK; -- cgit