From 646bb5b98226ecfcee8b02d669b9cef5d00bbded Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 11 Nov 2016 08:00:48 +1100 Subject: Simplified text_buffer callbacks --- src/adapad.adb | 7 +++---- src/adapad.ads | 10 ---------- src/fltk_binding/fltk-text_buffers.adb | 16 +++++++--------- src/fltk_binding/fltk-text_buffers.ads | 32 ++++++++++++-------------------- 4 files changed, 22 insertions(+), 43 deletions(-) diff --git a/src/adapad.adb b/src/adapad.adb index 1f2c03d..5d53d7c 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -212,9 +212,8 @@ package body Adapad is -- callbacks for the text buffer - overriding procedure Call - (This : in Mod_Callback; - Action : in FLTK.Text_Buffers.Modification; + procedure Mod_CB + (Action : in FLTK.Text_Buffers.Modification; Place : in FLTK.Text_Buffers.Position; Length : in Natural; Deleted_Text : in String) @@ -225,7 +224,7 @@ package body Adapad is Changed := True; end if; Set_Title; - end Call; + end Mod_CB; diff --git a/src/adapad.ads b/src/adapad.ads index 0a739de..45cd6ad 100644 --- a/src/adapad.ads +++ b/src/adapad.ads @@ -128,15 +128,5 @@ private About_CB : aliased About_Callback; - type Mod_Callback is new FLTK.Text_Buffers.Modify_Callback with null record; - overriding procedure Call - (This : in Mod_Callback; - Action : in FLTK.Text_Buffers.Modification; - Place : in FLTK.Text_Buffers.Position; - Length : in Natural; - Deleted_Text : in String); - Mod_CB : aliased Mod_Callback; - - end Adapad; diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb index 736e32e..7529c1c 100644 --- a/src/fltk_binding/fltk-text_buffers.adb +++ b/src/fltk_binding/fltk-text_buffers.adb @@ -2,7 +2,7 @@ with Interfaces.C; with Interfaces.C.Strings; -with Ada.Strings.Unbounded; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Containers; with System; use type System.Address; @@ -112,12 +112,10 @@ package body FLTK.Text_Buffers is 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 (""); + Deleted_Text : Unbounded_String := To_Unbounded_String (""); Ada_Text_Buffer : access Text_Buffer := Text_Buffer_Convert.To_Pointer (UD); @@ -129,7 +127,7 @@ package body FLTK.Text_Buffers is Length := Natural (Deleted); Action := Delete; if Text /= Interfaces.C.Strings.Null_Ptr then - Deleted_Text := UStr.To_Unbounded_String (Interfaces.C.Strings.Value (Text)); + Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); end if; elsif Restyled > 0 then Length := Natural (Restyled); @@ -140,7 +138,7 @@ package body FLTK.Text_Buffers is end if; for CB of Ada_Text_Buffer.Modify_CBs loop - CB.Call (Action, Place, Length, UStr.To_String (Deleted_Text)); + CB.all (Action, Place, Length, To_String (Deleted_Text)); end loop; end Modify_Callback_Hook; @@ -163,7 +161,7 @@ package body FLTK.Text_Buffers is Text_Buffer_Convert.To_Pointer (UD); begin for CB of Ada_Text_Buffer.Predelete_CBs loop - CB.Call (Place, Length); + CB.all (Place, Length); end loop; end Predelete_Callback_Hook; @@ -190,7 +188,7 @@ package body FLTK.Text_Buffers is procedure Add_Modify_Callback (This : in out Text_Buffer; - Func : not null access Modify_Callback'Class) is + Func : in Modify_Callback) is begin if This.Modify_CBs.Length = 0 then fl_text_buffer_add_modify_callback @@ -206,7 +204,7 @@ package body FLTK.Text_Buffers is procedure Add_Predelete_Callback (This : in out Text_Buffer; - Func : not null access Predelete_Callback'Class) is + Func : in Predelete_Callback) is begin if This.Predelete_CBs.Length = 0 then fl_text_buffer_add_predelete_callback diff --git a/src/fltk_binding/fltk-text_buffers.ads b/src/fltk_binding/fltk-text_buffers.ads index a560076..a021dbf 100644 --- a/src/fltk_binding/fltk-text_buffers.ads +++ b/src/fltk_binding/fltk-text_buffers.ads @@ -13,23 +13,19 @@ package FLTK.Text_Buffers is type Position is new Natural; + type Modification is (Insert, Restyle, Delete, None); - type Modification is (Insert, Restyle, Delete, None); - type Modify_Callback is interface; - procedure Call - (This : in Modify_Callback; - Action : in Modification; + type Modify_Callback is access procedure + (Action : in Modification; Place : in Position; Length : in Natural; - Deleted_Text : in String) is abstract; + Deleted_Text : in String); - type Predelete_Callback is interface; - procedure Call - (This : in Predelete_Callback; - Place : in Position; - Length : in Natural) is abstract; + type Predelete_Callback is access procedure + (Place : in Position; + Length : in Natural); function Create @@ -40,12 +36,12 @@ package FLTK.Text_Buffers is procedure Add_Modify_Callback (This : in out Text_Buffer; - Func : not null access Modify_Callback'Class); + Func : in Modify_Callback); procedure Add_Predelete_Callback (This : in out Text_Buffer; - Func : not null access Predelete_Callback'Class); + Func : in Predelete_Callback); procedure Call_Modify_Callbacks @@ -98,21 +94,17 @@ package FLTK.Text_Buffers is private - 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); + Element_Type => Modify_Callback); package Predelete_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, - Element_Type => Predelete_Access); + Element_Type => Predelete_Callback); type Text_Buffer is new Wrapper with record - Modify_CBs : Modify_Vectors.Vector; + Modify_CBs : Modify_Vectors.Vector; Predelete_CBs : Predelete_Vectors.Vector; end record; -- cgit