summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--adapad.gpr4
-rw-r--r--src/adapad.adb159
-rw-r--r--src/adapad.ads158
-rw-r--r--src/main.adb12
-rw-r--r--to_do.txt1
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