Adapad menus and callbacks now present in skeleton form, also Text_Buffers have callbacks too

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