summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--c_fl_text_buffer.cpp10
-rw-r--r--c_fl_text_buffer.h4
-rw-r--r--c_fl_text_editor.cpp22
-rw-r--r--c_fl_text_editor.h6
-rw-r--r--fltk-text_buffers.adb125
-rw-r--r--fltk-text_buffers.ads55
-rw-r--r--fltk-widgets-groups-text_displays-text_editors.adb52
-rw-r--r--fltk-widgets-groups-text_displays-text_editors.ads16
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