Undo/Redo now unlimited, very rough Change_Vectors package created to accommodate

5 files changed, 342 insertions, 7 deletions

diff --git a/src/adapad.adb b/src/adapad.adb
index 82aa1ad..154e636 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -4,14 +4,19 @@ with FLTK.Widgets.Menus;
 with FLTK.Widgets.Groups.Windows;
 with FLTK.Text_Buffers;
 with FLTK.Dialogs;
+with FLTK.Enums; use FLTK.Enums;
 with Windows.Editor;
 with Windows.About;
 with Windows.Find;
 with Windows.Replace;
 with Windows.Jump;
+with Change_Vectors;
 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 
 
+with Ada.Text_IO;
+
+
 package body Adapad is
 
 
@@ -37,8 +42,9 @@ package body Adapad is
     Replace  : Windows.Replace.Replace_Window := Windows.Replace.Create;
     Jump     : Windows.Jump.Jump_Window       := Windows.Jump.Create;
 
-    Changed  : Boolean          := False;
-    Filename : Unbounded_String := To_Unbounded_String (0);
+    Changed  : Boolean                      := False;
+    Mod_List : Change_Vectors.Change_Vector := Change_Vectors.Empty_Vector;
+    Filename : Unbounded_String             := To_Unbounded_String (0);
 
 
 
@@ -126,14 +132,67 @@ package body Adapad is
 
 
     procedure Undo_CB
