diff options
Diffstat (limited to 'src/adapad.adb')
| -rw-r--r-- | src/adapad.adb | 197 |
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; |