diff options
Diffstat (limited to 'src')
28 files changed, 788 insertions, 346 deletions
diff --git a/src/c_fl.cpp b/src/c_fl.cpp index acaae1a..1e8fd1c 100644 --- a/src/c_fl.cpp +++ b/src/c_fl.cpp @@ -10,6 +10,11 @@ +const short fl_mod_command = FL_COMMAND >> 16; + + + + size_t c_pointer_size() { return sizeof(void*); } @@ -8,6 +8,9 @@ #define FL_GUARD +extern "C" const short fl_mod_command; + + extern "C" size_t c_pointer_size(); diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp index ff5477c..488a73f 100644 --- a/src/c_fl_draw.cpp +++ b/src/c_fl_draw.cpp @@ -30,7 +30,7 @@ int fl_draw_can_do_alpha_blending() { return fl_can_do_alpha_blending(); } -const char * fl_draw_shortcut_label(unsigned long shortcut) { +const char * fl_draw_shortcut_label(unsigned int shortcut) { return fl_shortcut_label(shortcut); } diff --git a/src/c_fl_draw.h b/src/c_fl_draw.h index 89f9428..d719903 100644 --- a/src/c_fl_draw.h +++ b/src/c_fl_draw.h @@ -14,7 +14,7 @@ extern "C" void fl_draw_set_status(int x, int y, int w, int h); extern "C" int fl_draw_can_do_alpha_blending(); -extern "C" const char * fl_draw_shortcut_label(unsigned long shortcut); +extern "C" const char * fl_draw_shortcut_label(unsigned int shortcut); extern "C" const char * fl_draw_latin1_to_local(const char *t, int n); diff --git a/src/c_fl_event.cpp b/src/c_fl_event.cpp index cdb8185..59a22df 100644 --- a/src/c_fl_event.cpp +++ b/src/c_fl_event.cpp @@ -85,11 +85,11 @@ int fl_event_get() { return Fl::event(); } -unsigned long fl_event_state() { +int fl_event_state() { return Fl::event_state(); } -int fl_event_check_state(unsigned long s) { +int fl_event_check_state(int s) { return Fl::event_state(s); } @@ -159,19 +159,19 @@ int fl_event_inside(int x, int y, int w, int h) { -unsigned long fl_event_key() { +int fl_event_key() { return Fl::event_key(); } -unsigned long fl_event_original_key() { +int fl_event_original_key() { return Fl::event_original_key(); } -int fl_event_key_during(unsigned long k) { +int fl_event_key_during(int k) { return Fl::event_key(k); } -int fl_event_get_key(unsigned long k) { +int fl_event_get_key(int k) { return Fl::get_key(k); } diff --git a/src/c_fl_event.h b/src/c_fl_event.h index 24ef7c9..cc1f930 100644 --- a/src/c_fl_event.h +++ b/src/c_fl_event.h @@ -30,8 +30,8 @@ extern "C" int fl_event_length(); extern "C" int fl_event_get(); -extern "C" unsigned long fl_event_state(); -extern "C" int fl_event_check_state(unsigned long s); +extern "C" int fl_event_state(); +extern "C" int fl_event_check_state(int s); extern "C" int fl_event_x(); @@ -51,10 +51,10 @@ extern "C" int fl_event_button3(); extern "C" int fl_event_inside(int x, int y, int w, int h); -extern "C" unsigned long fl_event_key(); -extern "C" unsigned long fl_event_original_key(); -extern "C" int fl_event_key_during(unsigned long k); -extern "C" int fl_event_get_key(unsigned long k); +extern "C" int fl_event_key(); +extern "C" int fl_event_original_key(); +extern "C" int fl_event_key_during(int k); +extern "C" int fl_event_get_key(int k); extern "C" int fl_event_ctrl(); extern "C" int fl_event_alt(); extern "C" int fl_event_command(); diff --git a/src/c_fl_input_.cpp b/src/c_fl_input_.cpp index 158a18c..7fe0556 100644 --- a/src/c_fl_input_.cpp +++ b/src/c_fl_input_.cpp @@ -118,11 +118,11 @@ void fl_input_set_input_type(INPUT i, int t) { static_cast<Fl_Input_*>(i)->input_type(t); } -unsigned long fl_input_get_shortcut(INPUT i) { +int fl_input_get_shortcut(INPUT i) { return static_cast<Fl_Input_*>(i)->shortcut(); } -void fl_input_set_shortcut(INPUT i, unsigned long t) { +void fl_input_set_shortcut(INPUT i, int t) { static_cast<Fl_Input_*>(i)->shortcut(t); } diff --git a/src/c_fl_input_.h b/src/c_fl_input_.h index eec03c2..689894e 100644 --- a/src/c_fl_input_.h +++ b/src/c_fl_input_.h @@ -33,8 +33,8 @@ extern "C" void fl_input_set_wrap(INPUT i, int t); extern "C" int fl_input_get_input_type(INPUT i); extern "C" void fl_input_set_input_type(INPUT i, int t); -extern "C" unsigned long fl_input_get_shortcut(INPUT i); -extern "C" void fl_input_set_shortcut(INPUT i, unsigned long t); +extern "C" int fl_input_get_shortcut(INPUT i); +extern "C" void fl_input_set_shortcut(INPUT i, int t); extern "C" int fl_input_get_mark(INPUT i); extern "C" int fl_input_set_mark(INPUT i, int t); extern "C" int fl_input_get_position(INPUT i); diff --git a/src/c_fl_menuitem.cpp b/src/c_fl_menuitem.cpp index cb4ebee..b72c065 100644 --- a/src/c_fl_menuitem.cpp +++ b/src/c_fl_menuitem.cpp @@ -27,7 +27,7 @@ void * null_fl_menu_item() { return mi; } -void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f) { +void * new_fl_menu_item(char * t, void * c, int s, int f) { Fl_Menu_Item *mi = new Fl_Menu_Item; mi->callback(c==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), c); mi->flags = static_cast<int>(f); @@ -145,11 +145,11 @@ void fl_menu_item_set_shortcut(MENUITEM mi, int s) { static_cast<Fl_Menu_Item*>(mi)->shortcut(s); } -unsigned long fl_menu_item_get_flags(MENUITEM mi) { +int fl_menu_item_get_flags(MENUITEM mi) { return static_cast<Fl_Menu_Item*>(mi)->flags; } -void fl_menu_item_set_flags(MENUITEM mi, unsigned long f) { +void fl_menu_item_set_flags(MENUITEM mi, int f) { static_cast<Fl_Menu_Item*>(mi)->flags = f; } diff --git a/src/c_fl_menuitem.h b/src/c_fl_menuitem.h index eefd645..1e63c60 100644 --- a/src/c_fl_menuitem.h +++ b/src/c_fl_menuitem.h @@ -12,7 +12,7 @@ typedef void* MENUITEM; extern "C" void * null_fl_menu_item(); -extern "C" void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f); +extern "C" void * new_fl_menu_item(char * t, void * c, int s, int f); extern "C" void free_fl_menu_item(MENUITEM mi); @@ -45,8 +45,8 @@ extern "C" void fl_menu_item_set_labeltype(MENUITEM mi, int t); extern "C" int fl_menu_item_get_shortcut(MENUITEM mi); extern "C" void fl_menu_item_set_shortcut(MENUITEM mi, int s); -extern "C" unsigned long fl_menu_item_get_flags(MENUITEM mi); -extern "C" void fl_menu_item_set_flags(MENUITEM mi, unsigned long f); +extern "C" int fl_menu_item_get_flags(MENUITEM mi); +extern "C" void fl_menu_item_set_flags(MENUITEM mi, int f); extern "C" void fl_menu_item_image(MENUITEM mi, void * i); diff --git a/src/c_fl_sys_menu_bar.cpp b/src/c_fl_sys_menu_bar.cpp index d67bf87..fbd6e34 100644 --- a/src/c_fl_sys_menu_bar.cpp +++ b/src/c_fl_sys_menu_bar.cpp @@ -63,26 +63,22 @@ int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t) { return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t); } -int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, unsigned long s, void * u, unsigned long f) { +int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, int s, void * u, int f) { return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s, u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f); } -int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, unsigned long f) { +int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, int f) { return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s, u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f); } -int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, unsigned long s, - void * u, unsigned long f) -{ +int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, int s, void * u, int f) { return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s, u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f); } -int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t, const char * s, - void * u, unsigned long f) -{ +int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t, const char * s, void * u, int f) { return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s, u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f); } @@ -121,15 +117,15 @@ void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t) { static_cast<Fl_Sys_Menu_Bar*>(m)->replace(i, t); } -void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int i, unsigned long s) { +void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int i, int s) { static_cast<Fl_Sys_Menu_Bar*>(m)->shortcut(i, s); } -unsigned long fl_sys_menu_bar_get_mode(SYSMENUBAR m, int i) { +int fl_sys_menu_bar_get_mode(SYSMENUBAR m, int i) { return static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i); } -void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int i, unsigned long f) { +void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int i, int f) { static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i, f); } diff --git a/src/c_fl_sys_menu_bar.h b/src/c_fl_sys_menu_bar.h index 67e5f0d..1bde8f2 100644 --- a/src/c_fl_sys_menu_bar.h +++ b/src/c_fl_sys_menu_bar.h @@ -16,14 +16,11 @@ extern "C" void free_fl_sys_menu_bar(SYSMENUBAR m); extern "C" int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t); -extern "C" int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, - unsigned long s, void * u, unsigned long f); -extern "C" int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, - const char * s, void * u, unsigned long f); -extern "C" int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, - unsigned long s, void * u, unsigned long f); +extern "C" int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, int s, void * u, int f); +extern "C" int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, int f); +extern "C" int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, int s, void * u, int f); extern "C" int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t, - const char * s, void * u, unsigned long f); + const char * s, void * u, int f); extern "C" void fl_sys_menu_bar_set_menu(SYSMENUBAR m, void * d); extern "C" void fl_sys_menu_bar_remove(SYSMENUBAR m, int p); extern "C" void fl_sys_menu_bar_clear(SYSMENUBAR m); @@ -35,9 +32,9 @@ extern "C" const void * fl_sys_menu_bar_get_item(SYSMENUBAR m, int i); extern "C" void fl_sys_menu_bar_setonly(SYSMENUBAR m, void * mi); extern "C" void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t); -extern "C" void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int p, unsigned long s); -extern "C" unsigned long fl_sys_menu_bar_get_mode(SYSMENUBAR m, int p); -extern "C" void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int p, unsigned long f); +extern "C" void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int p, int s); +extern "C" int fl_sys_menu_bar_get_mode(SYSMENUBAR m, int p); +extern "C" void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int p, int f); extern "C" void fl_sys_menu_bar_global(SYSMENUBAR m); diff --git a/src/c_fl_text_buffer.cpp b/src/c_fl_text_buffer.cpp index 3bb5b3b..2322984 100644 --- a/src/c_fl_text_buffer.cpp +++ b/src/c_fl_text_buffer.cpp @@ -11,9 +11,9 @@ class My_Text_Buffer : public Fl_Text_Buffer { - public: - using Fl_Text_Buffer::Fl_Text_Buffer; - int reference_count = 0; +public: + using Fl_Text_Buffer::Fl_Text_Buffer; + int reference_count = 0; }; diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp index d148676..6138cb2 100644 --- a/src/c_fl_text_editor.cpp +++ b/src/c_fl_text_editor.cpp @@ -18,6 +18,17 @@ extern "C" int widget_handle_hook(void * ud, int e); +// Non-friend protected access + +class Friend_Text_Editor : Fl_Text_Editor { +public: + using Fl_Text_Editor::handle_key; + using Fl_Text_Editor::maybe_do_callback; +}; + + + + // Attaching all relevant hooks and friends class My_Text_Editor : public Fl_Text_Editor { @@ -249,15 +260,81 @@ void fl_text_editor_ctrl_shift_up(TEXTEDITOR te) { +void fl_text_editor_meta_home(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Home, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_end(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_End, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_page_down(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_page_up(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_down(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Down, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_left(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Left, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_right(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Right, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_up(TEXTEDITOR te) { + Fl_Text_Editor::kf_meta_move(FL_Up, static_cast<Fl_Text_Editor*>(te)); +} + + + + +void fl_text_editor_meta_shift_home(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Home, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_end(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_End, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_page_down(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_page_up(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_down(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Down, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_left(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Left, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_right(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Right, static_cast<Fl_Text_Editor*>(te)); +} + +void fl_text_editor_meta_shift_up(TEXTEDITOR te) { + Fl_Text_Editor::kf_m_s_move(FL_Up, static_cast<Fl_Text_Editor*>(te)); +} + + + + void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f) { static_cast<Fl_Text_Editor*>(te)->add_key_binding (k, s, reinterpret_cast<Fl_Text_Editor::Key_Func>(f)); } -void fl_text_editor_remove_key_binding(TEXTEDITOR te, int k, int s) { - static_cast<Fl_Text_Editor*>(te)->remove_key_binding(k, s); -} - void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te) { static_cast<Fl_Text_Editor*>(te)->remove_all_key_bindings(); } @@ -310,4 +387,12 @@ int fl_text_editor_handle(TEXTEDITOR te, int e) { return static_cast<My_Text_Editor*>(te)->Fl_Text_Editor::handle(e); } +int fl_text_editor_handle_key(TEXTEDITOR te) { + return (static_cast<Fl_Text_Editor*>(te)->*(&Friend_Text_Editor::handle_key))(); +} + +void fl_text_editor_maybe_do_callback(TEXTEDITOR te) { + (static_cast<Fl_Text_Editor*>(te)->*(&Friend_Text_Editor::maybe_do_callback))(); +} + diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h index e25922f..3f57921 100644 --- a/src/c_fl_text_editor.h +++ b/src/c_fl_text_editor.h @@ -72,8 +72,27 @@ 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_meta_home(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_end(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_page_down(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_page_up(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_down(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_left(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_right(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_up(TEXTEDITOR te); + + +extern "C" void fl_text_editor_meta_shift_home(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_end(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_page_down(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_page_up(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_down(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_left(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_right(TEXTEDITOR te); +extern "C" void fl_text_editor_meta_shift_up(TEXTEDITOR te); + + extern "C" void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f); -extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, int k, int s); 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); @@ -88,6 +107,8 @@ extern "C" void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t); extern "C" void fl_text_editor_draw(TEXTEDITOR te); extern "C" int fl_text_editor_handle(TEXTEDITOR te, int e); +extern "C" int fl_text_editor_handle_key(TEXTEDITOR te); +extern "C" void fl_text_editor_maybe_do_callback(TEXTEDITOR te); #endif diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb index 79d34ff..8e98a7f 100644 --- a/src/fltk-draw.adb +++ b/src/fltk-draw.adb @@ -53,7 +53,7 @@ package body FLTK.Draw is pragma Inline (fl_draw_can_do_alpha_blending); function fl_draw_shortcut_label - (Shortcut : in Interfaces.C.unsigned_long) + (Shortcut : in Interfaces.C.unsigned) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_draw_shortcut_label, "fl_draw_shortcut_label"); pragma Inline (fl_draw_shortcut_label); @@ -694,7 +694,7 @@ package body FLTK.Draw is return String is begin return Interfaces.C.Strings.Value - (fl_draw_shortcut_label (To_C (Keys))); + (fl_draw_shortcut_label (Interfaces.C.unsigned (To_C (Keys)))); end Shortcut_Label; diff --git a/src/fltk-event.adb b/src/fltk-event.adb index c4933b4..4521fc2 100644 --- a/src/fltk-event.adb +++ b/src/fltk-event.adb @@ -120,12 +120,12 @@ package body FLTK.Event is pragma Inline (fl_event_get); function fl_event_state - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_event_state, "fl_event_state"); pragma Inline (fl_event_state); function fl_event_check_state - (S : in Interfaces.C.unsigned_long) + (S : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_event_check_state, "fl_event_check_state"); pragma Inline (fl_event_check_state); @@ -213,23 +213,23 @@ package body FLTK.Event is function fl_event_key - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_event_key, "fl_event_key"); pragma Inline (fl_event_key); function fl_event_original_key - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_event_original_key, "fl_event_original_key"); pragma Inline (fl_event_original_key); function fl_event_key_during - (K : in Interfaces.C.unsigned_long) + (K : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_event_key_during, "fl_event_key_during"); pragma Inline (fl_event_key_during); function fl_event_get_key - (K : in Interfaces.C.unsigned_long) + (K : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_event_get_key, "fl_event_get_key"); pragma Inline (fl_event_get_key); diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index 2acaeeb..5bd2519 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -26,7 +26,7 @@ package body FLTK.Menu_Items is function new_fl_menu_item (T : in Interfaces.C.char_array; C : in Storage.Integer_Address; - S, F : in Interfaces.C.unsigned_long) + S, F : in Interfaces.C.int) return Storage.Integer_Address; pragma Import (C, new_fl_menu_item, "new_fl_menu_item"); pragma Inline (new_fl_menu_item); @@ -184,13 +184,13 @@ package body FLTK.Menu_Items is function fl_menu_item_get_flags (MI : in Storage.Integer_Address) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_menu_item_get_flags, "fl_menu_item_get_flags"); pragma Inline (fl_menu_item_get_flags); procedure fl_menu_item_set_flags (MI : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long); + F : in Interfaces.C.int); pragma Import (C, fl_menu_item_set_flags, "fl_menu_item_set_flags"); pragma Inline (fl_menu_item_set_flags); @@ -272,7 +272,7 @@ package body FLTK.Menu_Items is (Interfaces.C.To_C (Text), Callback_Convert.To_Address (Action), To_C (Shortcut), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); end return; end Create; @@ -498,7 +498,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Key_Combo is begin - return To_Ada (Interfaces.C.unsigned_long (fl_menu_item_get_shortcut (This.Void_Ptr))); + return To_Ada (fl_menu_item_get_shortcut (This.Void_Ptr)); end Get_Shortcut; @@ -522,7 +522,7 @@ package body FLTK.Menu_Items is (This : in out Menu_Item; To : in Menu_Flag) is begin - fl_menu_item_set_flags (This.Void_Ptr, Interfaces.C.unsigned_long (To)); + fl_menu_item_set_flags (This.Void_Ptr, Interfaces.C.int (To)); end Set_Flags; diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index 0547ffa..11a57de 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -271,7 +271,7 @@ package body FLTK.Widgets.Buttons is (This : in Button) return Key_Combo is begin - return To_Ada (Interfaces.C.unsigned_long (fl_button_get_shortcut (This.Void_Ptr))); + return To_Ada (fl_button_get_shortcut (This.Void_Ptr)); end Get_Shortcut; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 33c2a2b..15066f9 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -6,15 +6,19 @@ with + Ada.Assertions, + Ada.Characters.Latin_1, FLTK.Event, Interfaces.C; -use type - Interfaces.C.unsigned_long; +package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + package Chk renames Ada.Assertions; + package Latin renames Ada.Characters.Latin_1; -package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is ------------------------ @@ -273,6 +277,92 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + 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; @@ -280,13 +370,6 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding"); pragma Inline (fl_text_editor_add_key_binding); - -- this particular procedure won't be necessary when FLTK keybindings fixed - procedure fl_text_editor_remove_key_binding - (TE : in Storage.Integer_Address; - K, S : in Interfaces.C.int); - pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); - pragma Inline (fl_text_editor_remove_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, @@ -344,6 +427,17 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is 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); + @@ -358,24 +452,39 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is is Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E); Ada_Editor : access Text_Editor'Class; - Modi : Modifier := FLTK.Event.Last_Modifier; - Actual_Key : Keypress := FLTK.Event.Last_Key; -- fuck you FLTK, give me the real code - Ada_Key : Key_Combo := To_Ada (To_C (Actual_Key) + To_C (Modi)); - Found_Binding : Boolean := False; + 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); - Found_Binding := True; + return Event_Outcome'Pos (Handled); end if; end loop; - if not Found_Binding and then Ada_Editor.Default_Func /= null then + if Ada_Editor.Default_Func /= null then Ada_Editor.Default_Func (Ada_Editor.all, Ada_Key); + return Event_Outcome'Pos (Handled); end if; - return 1; + 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; @@ -398,46 +507,17 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is Extra_Final (This); if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_text_editor (This.Void_Ptr); - free_fl_text_buffer (This.Raw_Buffer); 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; - -- remove this type and array once FLTK keybindings fixed - -- type To_Remove is record - -- Press : Keypress; - -- Modif : Interfaces.C.int; - -- end record; - - -- To_Remove_List : array (Positive range <>) of To_Remove := - -- ((Home_Key, 0), - -- (End_Key, 0), - -- (Page_Down_Key, 0), - -- (Page_Up_Key, 0), - -- (Down_Key, 0), - -- (Left_Key, 0), - -- (Right_Key, 0), - -- (Up_Key, 0), - -- (Character'Pos ('/'), Interfaces.C.int (Mod_Ctrl)), - -- (Delete_Key, Interfaces.C.int (Mod_Shift)), - -- (Insert_Key, Interfaces.C.int (Mod_Ctrl)), - -- (Insert_Key, Interfaces.C.int (Mod_Shift))); - - -- use type Interfaces.C.int; - -- To_Remove_Weird : array (Positive range <>) of To_Remove := - -- ((Enter_Key, -1), - -- (Keypad_Enter_Key, -1), - -- (Backspace_Key, -1), - -- (Insert_Key, -1), - -- (Delete_Key, -1), - -- (Escape_Key, -1)); - - - - -------------------- -- Constructors -- -------------------- @@ -447,43 +527,16 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is X, Y, W, H : in Integer; Text : in String) is begin - -- change things over so key bindings are all handled from the Ada side - This.Bindings := Binding_Vectors.Empty_Vector; for B of Default_Key_Bindings loop This.Bindings.Append (B); end loop; - This.Default_Func := Default'Access; - - -- remove these loops and uncomment subsequent "remove_all_key_bindings" - -- when FLTK keybindings fixed - -- for B of To_Remove_List loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif * 65536); - -- end loop; - -- for B of To_Remove_Weird loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif); - -- end loop; - fl_text_editor_remove_all_key_bindings (This.Void_Ptr); + 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)); - -- this is irritatingly required due to how FLTK handles certain keys - -- for B of Default_Key_Bindings loop - -- -- remove this conditional once FLTK keybindings fixed - -- if B.Key.Modcode = Mod_None then - -- fl_text_editor_add_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Key.Keycode), - -- Interfaces.C.int (B.Key.Modcode) * 65536, - -- Key_Func_Hook'Address); - -- end if; - -- end loop; Extra_Init (Text_Display (This), X, Y, W, H, Text); end Extra_Init; @@ -507,11 +560,11 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is 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)); + (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; @@ -537,58 +590,58 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is -- API Subprograms -- ----------------------- - procedure Default + 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 Default; + (This.Void_Ptr, + Interfaces.C.int (Key.Keycode)); + end KF_Default; - procedure Undo + procedure KF_Undo (This : in out Text_Editor'Class) is begin fl_text_editor_undo (This.Void_Ptr); - end Undo; + end KF_Undo; - procedure Cut + procedure KF_Cut (This : in out Text_Editor'Class) is begin fl_text_editor_cut (This.Void_Ptr); - end Cut; + end KF_Cut; - procedure Copy + procedure KF_Copy (This : in out Text_Editor'Class) is begin fl_text_editor_copy (This.Void_Ptr); - end Copy; + end KF_Copy; - procedure Paste + procedure KF_Paste (This : in out Text_Editor'Class) is begin fl_text_editor_paste (This.Void_Ptr); - end Paste; + end KF_Paste; - procedure Delete + procedure KF_Delete (This : in out Text_Editor'Class) is begin fl_text_editor_delete (This.Void_Ptr); - end Delete; + end KF_Delete; - procedure Select_All + procedure KF_Select_All (This : in out Text_Editor'Class) is begin fl_text_editor_select_all (This.Void_Ptr); - end Select_All; + end KF_Select_All; @@ -621,6 +674,13 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is 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 @@ -855,12 +915,130 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + 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 - This.Bindings.Append ((Key, Func)); + if Func /= null then + This.Bindings.Append ((Key, Func)); + end if; end Add_Key_Binding; @@ -868,16 +1046,20 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (This : in out Text_Editor; Bind : in Key_Binding) is begin - This.Bindings.Append (Bind); + if Bind.Func /= null then + This.Bindings.Append (Bind); + end if; end Add_Key_Binding; procedure Add_Key_Bindings (This : in out Text_Editor; - List : in Key_Binding_List) is + Bind : in Key_Binding_Array) is begin - for I of List loop - This.Bindings.Append (I); + for Item of Bind loop + if Item.Func /= null then + This.Bindings.Append (Item); + end if; end loop; end Add_Key_Bindings; @@ -896,56 +1078,48 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is 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 - use type Interfaces.C.int; + Key : in Key_Combo) is begin for I in reverse 1 .. Integer (This.Bindings.Length) loop - if This.Bindings.Reference (I).Key = Key then + if This.Bindings.Element (I).Key = Key then This.Bindings.Delete (I); end if; end loop; - - -- remove this once FLTK keybindings fixed - -- if Key.Modcode /= Mod_None then - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (Key.Keycode), - -- Interfaces.C.int (Key.Modcode) * 65536); - -- end if; end Remove_Key_Binding; procedure Remove_Key_Binding (This : in out Text_Editor; - Bind : in Key_Binding) - is - -- use type Interfaces.C.int; + 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 + if This.Bindings.Element (I) = Bind then This.Bindings.Delete (I); end if; end loop; - - -- remove this once FLTK keybindings fixed - -- if Bind.Key.Modcode /= Mod_None then - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (Bind.Key.Keycode), - -- Interfaces.C.int (Bind.Key.Modcode) * 65536); - -- end if; end Remove_Key_Binding; procedure Remove_Key_Bindings (This : in out Text_Editor; - List : in Key_Binding_List) is + Bind : in Key_Binding_Array) is begin - for I of List loop - This.Remove_Key_Binding (I); + for Item of Bind loop + This.Remove_Key_Binding (Item); end loop; end Remove_Key_Bindings; @@ -953,11 +1127,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure Remove_All_Key_Bindings (This : in out Text_Editor) is begin - This.Bindings := Binding_Vectors.Empty_Vector; - -- This.Default_Func := null; - - -- remove this once FLTK keybindings fixed - -- fl_text_editor_remove_all_key_bindings (This.Void_Ptr); + This.Bindings.Clear; end Remove_All_Key_Bindings; @@ -981,9 +1151,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function Get_Insert_Mode (This : in Text_Editor) - return Insert_Mode is + return Insert_Mode + is + Result : Interfaces.C.int := fl_text_editor_get_insert_mode (This.Void_Ptr); begin - return Insert_Mode'Val (fl_text_editor_get_insert_mode (This.Void_Ptr)); + 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; @@ -999,11 +1175,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function Get_Tab_Mode (This : in Text_Editor) - return Tab_Navigation is + return Tab_Navigation + is + Result : Interfaces.C.int := fl_text_editor_get_tab_nav (This.Void_Ptr); begin - return Tab_Navigation'Val (fl_text_editor_get_tab_nav (This.Void_Ptr)); + return Tab_Navigation'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; + 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; @@ -1026,6 +1206,27 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is 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; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 6f5131d..e6355c7 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -4,11 +4,14 @@ -- Released into the public domain -private with +with - Interfaces.C, Ada.Containers.Vectors; +private with + + Interfaces.C; + package FLTK.Widgets.Groups.Text_Displays.Text_Editors is @@ -34,7 +37,11 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is Func : Key_Func; end record; - type Key_Binding_List is array (Positive range <>) of Key_Binding; + type Key_Binding_Array is array (Positive range <>) of Key_Binding; + + package Key_Binding_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Key_Binding); @@ -57,29 +64,29 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - procedure Default + procedure KF_Default (This : in out Text_Editor'Class; Key : in Key_Combo); - procedure Undo + procedure KF_Undo (This : in out Text_Editor'Class); - procedure Cut + procedure KF_Cut (This : in out Text_Editor'Class); - procedure Copy + procedure KF_Copy (This : in out Text_Editor'Class); - procedure Paste + procedure KF_Paste (This : in out Text_Editor'Class); - procedure Delete + procedure KF_Delete (This : in out Text_Editor'Class); - procedure Select_All + procedure KF_Select_All (This : in out Text_Editor'Class); @@ -97,6 +104,9 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure KF_Ignore (This : in out Text_Editor'Class); + procedure KF_Tab + (This : in out Text_Editor'Class); + @@ -208,54 +218,133 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - Default_Key_Bindings : constant Key_Binding_List := - ((Mod_None + Enter_Key, KF_Enter'Access), - (Mod_None + Keypad_Enter_Key, KF_Enter'Access), - (Mod_None + Backspace_Key, KF_Backspace'Access), - (Mod_None + Insert_Key, KF_Insert'Access), + procedure KF_Meta_Home + (This : in out Text_Editor'Class); - (Mod_None + 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), + procedure KF_Meta_End + (This : in out Text_Editor'Class); - (Mod_None + Home_Key, KF_Home'Access), - (Mod_None + End_Key, KF_End'Access), - (Mod_None + Page_Down_Key, KF_Page_Down'Access), - (Mod_None + Page_Up_Key, KF_Page_Up'Access), - (Mod_None + Down_Key, KF_Down'Access), - (Mod_None + Left_Key, KF_Left'Access), - (Mod_None + Right_Key, KF_Right'Access), - (Mod_None + Up_Key, KF_Up'Access), + procedure KF_Meta_Page_Down + (This : in out Text_Editor'Class); - (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), + procedure KF_Meta_Page_Up + (This : in out Text_Editor'Class); - (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), + procedure KF_Meta_Down + (This : in out Text_Editor'Class); - (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 KF_Meta_Left + (This : in out Text_Editor'Class); + + procedure KF_Meta_Right + (This : in out Text_Editor'Class); + + procedure KF_Meta_Up + (This : in out Text_Editor'Class); + + + + + procedure KF_Meta_Shift_Home + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_End + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Page_Down + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Page_Up + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Down + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Left + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Right + (This : in out Text_Editor'Class); + + procedure KF_Meta_Shift_Up + (This : in out Text_Editor'Class); + + + + + Default_Key_Bindings : constant Key_Binding_Array := + ((Mod_None + Escape_Key, KF_Ignore'Access), + (Mod_None + Enter_Key, KF_Enter'Access), + (Mod_None + Keypad_Enter_Key, KF_Enter'Access), + (Mod_None + Backspace_Key, KF_Backspace'Access), + (Mod_None + Insert_Key, KF_Insert'Access), + (Mod_None + Tab_Key, KF_Tab'Access), + + (Mod_None + Delete_Key, KF_Delete'Access), + (Mod_Command + 'c', KF_Copy'Access), + (Mod_Command + 'v', KF_Paste'Access), + (Mod_Command + 'x', KF_Cut'Access), + (Mod_Command + 'z', KF_Undo'Access), + (Mod_Command + 'a', KF_Select_All'Access), + + -- Ctrl+'/' Shift+Del Ctrl+Insert Shift+Insert all intentionally absent + + (Mod_None + Home_Key, KF_Home'Access), + (Mod_None + End_Key, KF_End'Access), + (Mod_None + Page_Down_Key, KF_Page_Down'Access), + (Mod_None + Page_Up_Key, KF_Page_Up'Access), + (Mod_None + Down_Key, KF_Down'Access), + (Mod_None + Left_Key, KF_Left'Access), + (Mod_None + Right_Key, KF_Right'Access), + (Mod_None + 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), + + (Mod_Meta + Home_Key, KF_Meta_Home'Access), + (Mod_Meta + End_Key, KF_Meta_End'Access), + (Mod_Meta + Page_Down_Key, KF_Meta_Page_Down'Access), + (Mod_Meta + Page_Up_Key, KF_Meta_Page_Up'Access), + (Mod_Meta + Down_Key, KF_Meta_Down'Access), + (Mod_Meta + Left_Key, KF_Meta_Left'Access), + (Mod_Meta + Right_Key, KF_Meta_Right'Access), + (Mod_Meta + Up_Key, KF_Meta_Up'Access), + + (Mod_Meta + Mod_Shift + Home_Key, KF_Meta_Shift_Home'Access), + (Mod_Meta + Mod_Shift + End_Key, KF_Meta_Shift_End'Access), + (Mod_Meta + Mod_Shift + Page_Down_Key, KF_Meta_Shift_Page_Down'Access), + (Mod_Meta + Mod_Shift + Page_Up_Key, KF_Meta_Shift_Page_Up'Access), + (Mod_Meta + Mod_Shift + Down_Key, KF_Meta_Shift_Down'Access), + (Mod_Meta + Mod_Shift + Left_Key, KF_Meta_Shift_Left'Access), + (Mod_Meta + Mod_Shift + Right_Key, KF_Meta_Shift_Right'Access), + (Mod_Meta + Mod_Shift + Up_Key, KF_Meta_Shift_Up'Access)); + + + Global_Key_Bindings : Key_Binding_Vectors.Vector; @@ -271,13 +360,17 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure Add_Key_Bindings (This : in out Text_Editor; - List : in Key_Binding_List); + Bind : in Key_Binding_Array); function Get_Bound_Key_Function (This : in Text_Editor; Key : in Key_Combo) return Key_Func; + function Get_All_Bound_Key_Functions + (This : in Text_Editor) + return Key_Binding_Array; + procedure Remove_Key_Binding (This : in out Text_Editor; Key : in Key_Combo); @@ -288,7 +381,7 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure Remove_Key_Bindings (This : in out Text_Editor; - List : in Key_Binding_List); + Bind : in Key_Binding_Array); procedure Remove_All_Key_Bindings (This : in out Text_Editor); @@ -331,16 +424,19 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is Event : in Event_Kind) return Event_Outcome; + function Handle_Key + (This : in out Text_Editor) + return Event_Outcome; -private + procedure Maybe_Do_Callback + (This : in out Text_Editor); - package Binding_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, Element_Type => Key_Binding); +private type Text_Editor is new Text_Display with record - Bindings : Binding_Vectors.Vector; + Bindings : Key_Binding_Vectors.Vector; Default_Func : Default_Key_Func; end record; @@ -369,19 +465,20 @@ private package Editor_Convert is new System.Address_To_Access_Conversions (Text_Editor'Class); - pragma Inline (Default); + pragma Inline (KF_Default); - pragma Inline (Undo); - pragma Inline (Cut); - pragma Inline (Copy); - pragma Inline (Paste); - pragma Inline (Delete); - pragma Inline (Select_All); + pragma Inline (KF_Undo); + pragma Inline (KF_Cut); + pragma Inline (KF_Copy); + pragma Inline (KF_Paste); + pragma Inline (KF_Delete); + pragma Inline (KF_Select_All); pragma Inline (KF_Backspace); pragma Inline (KF_Insert); pragma Inline (KF_Enter); pragma Inline (KF_Ignore); + pragma Inline (KF_Tab); pragma Inline (KF_Home); pragma Inline (KF_End); @@ -419,6 +516,24 @@ private pragma Inline (KF_Ctrl_Shift_Right); pragma Inline (KF_Ctrl_Shift_Up); + pragma Inline (KF_Meta_Home); + pragma Inline (KF_Meta_End); + pragma Inline (KF_Meta_Page_Down); + pragma Inline (KF_Meta_Page_Up); + pragma Inline (KF_Meta_Down); + pragma Inline (KF_Meta_Left); + pragma Inline (KF_Meta_Right); + pragma Inline (KF_Meta_Up); + + pragma Inline (KF_Meta_Shift_Home); + pragma Inline (KF_Meta_Shift_End); + pragma Inline (KF_Meta_Shift_Page_Down); + pragma Inline (KF_Meta_Shift_Page_Up); + pragma Inline (KF_Meta_Shift_Down); + pragma Inline (KF_Meta_Shift_Left); + pragma Inline (KF_Meta_Shift_Right); + pragma Inline (KF_Meta_Shift_Up); + pragma Inline (Add_Key_Binding); pragma Inline (Remove_All_Key_Bindings); pragma Inline (Get_Default_Key_Function); @@ -427,10 +542,12 @@ private pragma Inline (Get_Insert_Mode); pragma Inline (Set_Insert_Mode); - -- pragma Inline (Get_Tab_Nav_Mode); - -- pragma Inline (Set_Tab_Nav_Mode); + pragma Inline (Get_Tab_Mode); + pragma Inline (Set_Tab_Mode); pragma Inline (Handle); + pragma Inline (Handle_Key); + pragma Inline (Maybe_Do_Callback); end FLTK.Widgets.Groups.Text_Displays.Text_Editors; diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index 0c90bec..011d841 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -478,8 +478,11 @@ package body FLTK.Widgets.Groups.Text_Displays is Extra_Final (This); if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_text_display (This.Void_Ptr); - free_fl_text_buffer (This.Raw_Buffer); 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; diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 1030ac0..3ba8192 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -138,13 +138,13 @@ package body FLTK.Widgets.Inputs is function fl_input_get_shortcut (I : in Storage.Integer_Address) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_input_get_shortcut, "fl_input_get_shortcut"); pragma Inline (fl_input_get_shortcut); procedure fl_input_set_shortcut (I : in Storage.Integer_Address; - T : in Interfaces.C.unsigned_long); + T : in Interfaces.C.int); pragma Import (C, fl_input_set_shortcut, "fl_input_set_shortcut"); pragma Inline (fl_input_set_shortcut); diff --git a/src/fltk-widgets-menus-menu_bars-systemwide.adb b/src/fltk-widgets-menus-menu_bars-systemwide.adb index aebf9bd..bccdc2e 100644 --- a/src/fltk-widgets-menus-menu_bars-systemwide.adb +++ b/src/fltk-widgets-menus-menu_bars-systemwide.adb @@ -56,9 +56,9 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is function fl_sys_menu_bar_add2 (M : in Storage.Integer_Address; T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; + S : in Interfaces.C.int; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_sys_menu_bar_add2, "fl_sys_menu_bar_add2"); pragma Inline (fl_sys_menu_bar_add2); @@ -67,7 +67,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is (M : in Storage.Integer_Address; T, S : in Interfaces.C.char_array; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_sys_menu_bar_add3, "fl_sys_menu_bar_add3"); pragma Inline (fl_sys_menu_bar_add3); @@ -76,9 +76,9 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is (M : in Storage.Integer_Address; P : in Interfaces.C.int; T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; + S : in Interfaces.C.int; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_sys_menu_bar_insert, "fl_sys_menu_bar_insert"); pragma Inline (fl_sys_menu_bar_insert); @@ -88,7 +88,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is P : in Interfaces.C.int; T, S : in Interfaces.C.char_array; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_sys_menu_bar_insert2, "fl_sys_menu_bar_insert2"); pragma Inline (fl_sys_menu_bar_insert2); @@ -144,21 +144,21 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is procedure fl_sys_menu_bar_shortcut (M : in Storage.Integer_Address; I : in Interfaces.C.int; - S : in Interfaces.C.unsigned_long); + S : in Interfaces.C.int); pragma Import (C, fl_sys_menu_bar_shortcut, "fl_sys_menu_bar_shortcut"); pragma Inline (fl_sys_menu_bar_shortcut); function fl_sys_menu_bar_get_mode (M : in Storage.Integer_Address; I : in Interfaces.C.int) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_sys_menu_bar_get_mode, "fl_sys_menu_bar_get_mode"); pragma Inline (fl_sys_menu_bar_get_mode); procedure fl_sys_menu_bar_set_mode (M : in Storage.Integer_Address; I : in Interfaces.C.int; - F : in Interfaces.C.unsigned_long); + F : in Interfaces.C.int); pragma Import (C, fl_sys_menu_bar_set_mode, "fl_sys_menu_bar_set_mode"); pragma Inline (fl_sys_menu_bar_set_mode); @@ -324,7 +324,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Add; @@ -343,7 +343,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -362,7 +362,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Add; @@ -381,7 +381,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -402,7 +402,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Insert; @@ -423,7 +423,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -444,7 +444,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Insert; @@ -465,7 +465,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -585,7 +585,7 @@ package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is fl_sys_menu_bar_set_mode (This.Void_Ptr, Interfaces.C.int (Place) - 1, - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); end Set_Flags; diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index 3e5df01..034cd4c 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -14,7 +14,6 @@ with use type Interfaces.C.int, - Interfaces.C.unsigned_long, Interfaces.C.Strings.chars_ptr; @@ -68,9 +67,9 @@ package body FLTK.Widgets.Menus is function fl_menu_add2 (M : in Storage.Integer_Address; T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; + S : in Interfaces.C.int; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_add2, "fl_menu_add2"); pragma Inline (fl_menu_add2); @@ -79,7 +78,7 @@ package body FLTK.Widgets.Menus is (M : in Storage.Integer_Address; T, S : in Interfaces.C.char_array; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_add3, "fl_menu_add3"); pragma Inline (fl_menu_add3); @@ -88,9 +87,9 @@ package body FLTK.Widgets.Menus is (M : in Storage.Integer_Address; P : in Interfaces.C.int; T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; + S : in Interfaces.C.int; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_insert, "fl_menu_insert"); pragma Inline (fl_menu_insert); @@ -100,7 +99,7 @@ package body FLTK.Widgets.Menus is P : in Interfaces.C.int; T, S : in Interfaces.C.char_array; U : in Storage.Integer_Address; - F : in Interfaces.C.unsigned_long) + F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_insert2, "fl_menu_insert2"); pragma Inline (fl_menu_insert2); @@ -230,21 +229,21 @@ package body FLTK.Widgets.Menus is procedure fl_menu_shortcut (M : in Storage.Integer_Address; I : in Interfaces.C.int; - S : in Interfaces.C.unsigned_long); + S : in Interfaces.C.int); pragma Import (C, fl_menu_shortcut, "fl_menu_shortcut"); pragma Inline (fl_menu_shortcut); function fl_menu_get_mode (M : in Storage.Integer_Address; I : in Interfaces.C.int) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; pragma Import (C, fl_menu_get_mode, "fl_menu_get_mode"); pragma Inline (fl_menu_get_mode); procedure fl_menu_set_mode (M : in Storage.Integer_Address; I : in Interfaces.C.int; - F : in Interfaces.C.unsigned_long); + F : in Interfaces.C.int); pragma Import (C, fl_menu_set_mode, "fl_menu_set_mode"); pragma Inline (fl_menu_set_mode); @@ -577,7 +576,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Add; @@ -596,7 +595,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -615,7 +614,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Add; @@ -634,7 +633,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -655,7 +654,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Insert; @@ -676,7 +675,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -697,7 +696,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; end Insert; @@ -718,7 +717,7 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text), Interfaces.C.To_C (Shortcut), Callback_Convert.To_Address (Action), - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); begin This.Adjust_Item_Store; return Index (Added_Spot + 1); @@ -1169,7 +1168,7 @@ package body FLTK.Widgets.Menus is fl_menu_set_mode (This.Void_Ptr, Interfaces.C.int (Place) - 1, - Interfaces.C.unsigned_long (Flags)); + Interfaces.C.int (Flags)); end Set_Flags; diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb index f92d03b..6091d55 100644 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ b/src/fltk-widgets-valuators-value_inputs.adb @@ -299,7 +299,7 @@ package body FLTK.Widgets.Valuators.Value_Inputs is (This : in Value_Input) return Key_Combo is begin - return To_Ada (Interfaces.C.unsigned_long (fl_value_input_get_shortcut (This.Void_Ptr))); + return To_Ada (fl_value_input_get_shortcut (This.Void_Ptr)); end Get_Shortcut; diff --git a/src/fltk.adb b/src/fltk.adb index 3afb984..61491d9 100644 --- a/src/fltk.adb +++ b/src/fltk.adb @@ -210,14 +210,14 @@ package body FLTK is function To_C (Key : in Key_Combo) - return Interfaces.C.unsigned_long is + return Interfaces.C.int is begin return To_C (Key.Modcode) + To_C (Key.Keycode) + To_C (Key.Mousecode); end To_C; function To_Ada - (Key : in Interfaces.C.unsigned_long) + (Key : in Interfaces.C.int) return Key_Combo is begin return Result : Key_Combo do @@ -230,14 +230,14 @@ package body FLTK is function To_C (Key : in Keypress) - return Interfaces.C.unsigned_long is + return Interfaces.C.int is begin - return Interfaces.C.unsigned_long (Key); + return Interfaces.C.int (Key); end To_C; function To_Ada - (Key : in Interfaces.C.unsigned_long) + (Key : in Interfaces.C.int) return Keypress is begin return Keypress (Key mod 65536); @@ -246,14 +246,14 @@ package body FLTK is function To_C (Modi : in Modifier) - return Interfaces.C.unsigned_long is + return Interfaces.C.int is begin - return Interfaces.C.unsigned_long (Modi) * 65536; + return Interfaces.C.int (Modi) * 65536; end To_C; function To_Ada - (Modi : in Interfaces.C.unsigned_long) + (Modi : in Interfaces.C.int) return Modifier is begin return Modifier ((Modi / 65536) mod 256); @@ -262,7 +262,7 @@ package body FLTK is function To_C (Button : in Mouse_Button) - return Interfaces.C.unsigned_long is + return Interfaces.C.int is begin case Button is when Left_Button => return 1 * (256 ** 3); @@ -274,7 +274,7 @@ package body FLTK is function To_Ada - (Button : in Interfaces.C.unsigned_long) + (Button : in Interfaces.C.int) return Mouse_Button is begin case (Button / (256 ** 3)) is diff --git a/src/fltk.ads b/src/fltk.ads index 3a0e332..4af6b42 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -136,6 +136,7 @@ package FLTK is Right_Key : constant Keypress; Up_Key : constant Keypress; Escape_Key : constant Keypress; + Tab_Key : constant Keypress; type Mouse_Button is (No_Button, Left_Button, Middle_Button, Right_Button); @@ -151,10 +152,15 @@ package FLTK is function "+" (Left : in Modifier; Right : in Keypress) return Key_Combo; function "+" (Left : in Modifier; Right : in Mouse_Button) return Key_Combo; function "+" (Left : in Modifier; Right : in Key_Combo) return Key_Combo; - Mod_None : constant Modifier; - Mod_Shift : constant Modifier; - Mod_Ctrl : constant Modifier; - Mod_Alt : constant Modifier; + Mod_None : constant Modifier; + Mod_Shift : constant Modifier; + Mod_Caps_Lock : constant Modifier; + Mod_Ctrl : constant Modifier; + Mod_Alt : constant Modifier; + Mod_Num_Lock : constant Modifier; + Mod_Meta : constant Modifier; + Mod_Scroll_Lock : constant Modifier; + Mod_Command : constant Modifier; @@ -467,41 +473,49 @@ private function To_C (Key : in Key_Combo) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; function To_Ada - (Key : in Interfaces.C.unsigned_long) + (Key : in Interfaces.C.int) return Key_Combo; function To_C (Key : in Keypress) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; function To_Ada - (Key : in Interfaces.C.unsigned_long) + (Key : in Interfaces.C.int) return Keypress; function To_C (Modi : in Modifier) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; function To_Ada - (Modi : in Interfaces.C.unsigned_long) + (Modi : in Interfaces.C.int) return Modifier; function To_C (Button : in Mouse_Button) - return Interfaces.C.unsigned_long; + return Interfaces.C.int; function To_Ada - (Button : in Interfaces.C.unsigned_long) + (Button : in Interfaces.C.int) return Mouse_Button; -- these values designed to align with FLTK enumeration types - Mod_None : constant Modifier := 2#00000000#; - Mod_Shift : constant Modifier := 2#00000001#; - Mod_Ctrl : constant Modifier := 2#00000100#; - Mod_Alt : constant Modifier := 2#00001000#; + Mod_None : constant Modifier := 2#00000000#; + Mod_Shift : constant Modifier := 2#00000001#; + Mod_Caps_Lock : constant Modifier := 2#00000010#; + Mod_Ctrl : constant Modifier := 2#00000100#; + Mod_Alt : constant Modifier := 2#00001000#; + Mod_Num_Lock : constant Modifier := 2#00010000#; + -- Missing 2#00100000#; + Mod_Meta : constant Modifier := 2#01000000#; + Mod_Scroll_Lock : constant Modifier := 2#10000000#; + + -- If this is Apple then Mod_Meta, otherwise Mod_Ctrl + pragma Import (C, Mod_Command, "fl_mod_command"); No_Key : constant Key_Combo := (Modcode => Mod_None, Keycode => 0, Mousecode => No_Button); @@ -520,6 +534,7 @@ private Right_Key : constant Keypress := 16#ff53#; Up_Key : constant Keypress := 16#ff52#; Escape_Key : constant Keypress := 16#ff1b#; + Tab_Key : constant Keypress := 16#ff09#; |