summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/c_fl_text_editor.cpp8
-rw-r--r--src/c_fl_text_editor.h3
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.adb276
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.ads180
-rw-r--r--src/fltk.adb21
-rw-r--r--src/fltk.ads43
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<Fl_Text_Editor*>(te)->remove_key_binding(k, m);
+void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te) {
+ reinterpret_cast<Fl_Text_Editor*>(te)->remove_all_key_bindings();
+}
+
+void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f) {
+ reinterpret_cast<Fl_Text_Editor*>(te)->default_key_function(reinterpret_cast<Fl_Text_Editor::Key_Func>(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;
generated by cgit (git 2.30.0) at 2024-12-22 23:07:56 +0000