with FLTK; with Editors; use Editors; with FLTK.Text_Buffers; use FLTK.Text_Buffers; with FLTK.Widgets; use FLTK.Widgets; with FLTK.Widgets.Menus; use FLTK.Widgets.Menus; with Ada.Text_IO; function AdaPad return Integer is Pad : aliased Editor_Window := Create (0, 0, 640, 400, "AdaPad"); Buff : aliased Text_Buffer := Create; type Editor_Callback is abstract new Widget_Callback with record Editor : access Editor_Window := Pad'Access; Buffer : access Text_Buffer := Buff'Access; end record; type New_Callback is new Editor_Callback with null record; New_CB : aliased New_Callback; overriding procedure Call (This : in New_Callback; Item : in out Widget'Class) is begin Ada.Text_IO.Put_Line ("New callback executed."); end Call; type Open_Callback is new Editor_Callback with null record; Open_CB : aliased Open_Callback; overriding procedure Call (This : in Open_Callback; Item : in out Widget'Class) is begin Ada.Text_IO.Put_Line ("Open callback executed."); end Call; type Save_Callback is new Editor_Callback with null record; Save_CB : aliased Save_Callback; overriding procedure Call (This : in Save_Callback; Item : in out Widget'Class) is begin Ada.Text_IO.Put_Line ("Save callback executed."); end Call; type Save_As_Callback is new Editor_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 begin Ada.Text_IO.Put_Line ("Save As callback executed."); end Call; 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."); end Call; 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."); end Call; 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 begin This.Editor.Cut; end Call; 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 begin This.Editor.Copy; end Call; 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 begin This.Editor.Paste; end Call; 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 begin This.Editor.Delete; end Call; 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 begin Ada.Text_IO.Put_Line ("Find callback executed."); end Call; 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 begin Ada.Text_IO.Put_Line ("Replace callback executed."); end Call; 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 begin Ada.Text_IO.Put_Line ("About callback executed."); end Call; type Mod_Callback is new Modify_Callback with null record; Mod_CB : aliased Mod_Callback; overriding procedure Call (This : in Mod_Callback; Action : in Modification; Place : in Position; 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)); end Call; type Pre_Callback is new Predelete_Callback with null record; Pre_CB : aliased Pre_Callback; 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; begin Buff.Add_Modify_Callback (Mod_CB'Access); Buff.Add_Predelete_Callback (Pre_CB'Access); declare Bar : Menu_Cursor := Pad.Get_Menu; begin Bar.Add (Text => "&File", Shortcut => Mod_Alt + 'f', 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 ("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 ("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 ("Help/&About", About_CB'Access); end; Pad.Set_Buffer (Buff); Pad.Show; return FLTK.Run; end AdaPad;