diff options
| -rw-r--r-- | adapad.gpr | 4 | ||||
| -rw-r--r-- | src/adapad.adb | 159 | ||||
| -rw-r--r-- | src/adapad.ads | 158 | ||||
| -rw-r--r-- | src/main.adb | 12 | ||||
| -rw-r--r-- | to_do.txt | 1 |
5 files changed, 226 insertions, 108 deletions
@@ -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; + @@ -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 |