diff options
| -rw-r--r-- | c_fl_text_buffer.cpp | 10 | ||||
| -rw-r--r-- | c_fl_text_buffer.h | 4 | ||||
| -rw-r--r-- | c_fl_text_editor.cpp | 22 | ||||
| -rw-r--r-- | c_fl_text_editor.h | 6 | ||||
| -rw-r--r-- | fltk-text_buffers.adb | 125 | ||||
| -rw-r--r-- | fltk-text_buffers.ads | 55 | ||||
| -rw-r--r-- | fltk-widgets-groups-text_displays-text_editors.adb | 52 | ||||
| -rw-r--r-- | fltk-widgets-groups-text_displays-text_editors.ads | 16 |
8 files changed, 289 insertions, 1 deletions
diff --git a/c_fl_text_buffer.cpp b/c_fl_text_buffer.cpp index 791e0ab..0da63c2 100644 --- a/c_fl_text_buffer.cpp +++ b/c_fl_text_buffer.cpp @@ -14,3 +14,13 @@ void free_fl_text_buffer(TEXTBUFFER tb) { delete reinterpret_cast<Fl_Text_Buffer*>(tb); } + +void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->add_modify_callback(reinterpret_cast<Fl_Text_Modify_Cb>(cb), ud); +} + + +void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->add_predelete_callback(reinterpret_cast<Fl_Text_Predelete_Cb>(cb), ud); +} + diff --git a/c_fl_text_buffer.h b/c_fl_text_buffer.h index 23daa03..8c1483e 100644 --- a/c_fl_text_buffer.h +++ b/c_fl_text_buffer.h @@ -11,5 +11,9 @@ extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); extern "C" void free_fl_text_buffer(TEXTBUFFER tb); +extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); + + #endif diff --git a/c_fl_text_editor.cpp b/c_fl_text_editor.cpp index 797035e..6754695 100644 --- a/c_fl_text_editor.cpp +++ b/c_fl_text_editor.cpp @@ -14,3 +14,25 @@ void free_fl_text_editor(TEXTEDITOR te) { delete reinterpret_cast<Fl_Text_Editor*>(te); } + + + +void fl_text_editor_cut (TEXTEDITOR te) { + Fl_Text_Editor::kf_cut(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_copy (TEXTEDITOR te) { + Fl_Text_Editor::kf_copy(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_paste (TEXTEDITOR te) { + Fl_Text_Editor::kf_paste(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_delete (TEXTEDITOR te) { + Fl_Text_Editor::kf_delete(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + diff --git a/c_fl_text_editor.h b/c_fl_text_editor.h index 2eda9f3..7c7cee5 100644 --- a/c_fl_text_editor.h +++ b/c_fl_text_editor.h @@ -11,5 +11,11 @@ extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label extern "C" void free_fl_text_editor(TEXTEDITOR te); +extern "C" void fl_text_editor_cut (TEXTEDITOR te); +extern "C" void fl_text_editor_copy (TEXTEDITOR te); +extern "C" void fl_text_editor_paste (TEXTEDITOR te); +extern "C" void fl_text_editor_delete (TEXTEDITOR te); + + #endif diff --git a/fltk-text_buffers.adb b/fltk-text_buffers.adb index 52f475d..fa2a259 100644 --- a/fltk-text_buffers.adb +++ b/fltk-text_buffers.adb @@ -1,8 +1,17 @@ with Interfaces.C; +with Interfaces.C.Strings; +with Ada.Strings.Unbounded; +with Ada.Containers; with System; use type System.Address; +use type Interfaces.C.int; +use type Interfaces.C.Strings.chars_ptr; +use type Ada.Containers.Count_Type; + + +with Ada.Text_IO; package body FLTK.Text_Buffers is @@ -17,6 +26,16 @@ package body FLTK.Text_Buffers is (TB : in System.Address); pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); + procedure fl_text_buffer_add_modify_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_modify_callback, + "fl_text_buffer_add_modify_callback"); + + procedure fl_text_buffer_add_predelete_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_predelete_callback, + "fl_text_buffer_add_predelete_callback"); + @@ -33,6 +52,77 @@ package body FLTK.Text_Buffers is + procedure Modify_Callback_Hook + (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address); + pragma Convention (C, Modify_Callback_Hook); + + procedure Modify_Callback_Hook + (Pos : in Interfaces.C.int; + Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address) is + + package UStr renames Ada.Strings.Unbounded; + + Action : Modification; + Place : Position := Position (Pos); + Length : Natural; + Deleted_Text : UStr.Unbounded_String := UStr.To_Unbounded_String (""); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + + begin + if Inserted > 0 then + Length := Natural (Inserted); + Action := Insert; + elsif Deleted > 0 then + Length := Natural (Deleted); + Action := Delete; + if Text /= Interfaces.C.Strings.Null_Ptr then + Deleted_Text := UStr.To_Unbounded_String (Interfaces.C.Strings.Value (Text)); + end if; + elsif Restyled > 0 then + Length := Natural (Restyled); + Action := Restyle; + else + raise Program_Error; + end if; + + for CB of Ada_Text_Buffer.Modify_CBs loop + CB.Call (Action, Place, Length, UStr.To_String (Deleted_Text)); + end loop; + end Modify_Callback_Hook; + + + + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address); + pragma Convention (C, Predelete_Callback_Hook); + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address) is + + Place : Position := Position (Pos); + Length : Natural := Natural (Deleted); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + + begin + for CB of Ada_Text_Buffer.Predelete_CBs loop + CB.Call (Place, Length); + end loop; + end Predelete_Callback_Hook; + + + + function Create (Requested_Size : in Natural := 0; Preferred_Gap_Size : in Natural := 1024) @@ -42,9 +132,44 @@ package body FLTK.Text_Buffers is This.Void_Ptr := new_fl_text_buffer (Interfaces.C.int (Requested_Size), Interfaces.C.int (Preferred_Gap_Size)); + + This.Modify_CBs := Modify_Vectors.Empty_Vector; + This.Predelete_CBs := Predelete_Vectors.Empty_Vector; end return; end Create; + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : not null access Modify_Callback'Class) is + begin + if This.Modify_CBs.Length = 0 then + fl_text_buffer_add_modify_callback + (This.Void_Ptr, + Modify_Callback_Hook'Address, + This'Address); + end if; + This.Modify_CBs.Append (Func); + end Add_Modify_Callback; + + + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : not null access Predelete_Callback'Class) is + begin + if This.Predelete_CBs.Length = 0 then + fl_text_buffer_add_predelete_callback + (This.Void_Ptr, + Predelete_Callback_Hook'Address, + This'Address); + end if; + This.Predelete_CBs.Append (Func); + end Add_Predelete_Callback; + + end FLTK.Text_Buffers; diff --git a/fltk-text_buffers.ads b/fltk-text_buffers.ads index 2dae75d..aa6a49f 100644 --- a/fltk-text_buffers.ads +++ b/fltk-text_buffers.ads @@ -1,5 +1,9 @@ +private with Ada.Containers.Vectors; +private with System.Address_To_Access_Conversions; + + package FLTK.Text_Buffers is @@ -8,21 +12,70 @@ package FLTK.Text_Buffers is with Implicit_Dereference => Data; + type Position is new Natural; + + + type Modification is (Insert, Restyle, Delete); + type Modify_Callback is interface; + procedure Call + (This : in Modify_Callback; + Action : in Modification; + Place : in Position; + Length : in Natural; + Deleted_Text : in String) is abstract; + + + type Predelete_Callback is interface; + procedure Call + (This : in Predelete_Callback; + Place : in Position; + Length : in Natural) is abstract; + + function Create (Requested_Size : in Natural := 0; Preferred_Gap_Size : in Natural := 1024) return Text_Buffer; + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : not null access Modify_Callback'Class); + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : not null access Predelete_Callback'Class); + + private - type Text_Buffer is new Wrapper with null record; + type Modify_Access is access all Modify_Callback'Class; + type Predelete_Access is access all Predelete_Callback'Class; + + + package Modify_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Modify_Access); + package Predelete_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Predelete_Access); + + + type Text_Buffer is new Wrapper with + record + Modify_CBs : Modify_Vectors.Vector; + Predelete_CBs : Predelete_Vectors.Vector; + end record; overriding procedure Finalize (This : in out Text_Buffer); + package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); + + end FLTK.Text_Buffers; diff --git a/fltk-widgets-groups-text_displays-text_editors.adb b/fltk-widgets-groups-text_displays-text_editors.adb index 447da2c..7969f27 100644 --- a/fltk-widgets-groups-text_displays-text_editors.adb +++ b/fltk-widgets-groups-text_displays-text_editors.adb @@ -18,6 +18,22 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (TE : in System.Address); pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + procedure fl_text_editor_cut + (TE : in System.Address); + pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); + + procedure fl_text_editor_copy + (TE : in System.Address); + pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); + + procedure fl_text_editor_paste + (TE : in System.Address); + pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); + + procedure fl_text_editor_delete + (TE : in System.Address); + pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); + @@ -55,5 +71,41 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is end Create; + + + procedure Cut + (This : in out Text_Editor) is + begin + fl_text_editor_cut (This.Void_Ptr); + end Cut; + + + + + procedure Copy + (This : in out Text_Editor) is + begin + fl_text_editor_copy (This.Void_Ptr); + end Copy; + + + + + procedure Paste + (This : in out Text_Editor) is + begin + fl_text_editor_paste (This.Void_Ptr); + end Paste; + + + + + procedure Delete + (This : in out Text_Editor) is + begin + fl_text_editor_delete (This.Void_Ptr); + end Delete; + + end FLTK.Widgets.Groups.Text_Displays.Text_Editors; diff --git a/fltk-widgets-groups-text_displays-text_editors.ads b/fltk-widgets-groups-text_displays-text_editors.ads index 5b179b9..37e5464 100644 --- a/fltk-widgets-groups-text_displays-text_editors.ads +++ b/fltk-widgets-groups-text_displays-text_editors.ads @@ -12,6 +12,22 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is return Text_Editor; + procedure Cut + (This : in out Text_Editor); + + + procedure Copy + (This : in out Text_Editor); + + + procedure Paste + (This : in out Text_Editor); + + + procedure Delete + (This : in out Text_Editor); + + private |