From 300d6ba8fd25fc518117114bca7a0201c360c84a Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Thu, 10 Nov 2016 17:23:51 +1100 Subject: Adapad logic now in its own package as singleton, removing the need for unchecked_access callbacks --- src/adapad.ads | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 158 insertions(+) create mode 100644 src/adapad.ads (limited to 'src/adapad.ads') 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; + -- cgit