-           (Item : in out FLTK.Widgets.Widget'Class) is
+           (Item : in out FLTK.Widgets.Widget'Class)
+    is
+        use type FLTK.Text_Buffers.Modification;
+        Bar : FLTK.Widgets.Menus.Menu_Cursor := Editor.Get_Menu_Bar;
+        Ch  : Change_Vectors.Change;
     begin
-        Editor.Undo;
+        Buffer.Disable_Callbacks;
+
+        if Mod_List.Peek (Ch) then
+            if Ch.Action = FLTK.Text_Buffers.Insert then
+                Buffer.Remove_Text (Integer (Ch.Place), Integer (Ch.Place) + Ch.Length);
+                Editor.Set_Insert_Position (Integer (Ch.Place));
+            else
+                Buffer.Insert_Text (Integer (Ch.Place), To_String (Ch.Text));
+                Editor.Set_Insert_Position (Integer (Ch.Place) + Ch.Length);
+            end if;
+            Editor.Show_Insert_Position;
+            Mod_List.Pop;
+            Bar.Find_Item ("&Edit/&Redo").Activate;
+            if Mod_List.At_Start then
+                Bar.Find_Item ("&Edit/&Undo").Deactivate;
+            end if;
+        end if;
+
+        Buffer.Enable_Callbacks;
     end Undo_CB;
 
 
 
 
+    procedure Redo_CB
+           (Item : in out FLTK.Widgets.Widget'Class)
+    is
+        use type FLTK.Text_Buffers.Modification;
+        Bar : FLTK.Widgets.Menus.Menu_Cursor := Editor.Get_Menu_Bar;
+        Ch  : Change_Vectors.Change;
+    begin
+        Buffer.Disable_Callbacks;
+
+        if Mod_List.Re_Push then
+            Mod_List.Peek (Ch);
+            if Ch.Action = FLTK.Text_Buffers.Insert then
+                Buffer.Insert_Text (Integer (Ch.Place), To_String (Ch.Text));
+                Editor.Set_Insert_Position (Integer (Ch.Place) + Ch.Length);
+            else
+                Buffer.Remove_Text (Integer (Ch.Place), Integer (Ch.Place) + Ch.Length);
+                Editor.Set_Insert_Position (Integer (Ch.Place));
+            end if;
+            Editor.Show_Insert_Position;
+            Bar.Find_Item ("&Edit/&Undo").Activate;
+            if Mod_List.At_End then
+                Bar.Find_Item ("&Edit/&Redo").Deactivate;
+            end if;
+        end if;
+
+        Buffer.Enable_Callbacks;
+    end Redo_CB;
+
+
+
+
     procedure Cut_CB
            (Item : in out FLTK.Widgets.Widget'Class) is
     begin
@@ -302,6 +361,24 @@ package body Adapad is
         if Action = FLTK.Text_Buffers.Insert or Action = FLTK.Text_Buffers.Delete then
             Changed := True;
             Set_Title;
+            declare
+                Ch : Change_Vectors.Change;
+            begin
+                Ch.Action := Action;
+                Ch.Place := Place;
+                Ch.Length := Length;
+                if Action = FLTK.Text_Buffers.Insert then
+                    Ch.Text := To_Unbounded_String
+                           (Buffer.Text_At (Integer (Place), Integer (Place) + Length));
+                else
+                    Ch.Text := To_Unbounded_String (Deleted_Text);
+                end if;
+                Mod_List.Push (Ch);
+                Bar.Find_Item ("&Edit/&Undo").Activate;
+                if Mod_List.At_End then
+                    Bar.Find_Item ("&Edit/&Redo").Deactivate;
+                end if;
+            end;
         end if;
 
         if Buffer.Has_Selection then
@@ -558,7 +635,8 @@ begin
         Bar.Add ("File/&Quit",         Quit_CB'Access,       Mod_Ctrl + 'q');
 
         Bar.Add (Text => "&Edit",   Flags => Flag_Submenu);
-        Bar.Add ("Edit/&Undo",         Undo_CB'Access,       Mod_Ctrl + 'z',    Flag_Divider);
+        Bar.Add ("Edit/&Undo",         Undo_CB'Access,       Mod_Ctrl + 'z',    Flag_Inactive);
+        Bar.Add ("Edit/&Redo", Redo_CB'Access, Mod_Shift + Mod_Ctrl + 'z', Flag_Inactive + Flag_Divider);
         Bar.Add ("Edit/Cu&t",          Cut_CB'Access,        Mod_Ctrl + 'x',    Flag_Inactive);
         Bar.Add ("Edit/&Copy",         Copy_CB'Access,       Mod_Ctrl + 'c',    Flag_Inactive);
         Bar.Add ("Edit/&Paste",        Paste_CB'Access,      Mod_Ctrl + 'v');
diff --git a/src/change_vectors.adb b/src/change_vectors.adb
new file mode 100644
index 0000000..65a1f99
--- /dev/null
+++ b/src/change_vectors.adb
@@ -0,0 +1,165 @@
+
+
+with FLTK.Text_Buffers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+use type FLTK.Text_Buffers.Modification;
+use type FLTK.Text_Buffers.Position;
+
+
+with Ada.Text_IO;
+
+
+package body Change_Vectors is
+
+
+    procedure Push
+           (This : in out Change_Vector;
+            Item : in     Change)
+    is
+        procedure App (Ch : in out Change) is
+        begin
+            Ch.Length := Ch.Length + 1;
+            Append (Ch.Text, Item.Text);
+        end App;
+        procedure Pre (Ch : in out Change) is
+        begin
+            Ch.Length := Ch.Length + 1;
+            Ch.Text := Item.Text & Ch.Text;
+            Ch.Place := Ch.Place - 1;
+        end Pre;
+    begin
+        if Item.Action = FLTK.Text_Buffers.Insert then
+            if This.Near > 0 and then
+                This.List.Element (This.Near).Action = FLTK.Text_Buffers.Insert and then
+                Integer (This.List.Element (This.Near).Place) + This.List.Element (This.Near).Length = Integer (Item.Place) and then
+                Item.Length = 1 and then
+                (Element (This.List.Element (This.Near).Text, This.List.Element (This.Near).Length) /= ' ' or else
+                    Element (Item.Text, (1)) = ' ') then
+                This.List.Update_Element (This.Near, App'Access);
+            else
+                This.Near := This.Near + 1;
+                This.List.Insert (This.Near, Item);
+            end if;
+        elsif Item.Action = FLTK.Text_Buffers.Delete then
+            if This.Near > 0 then
+                if This.List.Element (This.Near).Action = FLTK.Text_Buffers.Delete and then
+                    This.List.Element (This.Near).Place = Item.Place and then Item.Length = 1 then
+                    This.List.Update_Element (This.Near, App'Access);
+                elsif This.List.Element (This.Near).Action = FLTK.Text_Buffers.Delete and then
+                    This.List.Element (This.Near).Place = Item.Place + 1 and then Item.Length = 1 then
+                    This.List.Update_Element (This.Near, Pre'Access);
+                else
+                    This.Near := This.Near + 1;
+                    This.List.Insert (This.Near, Item);
+                end if;
+            end if;
+        end if;
+        This.Far := This.Near;
+        while Integer (This.List.Length) > This.Far loop
+            This.List.Delete_Last;
+        end loop;
+    end Push;
+
+
+
+
+    function Pop
+           (This : in out Change_Vector)
+        return Boolean is
+    begin
+        if This.Near > 0 then
+            This.Near := This.Near - 1;
+            return True;
+        else
+            return False;
+        end if;
+    end Pop;
+
+
+
+
+    procedure Pop
+           (This : in out Change_Vector) is
+    begin
+        if This.Near > 0 then
+            This.Near := This.Near - 1;
+        end if;
+    end Pop;
+
+
+
+
+    function Peek
+           (This : in     Change_Vector;
+            Item :    out Change)
+        return Boolean is
+    begin
+        if This.Near > 0 then
+            Item := This.List.Element (This.Near);
+            return True;
+        else
+            return False;
+        end if;
+    end Peek;
+
+
+
+
+    procedure Peek
+           (This : in     Change_Vector;
+            Item :    out Change) is
+    begin
+        if This.Near > 0 then
+            Item := This.List.Element (This.Near);
+        end if;
+    end Peek;
+
+
+
+
+    function Re_Push
+           (This : in out Change_Vector)
+        return Boolean is
+    begin
+        if This.Near < This.Far then
+            This.Near := This.Near + 1;
+            return True;
+        else
+            return False;
+        end if;
+    end Re_Push;
+
+
+
+
+    procedure Re_Push
+           (This : in out Change_Vector) is
+    begin
+        if This.Near < This.Far then
+            This.Near := This.Near + 1;
+        end if;
+    end Re_Push;
+
+
+
+
+    function At_Start
+           (This : in Change_Vector)
+        return Boolean is
+    begin
+        return This.Near = 0;
+    end At_Start;
+
+
+
+
+    function At_End
+           (This : in Change_Vector)
+        return Boolean is
+    begin
+        return This.Near >= This.Far;
+    end At_End;
+
+
+end Change_Vectors;
+
diff --git a/src/change_vectors.ads b/src/change_vectors.ads
new file mode 100644
index 0000000..b2b74b7
--- /dev/null
+++ b/src/change_vectors.ads
@@ -0,0 +1,91 @@
+
+
+with FLTK.Text_Buffers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+private with Ada.Containers.Vectors;
+
+
+package Change_Vectors is
+
+
+    type Change_Vector is tagged private;
+
+
+    type Change is
+        record
+            Action : FLTK.Text_Buffers.Modification;
+            Place  : FLTK.Text_Buffers.Position;
+            Length : Natural;
+            Text   : Unbounded_String;
+        end record;
+
+
+    Empty_Vector : constant Change_Vector;
+
+
+    procedure Push
+           (This : in out Change_Vector;
+            Item : in     Change);
+
+
+    function Pop
+           (This : in out Change_Vector)
+        return Boolean;
+
+
+    procedure Pop
+           (This : in out Change_Vector);
+
+
+    function Peek
+           (This : in     Change_Vector;
+            Item :    out Change)
+        return Boolean;
+
+
+    procedure Peek
+           (This : in     Change_Vector;
+            Item :    out Change);
+
+
+    function Re_Push
+           (This : in out Change_Vector)
+        return Boolean;
+
+
+    procedure Re_Push
+           (This : in out Change_Vector);
+
+
+    function At_Start
+           (This : in Change_Vector)
+        return Boolean;
+
+
+    function At_End
+           (This : in Change_Vector)
+        return Boolean;
+
+
+private
+
+
+    package Internal_Vectors is new Ada.Containers.Vectors
+           (Index_Type => Positive, Element_Type => Change);
+
+
+    type Change_Vector is tagged
+        record
+            Near, Far : Natural;
+            List      : Internal_Vectors.Vector;
+        end record;
+
+
+    Empty_Vector : constant Change_Vector :=
+           (Near => 0,
+            Far => 0,
+            List => Internal_Vectors.Empty_Vector);
+
+
+end Change_Vectors;
+
diff --git a/src/windows-editor.adb b/src/windows-editor.adb
index fdf95c7..e6d98bf 100644
--- a/src/windows-editor.adb
+++ b/src/windows-editor.adb
@@ -60,6 +60,8 @@ package body Windows.Editor is
             This.Set_Resizable (This.Editor);
             This.Set_Size_Range (Min_Editor_Width, Min_Editor_Height);
             This.Set_Icon (Logo);
+
+            This.Editor.Remove_Key_Binding (Mod_Ctrl + 'z');
         end return;
     end Create;
 
diff --git a/to_do.txt b/to_do.txt
index 89c0ed0..e11c4f2 100644
--- a/to_do.txt
+++ b/to_do.txt
@@ -3,9 +3,8 @@
 To Do:
 
 - change build to be dynamically linked
-- improve undo/redo
 - suppress unnecessary left/right scrollbar
-- clean up menu widget code, adapad menu and callback code
+- clean up menu widget code, adapad menu and callback code, change_vector code
 - make shortcut_key types private somehow
 - introduce maybe type to eliminate out parameters in search_forward/search_backward
 - eliminate image/text_buffer runtime warnings