diff options
| -rw-r--r-- | src/adapad.adb | 88 | ||||
| -rw-r--r-- | src/change_vectors.adb | 165 | ||||
| -rw-r--r-- | src/change_vectors.ads | 91 | ||||
| -rw-r--r-- | src/windows-editor.adb | 2 | ||||
| -rw-r--r-- | to_do.txt | 3 |
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; @@ -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 |