From 395e2de5b0d834091637820fc04d731721c771b7 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 16 Sep 2016 04:10:49 +1000
Subject: Adapad menus and callbacks now present in skeleton form, also
 Text_Buffers have callbacks too

---
 src/fltk_binding/fltk-text_buffers.adb | 125 +++++++++++++++++++++++++++++++++
 1 file changed, 125 insertions(+)

(limited to 'src/fltk_binding/fltk-text_buffers.adb')

diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb
index 52f475d..fa2a259 100644
--- a/src/fltk_binding/fltk-text_buffers.adb
+++ b/src/fltk_binding/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;
 
-- 
cgit