Adapad logic now in its own package as singleton, removing the need for unchecked_access callbacks

5 files changed, 226 insertions, 108 deletions

diff --git a/adapad.gpr b/adapad.gpr
index 71d5b60..f1abdce 100644
--- a/adapad.gpr
+++ b/adapad.gpr
@@ -13,11 +13,11 @@ project AdaPad is
     for Source_Dirs use ("src/**");
     for Object_Dir use "obj";
     for Exec_Dir use "bin";
-    for Main use ("adapad.adb");
+    for Main use ("main.adb");
 
 
     package Builder is
-        for Executable("adapad.adb") use "adapad";
+        for Executable("main.adb") use "adapad";
     end Builder;
 
 
diff --git a/src/adapad.adb b/src/adapad.adb
index 943a49c..a28494b 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -13,35 +13,20 @@ with Windows.Replace;
 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 
 
-function Adapad return Integer is
+package body Adapad is
 
 
     package W  renames FLTK.Widgets;
-    package M  renames FLTK.Widgets.Menus;
     package WN renames FLTK.Widgets.Groups.Windows;
-    package TB renames FLTK.Text_Buffers;
     package D  renames FLTK.Popups;
 
 
 
 
-    --  forward declarations of helper functions
-
-    procedure Set_Title;
-    function Safe_To_Discard return Boolean;
-    procedure Do_Save;
-    procedure Do_Save_As;
-    procedure Load_File (Name : in String);
-    procedure Save_File (Name : in String);
-    procedure Centre (Win : in out WN.Window'Class);
-
-
-
-
     --  global state of the text editor
 
     Editor   : Windows.Editor.Editor_Window   := Windows.Editor.Create (800, 500);
-    Buffer   : TB.Text_Buffer                 := TB.Create;
+    Buffer   : FLTK.Text_Buffers.Text_Buffer  := FLTK.Text_Buffers.Create;
     About    : Windows.About.About_Window     := Windows.About.Create;
     Find     : Windows.Find.Find_Window       := Windows.Find.Create;
     Replace  : Windows.Replace.Replace_Window := Windows.Replace.Create;
@@ -52,10 +37,28 @@ function Adapad return Integer is
 
 
 
-    --  callbacks for the menu
+    --  main program interface
+
+    procedure Show is
+    begin
+        Editor.Show;
+    end Show;
+
+
+
 
-    type New_Callback is new W.Widget_Callback with null record;
-    New_CB : aliased New_Callback;
+    procedure Hide is
+    begin
+        About.Hide;
+        Find.Hide;
+        Replace.Hide;
+        Editor.Hide;
+    end Hide;
+
+
+
+
+    --  callbacks for the menu
 
     overriding procedure Call
            (This : in     New_Callback;
@@ -72,9 +75,6 @@ function Adapad return Integer is
 
 
 
-    type Open_Callback is new W.Widget_Callback with null record;
-    Open_CB : aliased Open_Callback;
-
     overriding procedure Call
            (This : in     Open_Callback;
             Item : in out W.Widget'Class) is
@@ -92,9 +92,6 @@ function Adapad return Integer is
 
 
 
-    type Save_Callback is new W.Widget_Callback with null record;
-    Save_CB : aliased Save_Callback;
-
     overriding procedure Call
            (This : in     Save_Callback;
             Item : in out W.Widget'Class) is
@@ -105,9 +102,6 @@ function Adapad return Integer is
 
 
 
-    type Save_As_Callback is new W.Widget_Callback with null record;
-    Save_As_CB : aliased Save_As_Callback;
-
     overriding procedure Call
            (This : in     Save_As_Callback;
             Item : in out W.Widget'Class) is
@@ -118,26 +112,17 @@ function Adapad return Integer is
 
 
 
-    type Quit_Callback is new W.Widget_Callback with null record;
-    Quit_CB : aliased Quit_Callback;
-
     overriding procedure Call
            (This : in     Quit_Callback;
             Item : in out W.Widget'Class) is
     begin
         if not Safe_To_Discard then return; end if;
-        Find.Hide;
-        Replace.Hide;
-        About.Hide;
-        Editor.Hide;
+        Hide;
     end Call;
 
 
 
 
-    type Undo_Callback is new W.Widget_Callback with null record;
-    Undo_CB : aliased Undo_Callback;
-
     overriding procedure Call
            (This : in     Undo_Callback;
             Item : in out W.Widget'Class) is
@@ -148,9 +133,6 @@ function Adapad return Integer is
 
 
 
-    type Cut_Callback is new W.Widget_Callback with null record;
-    Cut_CB : aliased Cut_Callback;
-
     overriding procedure Call
            (This : in     Cut_Callback;
             Item : in out W.Widget'Class) is
@@ -161,9 +143,6 @@ function Adapad return Integer is
 
 
 
-    type Copy_Callback is new W.Widget_Callback with null record;
-    Copy_CB : aliased Copy_Callback;
-
     overriding procedure Call
            (This : in     Copy_Callback;
             Item : in out W.Widget'Class) is
@@ -174,9 +153,6 @@ function Adapad return Integer is
 
 
 
-    type Paste_Callback is new W.Widget_Callback with null record;
-    Paste_CB : aliased Paste_Callback;
-
     overriding procedure Call
            (This : in     Paste_Callback;
             Item : in out W.Widget'Class) is
@@ -187,9 +163,6 @@ function Adapad return Integer is
 
 
 
-    type Delete_Callback is new W.Widget_Callback with null record;
-    Delete_CB : aliased Delete_Callback;
-
     overriding procedure Call
            (This : in     Delete_Callback;
             Item : in out W.Widget'Class) is
@@ -200,9 +173,6 @@ function Adapad return Integer is
 
 
 
-    type Select_All_Callback is new W.Widget_Callback with null record;
-    Select_All_CB : aliased Select_All_Callback;
-
     overriding procedure Call
            (This : in     Select_All_Callback;
             Item : in out W.Widget'Class) is
@@ -213,9 +183,6 @@ function Adapad return Integer is
 
 
 
-    type Find_Callback is new W.Widget_Callback with null record;
-    Find_CB : aliased Find_Callback;
-
     overriding procedure Call
            (This : in     Find_Callback;
             Item : in out W.Widget'Class) is
@@ -227,9 +194,6 @@ function Adapad return Integer is
 
 
 
-    type Replace_Callback is new W.Widget_Callback with null record;
-    Replace_CB : aliased Replace_Callback;
-
     overriding procedure Call
            (This : in     Replace_Callback;
             Item : in out W.Widget'Class) is
@@ -241,9 +205,6 @@ function Adapad return Integer is
 
 
 
-    type About_Callback is new W.Widget_Callback with null record;
-    About_CB : aliased About_Callback;
-
     overriding procedure Call
            (This : in     About_Callback;
             Item : in out W.Widget'Class) is
@@ -257,19 +218,16 @@ function Adapad return Integer is
 
     --  callbacks for the text buffer
 
-    type Mod_Callback is new TB.Modify_Callback with null record;
-    Mod_CB : aliased Mod_Callback;
-
     overriding procedure Call
            (This         : in Mod_Callback;
-            Action       : in TB.Modification;
-            Place        : in TB.Position;
+            Action       : in FLTK.Text_Buffers.Modification;
+            Place        : in FLTK.Text_Buffers.Position;
             Length       : in Natural;
             Deleted_Text : in String)
     is
-        use type TB.Modification;
+        use type FLTK.Text_Buffers.Modification;
     begin
-        if Action = TB.Insert or Action = TB.Delete then
+        if Action = FLTK.Text_Buffers.Insert or Action = FLTK.Text_Buffers.Delete then
             Changed := True;
         end if;
         Set_Title;
@@ -280,9 +238,6 @@ function Adapad return Integer is
 
     --  callbacks for the find/replace windows
 
-    type Do_Find_Callback is new Windows.Find.Find_Callback with null record;
-    Do_Find_CB : aliased Do_Find_Callback;
-
     overriding procedure Call
            (This       : in Do_Find_Callback;
             Item       : in String;
@@ -304,9 +259,6 @@ function Adapad return Integer is
 
 
 
-    type Do_Replace_Callback is new Windows.Replace.Replace_Callback with null record;
-    Do_Replace_CB : aliased Do_Replace_Callback;
-
     overriding procedure Call
            (This                    : in Do_Replace_Callback;
             Item, Replace_With      : in String;
@@ -456,43 +408,40 @@ begin
 
 
     declare
-        Bar : M.Menu_Cursor := Editor.Get_Menu;
-        use type M.Shortcut_Key;
-        use type M.Modifier_Key;
+        use FLTK.Widgets.Menus;
+        Bar : Menu_Cursor := Editor.Get_Menu;
     begin
-        Bar.Add (Text => "&File",   Flags => M.Flag_Submenu);
-        Bar.Add ("File/&New",          New_CB'Access,        M.Mod_Ctrl + 'n');
-        Bar.Add ("File/&Open...",      Open_CB'Access,       M.Mod_Ctrl + 'o');
-        Bar.Add ("File/&Save",         Save_CB'Access,       M.Mod_Ctrl + 's');
-        Bar.Add ("File/Save &As...", Save_As_CB'Access, M.Mod_Shift + M.Mod_Ctrl + 's', M.Flag_Divider);
-        Bar.Add ("File/&Quit",         Quit_CB'Access,       M.Mod_Ctrl + 'q');
-
-        Bar.Add (Text => "&Edit",   Flags => M.Flag_Submenu);
-        Bar.Add ("Edit/&Undo",         Undo_CB'Access,       M.Mod_Ctrl + 'z',    M.Flag_Divider);
-        Bar.Add ("Edit/Cu&t",          Cut_CB'Access,        M.Mod_Ctrl + 'x');
-        Bar.Add ("Edit/&Copy",         Copy_CB'Access,       M.Mod_Ctrl + 'c');
-        Bar.Add ("Edit/&Paste",        Paste_CB'Access,      M.Mod_Ctrl + 'v');
-        Bar.Add ("Edit/&Delete",       Delete_CB'Access,     M.No_Key,            M.Flag_Divider);
-        Bar.Add ("Edit/Select &All",   Select_All_CB'Access, M.Mod_Ctrl + 'a');
-
-        Bar.Add (Text => "&Search", Flags => M.Flag_Submenu);
-        Bar.Add ("Search/&Find...",    Find_CB'Access,       M.Mod_Ctrl + 'f');
-        Bar.Add ("Search/&Replace...", Replace_CB'Access,    M.Mod_Ctrl + 'h');
-
-        Bar.Add (Text => "&Help",   Flags => M.Flag_Submenu);
+        Bar.Add (Text => "&File",   Flags => Flag_Submenu);
+        Bar.Add ("File/&New",          New_CB'Access,        Mod_Ctrl + 'n');
+        Bar.Add ("File/&Open...",      Open_CB'Access,       Mod_Ctrl + 'o');
+        Bar.Add ("File/&Save",         Save_CB'Access,       Mod_Ctrl + 's');
+        Bar.Add ("File/Save &As...", Save_As_CB'Access, Mod_Shift + Mod_Ctrl + 's', Flag_Divider);
+        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/Cu&t",          Cut_CB'Access,        Mod_Ctrl + 'x');
+        Bar.Add ("Edit/&Copy",         Copy_CB'Access,       Mod_Ctrl + 'c');
+        Bar.Add ("Edit/&Paste",        Paste_CB'Access,      Mod_Ctrl + 'v');
+        Bar.Add ("Edit/&Delete",       Delete_CB'Access,     No_Key,            Flag_Divider);
+        Bar.Add ("Edit/Select &All",   Select_All_CB'Access, Mod_Ctrl + 'a');
+
+        Bar.Add (Text => "&Search", Flags => Flag_Submenu);
+        Bar.Add ("Search/&Find...",    Find_CB'Access,       Mod_Ctrl + 'f');
+        Bar.Add ("Search/&Replace...", Replace_CB'Access,    Mod_Ctrl + 'h');
+
+        Bar.Add (Text => "&Help",   Flags => Flag_Submenu);
         Bar.Add ("Help/&About",        About_CB'Access);
     end;
 
 
-    Find.Set_Find_Callback (Do_Find_CB'Unchecked_Access);
-    Replace.Set_Replace_Callback (Do_Replace_CB'Unchecked_Access);
-    Buffer.Add_Modify_Callback (Mod_CB'Unchecked_Access);
-    Editor.Set_Callback (Quit_CB'Unchecked_Access);
+    Find.Set_Find_Callback (Do_Find_CB'Access);
+    Replace.Set_Replace_Callback (Do_Replace_CB'Access);
+    Buffer.Add_Modify_Callback (Mod_CB'Access);
+    Editor.Set_Callback (Quit_CB'Access);
 
 
     Editor.Set_Buffer (Buffer);
-    Editor.Show;
-    return FLTK.Run;
 
 
 end Adapad;
diff --git a/src/adapad.ads b/src/adapad.ads
new file mode 100644
index 0000000..9bb11b2
--- /dev/null
+++ b/src/adapad.ads
@@ -0,0 +1,158 @@
+
+
+private with FLTK.Widgets;
+private with FLTK.Widgets.Groups.Windows;
+private with FLTK.Text_Buffers;
+private with Windows.Find;
+private with Windows.Replace;
+
+
+package Adapad is
+
+
+    procedure Show;
+    procedure Hide;
+
+
+private
+
+
+    --  helper functions
+
+    procedure Set_Title;
+    function Safe_To_Discard return Boolean;
+    procedure Do_Save;
+    procedure Do_Save_As;
+    procedure Load_File (Name : in String);
+    procedure Save_File (Name : in String);
+    procedure Centre (Win : in out FLTK.Widgets.Groups.Windows.Window'Class);
+
+
+    --  callbacks
+
+    type New_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     New_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    New_CB : aliased New_Callback;
+
+
+    type Open_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Open_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Open_CB : aliased Open_Callback;
+
+
+    type Save_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Save_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Save_CB : aliased Save_Callback;
+
+
+    type Save_As_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Save_As_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Save_As_CB : aliased Save_As_Callback;
+
+
+    type Quit_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Quit_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Quit_CB : aliased Quit_Callback;
+
+
+    type Undo_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Undo_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Undo_CB : aliased Undo_Callback;
+
+
+    type Cut_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Cut_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Cut_CB : aliased Cut_Callback;
+
+
+    type Copy_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Copy_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Copy_CB : aliased Copy_Callback;
+
+
+    type Paste_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Paste_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Paste_CB : aliased Paste_Callback;
+
+
+    type Delete_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Delete_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Delete_CB : aliased Delete_Callback;
+
+
+    type Select_All_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Select_All_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Select_All_CB : aliased Select_All_Callback;
+
+
+    type Find_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Find_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Find_CB : aliased Find_Callback;
+
+
+    type Replace_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     Replace_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    Replace_CB : aliased Replace_Callback;
+
+
+    type About_Callback is new FLTK.Widgets.Widget_Callback with null record;
+    overriding procedure Call
+           (This : in     About_Callback;
+            Item : in out FLTK.Widgets.Widget'Class);
+    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;
+
+
+    type Do_Find_Callback is new Windows.Find.Find_Callback with null record;
+    overriding procedure Call
+           (This       : in Do_Find_Callback;
+            Item       : in String;
+            Match_Case : in Boolean);
+    Do_Find_CB : aliased Do_Find_Callback;
+
+
+    type Do_Replace_Callback is new Windows.Replace.Replace_Callback with null record;
+    overriding procedure Call
+           (This                    : in Do_Replace_Callback;
+            Item, Replace_With      : in String;
+            Match_Case, Replace_All : in Boolean);
+    Do_Replace_CB : aliased Do_Replace_Callback;
+
+
+end Adapad;
+
diff --git a/src/main.adb b/src/main.adb
new file mode 100644
index 0000000..7f31554
--- /dev/null
+++ b/src/main.adb
@@ -0,0 +1,12 @@
+
+
+with FLTK;
+with Adapad;
+
+
+function Main return Integer is
+begin
+    Adapad.Show;
+    return FLTK.Run;
+end Main;
+
diff --git a/to_do.txt b/to_do.txt
index ac7acc2..af2080c 100644
--- a/to_do.txt
+++ b/to_do.txt
@@ -3,7 +3,6 @@
 To Do:
 
 - change build to be dynamically linked
-- remove the need for unchecked_access callbacks
 - improve find, replace, undo/redo
 - add word count feature
 - suppress unnecessary left/right scrollbar