summaryrefslogtreecommitdiff
path: root/src/adapad.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/adapad.adb')
-rw-r--r--src/adapad.adb197
1 files changed, 104 insertions, 93 deletions
diff --git a/src/adapad.adb b/src/adapad.adb
index 079fad3..ee0941a 100644
--- a/src/adapad.adb
+++ b/src/adapad.adb
@@ -1,25 +1,28 @@
with FLTK;
-with Editor_Windows;
-use Editor_Windows;
-with FLTK.Text_Buffers;
-use FLTK.Text_Buffers;
with FLTK.Widgets;
-use FLTK.Widgets;
with FLTK.Widgets.Menus;
-use FLTK.Widgets.Menus;
-with FLTK.Popups;
-use FLTK.Popups;
with FLTK.Widgets.Groups.Windows;
-use FLTK.Widgets.Groups.Windows;
-with Ada.Strings.Unbounded;
-use Ada.Strings.Unbounded;
+with FLTK.Text_Buffers;
+with FLTK.Popups;
+with Editor_Windows;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
function Adapad return Integer 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;
+ package ED renames Editor_Windows;
+
+
+
+
-- forward declarations of helper functions
procedure Set_Title;
@@ -28,18 +31,18 @@ function Adapad return Integer is
procedure Do_Save_As;
procedure Load_File (Name : in String);
procedure Save_File (Name : in String);
- procedure Centre (Win : in out Window'Class);
+ procedure Centre (Win : in out WN.Window'Class);
-- global state of the text editor
- Editor : Editor_Window := Create (800, 500);
- Buffer : Text_Buffer := Create;
- About : About_Window := Create;
- Find : Find_Window := Create;
- Replace : Replace_Window := Create;
+ Editor : ED.Editor_Window := ED.Create (800, 500);
+ Buffer : TB.Text_Buffer := TB.Create;
+ About : ED.About_Window := ED.Create;
+ Find : ED.Find_Window := ED.Create;
+ Replace : ED.Replace_Window := ED.Create;
Changed : Boolean := False;
Filename : Unbounded_String := To_Unbounded_String (0);
@@ -49,12 +52,12 @@ function Adapad return Integer is
-- callbacks for the menu
- type New_Callback is new Widget_Callback with null record;
+ type New_Callback is new W.Widget_Callback with null record;
New_CB : aliased New_Callback;
overriding procedure Call
(This : in New_Callback;
- Item : in out Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
if not Safe_To_Discard then return; end if;
Filename := To_Unbounded_String (0);
@@ -67,16 +70,16 @@ function Adapad return Integer is
- type Open_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
if not Safe_To_Discard then return; end if;
declare
- New_Filename : String := File_Chooser ("Open File?", "*", To_String (Filename));
+ New_Filename : String := D.File_Chooser ("Open File?", "*", To_String (Filename));
begin
if New_Filename /= "" then
Load_File (New_Filename);
@@ -87,12 +90,12 @@ function Adapad return Integer is
- type Save_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Do_Save;
end Call;
@@ -100,12 +103,12 @@ function Adapad return Integer is
- type Save_As_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Do_Save_As;
end Call;
@@ -113,12 +116,12 @@ function Adapad return Integer is
- type Quit_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
if not Safe_To_Discard then return; end if;
Find.Hide;
@@ -130,12 +133,12 @@ function Adapad return Integer is
- type Undo_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Editor.Undo;
end Call;
@@ -143,12 +146,12 @@ function Adapad return Integer is
- type Cut_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Editor.Cut;
end Call;
@@ -156,12 +159,12 @@ function Adapad return Integer is
- type Copy_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Editor.Copy;
end Call;
@@ -169,12 +172,12 @@ function Adapad return Integer is
- type Paste_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Editor.Paste;
end Call;
@@ -182,12 +185,12 @@ function Adapad return Integer is
- type Delete_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Editor.Delete;
end Call;
@@ -195,12 +198,12 @@ function Adapad return Integer is
- type Select_All_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Buffer.Set_Selection (0, Buffer.Length);
end Call;
@@ -208,12 +211,12 @@ function Adapad return Integer is
- type Find_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Centre (Find);
Find.Show;
@@ -222,12 +225,12 @@ function Adapad return Integer is
- type Replace_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Centre (Replace);
Replace.Show;
@@ -236,12 +239,12 @@ function Adapad return Integer is
- type About_Callback is new Widget_Callback with null record;
+ 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 Widget'Class) is
+ Item : in out W.Widget'Class) is
begin
Centre (About);
About.Show;
@@ -252,17 +255,19 @@ function Adapad return Integer is
-- callbacks for the text buffer
- type Mod_Callback is new Modify_Callback with null record;
+ 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 Modification;
- Place : in Position;
+ Action : in TB.Modification;
+ Place : in TB.Position;
Length : in Natural;
- Deleted_Text : in String) is
+ Deleted_Text : in String)
+ is
+ use type TB.Modification;
begin
- if Action = Insert or Action = Delete then
+ if Action = TB.Insert or Action = TB.Delete then
Changed := True;
end if;
Set_Title;
@@ -279,10 +284,9 @@ function Adapad return Integer is
overriding procedure Call
(This : in Do_Find_Callback;
Item : in String;
- Match_Case : in Boolean) is
-
+ Match_Case : in Boolean)
+ is
Current_Position, Found_At : Natural;
-
begin
Find.Hide;
Current_Position := Editor.Get_Insert_Position;
@@ -291,7 +295,7 @@ function Adapad return Integer is
Editor.Set_Insert_Position (Found_At + Item'Length);
Editor.Show_Insert_Position;
else
- Alert ("No occurrences of '" & Item & "' found!");
+ D.Alert ("No occurrences of '" & Item & "' found!");
end if;
end Call;
@@ -304,11 +308,10 @@ function Adapad return Integer is
overriding procedure Call
(This : in Do_Replace_Callback;
Item, Replace_With : in String;
- Match_Case, Replace_All : in Boolean) is
-
+ Match_Case, Replace_All : in Boolean)
+ is
Current_Position, Found_At : Natural;
Times_Replaced : Natural := 0;
-
begin
Replace.Hide;
@@ -329,9 +332,9 @@ function Adapad return Integer is
end loop;
if Times_Replaced > 0 then
- Message_Box ("Replaced " & Integer'Image (Times_Replaced) & " occurrences.");
+ D.Message_Box ("Replaced " & Integer'Image (Times_Replaced) & " occurrences.");
else
- Alert ("No occurrences of '" & Item & "' found!");
+ D.Alert ("No occurrences of '" & Item & "' found!");
end if;
end Call;
@@ -357,21 +360,23 @@ function Adapad return Integer is
- function Safe_To_Discard return Boolean is
- User_Response : Choice;
+ function Safe_To_Discard
+ return Boolean
+ is
+ User_Response : D.Choice;
begin
if not Changed then return True; end if;
- User_Response := Three_Way_Choice
+ User_Response := D.Three_Way_Choice
("The current file has not been saved." & Character'Val (10) &
"Would you like to save it now?",
"Cancel", "Save", "Discard");
case User_Response is
- when First =>
+ when D.First =>
return False;
- when Second =>
+ when D.Second =>
Do_Save;
return not Changed;
- when Third =>
+ when D.Third =>
return True;
end case;
end Safe_To_Discard;
@@ -392,7 +397,7 @@ function Adapad return Integer is
procedure Do_Save_As is
- New_Filename : String := File_Chooser
+ New_Filename : String := D.File_Chooser
("Save File As?", "*", To_String (Filename));
begin
if New_Filename /= "" then
@@ -403,7 +408,8 @@ function Adapad return Integer is
- procedure Load_File (Name : in String) is
+ procedure Load_File
+ (Name : in String) is
begin
Buffer.Load_File (Name);
Filename := To_Unbounded_String (Name);
@@ -411,13 +417,14 @@ function Adapad return Integer is
Buffer.Call_Modify_Callbacks;
exception
when Storage_Error =>
- Alert ("Error reading from file " & Name);
+ D.Alert ("Error reading from file " & Name);
end Load_File;
- procedure Save_File (Name : in String) is
+ procedure Save_File
+ (Name : in String) is
begin
Buffer.Save_File (Name);
Filename := To_Unbounded_String (Name);
@@ -425,13 +432,15 @@ function Adapad return Integer is
Buffer.Call_Modify_Callbacks;
exception
when Storage_Error =>
- Alert ("Error writing to file " & Name);
+ D.Alert ("Error writing to file " & Name);
end Save_File;
- procedure Centre (Win : in out Window'Class) is
+ procedure Centre
+ (Win : in out WN.Window'Class)
+ is
Middle_X : Integer := Editor.Get_X + Editor.Get_W / 2;
Middle_Y : Integer := Editor.Get_Y + Editor.Get_H / 2;
begin
@@ -445,28 +454,30 @@ begin
declare
- Bar : Menu_Cursor := Editor.Get_Menu;
+ Bar : M.Menu_Cursor := Editor.Get_Menu;
+ use type M.Shortcut_Key;
+ use type M.Modifier_Key;
begin
- 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 (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 ("Help/&About", About_CB'Access);
end;