diff options
Diffstat (limited to 'src/adapad.adb')
| -rw-r--r-- | src/adapad.adb | 199 |
1 files changed, 146 insertions, 53 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index f1425f9..5dc36ca 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -9,6 +9,10 @@ with FLTK.Widgets; use FLTK.Widgets; with FLTK.Widgets.Menus; use FLTK.Widgets.Menus; +with FLTK.Popups; +use FLTK.Popups; +with Ada.Strings.Unbounded; +use Ada.Strings.Unbounded; with Ada.Text_IO; @@ -17,9 +21,22 @@ with Ada.Text_IO; function AdaPad return Integer is - Pad : aliased Editor_Window := Create (0, 0, 640, 400, "AdaPad"); + Pad : aliased Editor_Window := Create (0, 0, 640, 400, "(Untitled)"); Buff : aliased Text_Buffer := Create; + -- these globals make me feel dirty + -- like they should be in the buffer class or something + Changed : Boolean := False; + Filename : Unbounded_String := To_Unbounded_String (0); + + + + + procedure Set_Title (Editor : access Editor_Window); + function Cancel_Save_Discard return Choice; + procedure Load_File (Buffer : access Text_Buffer; Name : in String); + procedure Save_File (Buffer : access Text_Buffer; Name : in String); + @@ -32,57 +49,83 @@ function AdaPad return Integer is - type New_Callback is new Editor_Callback with null record; - New_CB : aliased New_Callback; - + type Save_As_Callback is new Editor_Callback with null record; + Save_As_CB : aliased Save_As_Callback; overriding procedure Call - (This : in New_Callback; + (This : in Save_As_Callback; Item : in out Widget'Class) is + + New_Filename : String := File_Chooser + ("Save File As?", "*", To_String (Filename)); + begin - Ada.Text_IO.Put_Line ("New callback executed."); + if New_Filename /= "" then + Save_File (This.Buffer, New_Filename); + end if; end Call; - type Open_Callback is new Editor_Callback with null record; - Open_CB : aliased Open_Callback; - + type Save_Callback is new Editor_Callback with null record; + Save_CB : aliased Save_Callback; overriding procedure Call - (This : in Open_Callback; + (This : in Save_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Open callback executed."); + if Filename = "" then + Save_As_CB.Call (Item); + else + Save_File (This.Buffer, To_String (Filename)); + end if; end Call; - type Save_Callback is new Editor_Callback with null record; - Save_CB : aliased Save_Callback; - + type New_Callback is new Editor_Callback with null record; + New_CB : aliased New_Callback; overriding procedure Call - (This : in Save_Callback; + (This : in New_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Save callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + Filename := To_Unbounded_String (0); + This.Buffer.Set_Selection (0, This.Buffer.Length); + This.Buffer.Remove_Selected_Text; + Changed := False; + This.Buffer.Call_Modify_Callbacks; end Call; - type Save_As_Callback is new Editor_Callback with null record; - Save_As_CB : aliased Save_As_Callback; - + type Open_Callback is new Editor_Callback with null record; + Open_CB : aliased Open_Callback; overriding procedure Call - (This : in Save_As_Callback; + (This : in Open_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Save As callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + declare + New_Filename : String := File_Chooser ("Open File?", "*", To_String (Filename)); + begin + if New_Filename /= "" then + Load_File (This.Buffer, New_Filename); + end if; + end; end Call; @@ -91,12 +134,16 @@ function AdaPad return Integer is type Quit_Callback is new Editor_Callback with null record; Quit_CB : aliased Quit_Callback; - overriding procedure Call (This : in Quit_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Quit callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + This.Editor.Hide; end Call; @@ -105,12 +152,11 @@ function AdaPad return Integer is type Undo_Callback is new Editor_Callback with null record; Undo_CB : aliased Undo_Callback; - overriding procedure Call (This : in Undo_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Undo callback executed."); + This.Editor.Undo; end Call; @@ -119,7 +165,6 @@ function AdaPad return Integer is type Cut_Callback is new Editor_Callback with null record; Cut_CB : aliased Cut_Callback; - overriding procedure Call (This : in Cut_Callback; Item : in out Widget'Class) is @@ -133,7 +178,6 @@ function AdaPad return Integer is type Copy_Callback is new Editor_Callback with null record; Copy_CB : aliased Copy_Callback; - overriding procedure Call (This : in Copy_Callback; Item : in out Widget'Class) is @@ -147,7 +191,6 @@ function AdaPad return Integer is type Paste_Callback is new Editor_Callback with null record; Paste_CB : aliased Paste_Callback; - overriding procedure Call (This : in Paste_Callback; Item : in out Widget'Class) is @@ -161,7 +204,6 @@ function AdaPad return Integer is type Delete_Callback is new Editor_Callback with null record; Delete_CB : aliased Delete_Callback; - overriding procedure Call (This : in Delete_Callback; Item : in out Widget'Class) is @@ -175,7 +217,6 @@ function AdaPad return Integer is type Find_Callback is new Editor_Callback with null record; Find_CB : aliased Find_Callback; - overriding procedure Call (This : in Find_Callback; Item : in out Widget'Class) is @@ -189,7 +230,6 @@ function AdaPad return Integer is type Replace_Callback is new Editor_Callback with null record; Replace_CB : aliased Replace_Callback; - overriding procedure Call (This : in Replace_Callback; Item : in out Widget'Class) is @@ -203,7 +243,6 @@ function AdaPad return Integer is type About_Callback is new Editor_Callback with null record; About_CB : aliased About_Callback; - overriding procedure Call (This : in About_Callback; Item : in out Widget'Class) is @@ -214,10 +253,12 @@ function AdaPad return Integer is - type Mod_Callback is new Modify_Callback with null record; + type Mod_Callback is new Modify_Callback with + record + Editor : access Editor_Window := Pad'Access; + end record; Mod_CB : aliased Mod_Callback; - overriding procedure Call (This : in Mod_Callback; Action : in Modification; @@ -225,61 +266,113 @@ function AdaPad return Integer is Length : in Natural; Deleted_Text : in String) is begin - Ada.Text_IO.Put_Line ("Modify of Type: " & Modification'Image (Action) & - " Place: " & Position'Image (Place) & - " Length: " & Integer'Image (Length)); + if Action = Insert or Action = Delete then + Changed := True; + end if; + Set_Title (This.Editor); end Call; - type Pre_Callback is new Predelete_Callback with null record; - Pre_CB : aliased Pre_Callback; + procedure Set_Title + (Editor : access Editor_Window) is + Title : Unbounded_String := To_Unbounded_String (0); - overriding procedure Call - (This : in Pre_Callback; - Place : in Position; - Length : in Natural) is begin - Ada.Text_IO.Put_Line ("Predelete at Place: " & Position'Image (Place) & - " Length: " & Integer'Image (Length)); - end Call; + if Changed then + Append (Title, "*"); + end if; + if Filename = "" then + Append (Title, "(Untitled)"); + else + Append (Title, Filename); + end if; -begin + Editor.Set_Label (To_String (Title)); + end Set_Title; - Buff.Add_Modify_Callback (Mod_CB'Access); - Buff.Add_Predelete_Callback (Pre_CB'Access); + + + function Cancel_Save_Discard + return Choice is + begin + if not Changed then + return Third; + else + return Three_Way_Choice + ("The current file has not been saved." & Character'Val (10) & + "Would you like to save it now?", + "Cancel", "Save", "Discard"); + end if; + end Cancel_Save_Discard; + + + + + procedure Load_File + (Buffer : access Text_Buffer; + Name : in String) is + begin + Buffer.Load_File (Name); + Filename := To_Unbounded_String (Name); + Changed := False; + Buffer.Call_Modify_Callbacks; + exception + when Storage_Error => + Alert ("Error reading from file " & Name); + end Load_File; + + + + + procedure Save_File + (Buffer : access Text_Buffer; + Name : in String) is + begin + Buffer.Save_File (Name); + Filename := To_Unbounded_String (Name); + Changed := False; + Buffer.Call_Modify_Callbacks; + exception + when Storage_Error => + Alert ("Error writing to file " & Name); + end Save_File; + + +begin declare Bar : Menu_Cursor := Pad.Get_Menu; begin - Bar.Add (Text => "&File", Shortcut => Mod_Alt + 'f', Flags => 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'); Bar.Add ("File/&Quit", Quit_CB'Access, Mod_Ctrl + 'q'); - Bar.Add (Text => "&Edit", Shortcut => Mod_Alt + 'e', Flags => Flag_Submenu); + Bar.Add (Text => "&Edit", Flags => Flag_Submenu); Bar.Add ("Edit/&Undo", Undo_CB'Access, Mod_Ctrl + 'z'); 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); - Bar.Add (Text => "&Search", Shortcut => Mod_Alt + 's', Flags => Flag_Submenu); + 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", Shortcut => Mod_Alt + 'h', Flags => Flag_Submenu); + Bar.Add (Text => "&Help", Flags => Flag_Submenu); Bar.Add ("Help/&About", About_CB'Access); end; + Buff.Add_Modify_Callback (Mod_CB'Access); Pad.Set_Buffer (Buff); Pad.Show; return FLTK.Run; |