diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/adapad.adb | 197 | ||||
| -rw-r--r-- | src/editor_windows.adb | 136 | ||||
| -rw-r--r-- | src/editor_windows.ads | 128 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-images.ads | 16 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-popups.adb | 17 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-popups.ads | 2 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-text_buffers.adb | 32 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets-groups-text_displays.adb | 7 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets-groups-text_displays.ads | 8 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb | 6 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets-groups.adb | 5 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets-menus.adb | 5 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets.adb | 17 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-widgets.ads | 32 | ||||
| -rw-r--r-- | src/fltk_binding/fltk.adb | 3 |
15 files changed, 336 insertions, 275 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; diff --git a/src/editor_windows.adb b/src/editor_windows.adb index 0f013bc..d70ee71 100644 --- a/src/editor_windows.adb +++ b/src/editor_windows.adb @@ -1,21 +1,43 @@ -with FLTK.Enums; -use FLTK.Enums; +with FLTK.Enums; use FLTK.Enums; with FLTK.Widgets; -use FLTK.Widgets; with FLTK.Widgets.Groups; -use FLTK.Widgets.Groups; with FLTK.Widgets.Groups.Windows; -use FLTK.Widgets.Groups.Windows; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Groups.Text_Displays.Text_Editors; +with FLTK.Widgets.Menus; +with FLTK.Widgets.Menus.Menu_Bars; +with FLTK.Widgets.Boxes; +with FLTK.Widgets.Inputs; +with FLTK.Widgets.Buttons; +with FLTK.Widgets.Buttons.Enter; +with FLTK.Widgets.Buttons.Light.Check; with FLTK.Images.RGB.PNG; -use FLTK.Images.RGB.PNG; +with FLTK.Text_Buffers; +use type FLTK.Widgets.Buttons.State; package body Editor_Windows is - Logo : PNG_Image := Create ("logo.png"); + package W renames FLTK.Widgets; + package G renames FLTK.Widgets.Groups; + package WN renames FLTK.Widgets.Groups.Windows; + package WD renames FLTK.Widgets.Groups.Windows.Double; + package TE renames FLTK.Widgets.Groups.Text_Displays.Text_Editors; + package MB renames FLTK.Widgets.Menus.Menu_Bars; + package BX renames FLTK.Widgets.Boxes; + package IP renames FLTK.Widgets.Inputs; + package BU renames FLTK.Widgets.Buttons; + package EN renames FLTK.Widgets.Buttons.Enter; + package LC renames FLTK.Widgets.Buttons.Light.Check; + package PN renames FLTK.Images.RGB.PNG; + + + + + Logo : PN.PNG_Image := PN.Create ("logo.png"); @@ -25,12 +47,11 @@ package body Editor_Windows is function Create (X, Y, W, H : in Integer; Label_Text : in String) - return Editor_Window is - + return Editor_Window + is Width : Integer := Min_Editor_Width; Height : Integer := Min_Editor_Height; Menu_Height : Integer := 22; - begin if Width < W then Width := W; @@ -41,11 +62,11 @@ package body Editor_Windows is end if; return This : Editor_Window := - (Double_Window'(Create (X, Y, Width, Height, Label_Text)) with + (WD.Double_Window'(WD.Create (X, Y, Width, Height, Label_Text)) with - Editor => Text_Editor'(Create + Editor => TE.Text_Editor'(TE.Create (0, Menu_Height, Width, Height - Menu_Height, "")), - Bar => Menu_Bar'(Create + Bar => MB.Menu_Bar'(MB.Create (0, 0, Width, Menu_Height, ""))) do This.Add (This.Editor); @@ -73,7 +94,7 @@ package body Editor_Windows is function Get_Buffer (This : in Editor_Window) - return Text_Buffer_Cursor is + return FLTK.Text_Buffers.Text_Buffer_Cursor is begin return This.Editor.Get_Buffer; end Get_Buffer; @@ -83,7 +104,7 @@ package body Editor_Windows is procedure Set_Buffer (This : in out Editor_Window; - Buff : in out Text_Buffer) is + Buff : in out FLTK.Text_Buffers.Text_Buffer) is begin This.Editor.Set_Buffer (Buff); end Set_Buffer; @@ -93,9 +114,9 @@ package body Editor_Windows is function Get_Menu (This : in out Editor_Window) - return Menu_Cursor is + return FLTK.Widgets.Menus.Menu_Cursor is begin - return Ref : Menu_Cursor (This.Bar'Access); + return Ref : FLTK.Widgets.Menus.Menu_Cursor (This.Bar'Access); end Get_Menu; @@ -182,23 +203,22 @@ package body Editor_Windows is overriding procedure Call (This : in Hide_Callback; - Item : in out Widget'Class) is - - P : access Group'Class; - + Item : in out W.Widget'Class) + is + P : access G.Group'Class; begin - if Item in Window'Class then - Window (Item).Hide; + if Item in WN.Window'Class then + WN.Window (Item).Hide; else P := Item.Parent; loop if P = null then return; end if; - exit when P.all in Window'Class; + exit when P.all in WN.Window'Class; P := P.Parent; end loop; - Window (P.all).Hide; + WN.Window (P.all).Hide; end if; end Call; @@ -207,7 +227,9 @@ package body Editor_Windows is -- About_Window functions and procedures - function Create return About_Window is + function Create + return About_Window + is My_Width : Integer := 350; My_Height : Integer := 250; @@ -231,25 +253,25 @@ package body Editor_Windows is Author_Text : String := "Programmed by Jed Barber"; begin return This : About_Window := - (Double_Window'(Create (0, 0, My_Width, My_Height, "About Adapad")) with + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "About Adapad")) with - Picture => Box'(Create + Picture => BX.Box'(BX.Create ((My_Width - Logo_Width) / 2, Logo_Line, Logo_Width, Logo_Height, "")), - Heading => Box'(Create + Heading => BX.Box'(BX.Create (0, Heading_Line, My_Width, Heading_Size, Heading_Text)), - Blurb => Box'(Create + Blurb => BX.Box'(BX.Create (0, Blurb_Line, My_Width, Text_Size, Blurb_Text)), - Author => Box'(Create + Author => BX.Box'(BX.Create (0, Author_Line, My_Width, Text_Size, Author_Text)), - Dismiss => Enter_Button'(Create + Dismiss => EN.Enter_Button'(EN.Create ((My_Width - Button_Width) / 2, Button_Line, Button_Width, Button_Height, "Close"))) do This.Add (This.Picture); This.Picture.Set_Image (Logo); This.Add (This.Heading); - This.Heading.Set_Label_Size (Font_Size (Heading_Size)); + This.Heading.Set_Label_Size (W.Font_Size (Heading_Size)); This.Add (This.Blurb); This.Add (This.Author); This.Add (This.Dismiss); @@ -291,23 +313,24 @@ package body Editor_Windows is overriding procedure Call (This : in Find_Marshaller; - Item : in out Widget'Class) is - + Item : in out W.Widget'Class) + is type Find_Window_Access is access all Find_Window; Dialog : access Find_Window := Find_Window_Access (Item.Parent); - begin if Dialog.Callback /= null then Dialog.Callback.Call (Dialog.Find_What.Get_Value, - Dialog.Match_Case.Get_State = On); + Dialog.Match_Case.Get_State = BU.On); end if; end Call; - function Create return Find_Window is + function Create + return Find_Window + is My_Width : Integer := 350; My_Height : Integer := 130; @@ -329,17 +352,17 @@ package body Editor_Windows is Text_Size : Integer := 12; begin return This : Find_Window := - (Double_Window'(Create (0, 0, My_Width, My_Height, "Find")) with + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Find")) with - Find_What => Input'(Create + Find_What => IP.Input'(IP.Create (My_Width - Input_Width - Input_Margin_Right, Input_Line, Input_Width, Input_Height, "Find what:")), - Match_Case => Check_Button'(Create + Match_Case => LC.Check_Button'(LC.Create (Case_Margin_Left, Case_Line, Check_Width, Check_Height, "Match case")), - Cancel => Button'(Create + Cancel => BU.Button'(BU.Create ((My_Width - 2 * Button_Width) / 3, Button_Line, Button_Width, Button_Height, "Cancel")), - Start => Enter_Button'(Create + Start => EN.Enter_Button'(EN.Create ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, Button_Line, Button_Width, Button_Height, "Find")), @@ -398,25 +421,26 @@ package body Editor_Windows is overriding procedure Call (This : in Replace_Marshaller; - Item : in out Widget'Class) is - + Item : in out W.Widget'Class) + is type Replace_Window_Access is access all Replace_Window; Dialog : access Replace_Window := Replace_Window_Access (Item.Parent); - begin if Dialog.Callback /= null then Dialog.Callback.Call (Dialog.Find_What.Get_Value, Dialog.Replace_With.Get_Value, - Dialog.Match_Case.Get_State = On, - Dialog.Replace_All.Get_State = On); + Dialog.Match_Case.Get_State = BU.On, + Dialog.Replace_All.Get_State = BU.On); end if; end Call; - function Create return Replace_Window is + function Create + return Replace_Window + is My_Width : Integer := 350; My_Height : Integer := 180; @@ -440,24 +464,24 @@ package body Editor_Windows is Text_Size : Integer := 12; begin return This : Replace_Window := - (Double_Window'(Create (0, 0, My_Width, My_Height, "Replace")) with + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Replace")) with - Find_What => Input'(Create + Find_What => IP.Input'(IP.Create (My_Width - Input_Width - Input_Margin_Right, Find_Line, Input_Width, Input_Height, "Find what:")), - Replace_With => Input'(Create + Replace_With => IP.Input'(IP.Create (My_Width - Input_Width - Input_Margin_Right, Replace_Line, Input_Width, Input_Height, "Replace with:")), - Match_Case => Check_Button'(Create + Match_Case => LC.Check_Button'(LC.Create (Check_Margin_Left, Match_Line, Check_Width, Check_Height, "Match case")), - Replace_All => Check_Button'(Create + Replace_All => LC.Check_Button'(LC.Create (Check_Margin_Left, Rep_All_Line, Check_Width, Check_Height, "Replace all")), - Cancel => Button'(Create + Cancel => BU.Button'(BU.Create ((My_Width - 2 * Button_Width) / 3, Button_Line, Button_Width, Button_Height, "Cancel")), - Start => Enter_Button'(Create + Start => EN.Enter_Button'(EN.Create ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, Button_Line, Button_Width, Button_Height, "Replace")), diff --git a/src/editor_windows.ads b/src/editor_windows.ads index 7e6d42c..39ca7a5 100644 --- a/src/editor_windows.ads +++ b/src/editor_windows.ads @@ -1,15 +1,12 @@ with FLTK.Widgets.Groups.Windows.Double; -use FLTK.Widgets.Groups.Windows.Double; with FLTK.Widgets.Menus; -use FLTK.Widgets.Menus; with FLTK.Text_Buffers; -use FLTK.Text_Buffers; +private with FLTK.Widgets; private with FLTK.Widgets.Groups.Text_Displays.Text_Editors; private with FLTK.Widgets.Menus.Menu_Bars; private with FLTK.Widgets.Boxes; -private with FLTK.Widgets; private with FLTK.Widgets.Inputs; private with FLTK.Widgets.Buttons; private with FLTK.Widgets.Buttons.Enter; @@ -19,11 +16,11 @@ private with FLTK.Widgets.Buttons.Light.Check; package Editor_Windows is - type Editor_Window is new Double_Window with private; + type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; Min_Editor_Height : Integer := 60; - Min_Editor_Width : Integer := 300; + Min_Editor_Width : Integer := 300; function Create @@ -39,37 +36,60 @@ package Editor_Windows is function Get_Buffer (This : in Editor_Window) - return Text_Buffer_Cursor; + return FLTK.Text_Buffers.Text_Buffer_Cursor; procedure Set_Buffer (This : in out Editor_Window; - Buff : in out Text_Buffer); + Buff : in out FLTK.Text_Buffers.Text_Buffer); function Get_Menu (This : in out Editor_Window) - return Menu_Cursor; + return FLTK.Widgets.Menus.Menu_Cursor; + + + procedure Undo + (This : in out Editor_Window); + + + procedure Cut + (This : in out Editor_Window); + + + procedure Copy + (This : in out Editor_Window); + + + procedure Paste + (This : in out Editor_Window); + + + procedure Delete + (This : in out Editor_Window); - procedure Undo (This : in out Editor_Window); - procedure Cut (This : in out Editor_Window); - procedure Copy (This : in out Editor_Window); - procedure Paste (This : in out Editor_Window); - procedure Delete (This : in out Editor_Window); + function Get_Insert_Position + (This : in Editor_Window) + return Natural; + + + procedure Set_Insert_Position + (This : in out Editor_Window; + Pos : in Natural); - function Get_Insert_Position (This : in Editor_Window) return Natural; - procedure Set_Insert_Position (This : in out Editor_Window; Pos : in Natural); - procedure Show_Insert_Position (This : in out Editor_Window); + procedure Show_Insert_Position + (This : in out Editor_Window); - type About_Window is new Double_Window with private; + type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; - function Create return About_Window; + function Create + return About_Window; function Create @@ -85,7 +105,7 @@ package Editor_Windows is - type Find_Window is new Double_Window with private; + type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; type Find_Callback is interface; @@ -95,7 +115,8 @@ package Editor_Windows is Match_Case : in Boolean) is abstract; - function Create return Find_Window; + function Create + return Find_Window; function Create @@ -116,7 +137,7 @@ package Editor_Windows is - type Replace_Window is new Double_Window with private; + type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; type Replace_Callback is interface; @@ -126,7 +147,8 @@ package Editor_Windows is Match_Case, Rep_All : in Boolean) is abstract; - function Create return Replace_Window; + function Create + return Replace_Window; function Create @@ -148,67 +170,57 @@ package Editor_Windows is private - use FLTK.Widgets.Groups.Text_Displays.Text_Editors; - use FLTK.Widgets.Menus.Menu_Bars; - use FLTK.Widgets.Boxes; - use FLTK.Widgets; - use FLTK.Widgets.Inputs; - use FLTK.Widgets.Buttons; - use FLTK.Widgets.Buttons.Enter; - use FLTK.Widgets.Buttons.Light.Check; - - - type Editor_Window is new Double_Window with + type Editor_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with record - Bar : aliased Menu_Bar; - Editor : Text_Editor; + Bar : aliased FLTK.Widgets.Menus.Menu_Bars.Menu_Bar; + Editor : FLTK.Widgets.Groups.Text_Displays.Text_Editors.Text_Editor; end record; - type Hide_Callback is new Widget_Callback with null record; + type Hide_Callback is new FLTK.Widgets.Widget_Callback with null record; overriding procedure Call (This : in Hide_Callback; - Item : in out Widget'Class); + Item : in out FLTK.Widgets.Widget'Class); - type About_Window is new Double_Window with + type About_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with record - Picture : Box; - Heading : Box; - Blurb : Box; - Author : Box; - Dismiss : Enter_Button; + Picture : FLTK.Widgets.Boxes.Box; + Heading : FLTK.Widgets.Boxes.Box; + Blurb : FLTK.Widgets.Boxes.Box; + Author : FLTK.Widgets.Boxes.Box; + Dismiss : FLTK.Widgets.Buttons.Enter.Enter_Button; end record; - type Find_Marshaller is new Widget_Callback with null record; + type Find_Marshaller is new FLTK.Widgets.Widget_Callback with null record; overriding procedure Call (This : in Find_Marshaller; - Item : in out Widget'Class); + Item : in out FLTK.Widgets.Widget'Class); - type Find_Window is new Double_Window with + type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with record - Find_What : Input; - Match_Case : Check_Button; - Cancel : Button; - Start : Enter_Button; + Find_What : FLTK.Widgets.Inputs.Input; + Match_Case : FLTK.Widgets.Buttons.Light.Check.Check_Button; + Cancel : FLTK.Widgets.Buttons.Button; + Start : FLTK.Widgets.Buttons.Enter.Enter_Button; Callback : access Find_Callback'Class; end record; - type Replace_Marshaller is new Widget_Callback with null record; + type Replace_Marshaller is new FLTK.Widgets.Widget_Callback with null record; overriding procedure Call (This : in Replace_Marshaller; - Item : in out Widget'Class); + Item : in out FLTK.Widgets.Widget'Class); - type Replace_Window is new Double_Window with + type Replace_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with record - Find_What, Replace_With : Input; - Match_Case, Replace_All : Check_Button; - Cancel : Button; - Start : Enter_Button; + Find_What, Replace_With : FLTK.Widgets.Inputs.Input; + Match_Case, Replace_All : FLTK.Widgets.Buttons.Light.Check.Check_Button; + Cancel : FLTK.Widgets.Buttons.Button; + Start : FLTK.Widgets.Buttons.Enter.Enter_Button; Callback : access Replace_Callback'Class; end record; diff --git a/src/fltk_binding/fltk-images.ads b/src/fltk_binding/fltk-images.ads index 88d7658..f005443 100644 --- a/src/fltk_binding/fltk-images.ads +++ b/src/fltk_binding/fltk-images.ads @@ -11,9 +11,19 @@ package FLTK.Images is return Image; - function Get_W (This : in Image) return Natural; - function Get_H (This : in Image) return Natural; - function Get_D (This : in Image) return Natural; + function Get_W + (This : in Image) + return Natural; + + + function Get_H + (This : in Image) + return Natural; + + + function Get_D + (This : in Image) + return Natural; private diff --git a/src/fltk_binding/fltk-popups.adb b/src/fltk_binding/fltk-popups.adb index 40a8d3e..d6ac8e9 100644 --- a/src/fltk_binding/fltk-popups.adb +++ b/src/fltk_binding/fltk-popups.adb @@ -46,14 +46,13 @@ package body FLTK.Popups is function Three_Way_Choice (Message, Button1, Button2, Button3 : in String) - return Choice is - + return Choice + is Result : Interfaces.C.int := popup_fl_choice (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.To_C (Button2), Interfaces.C.To_C (Button3)); - begin return Choice'Val (Result); end Three_Way_Choice; @@ -63,15 +62,14 @@ package body FLTK.Popups is function File_Chooser (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) - return String is - + Relative : in Boolean := False) + return String + is Result : Interfaces.C.Strings.chars_ptr := popup_fl_file_chooser (Interfaces.C.To_C (Message), Interfaces.C.To_C (Filter_Pattern), Interfaces.C.To_C (Default), Boolean'Pos (Relative)); - begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -85,12 +83,11 @@ package body FLTK.Popups is function Text_Input (Message, Default : in String) - return String is - + return String + is Result : Interfaces.C.Strings.chars_ptr := popup_fl_input (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default)); - begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/src/fltk_binding/fltk-popups.ads b/src/fltk_binding/fltk-popups.ads index bee5d99..4b75c9b 100644 --- a/src/fltk_binding/fltk-popups.ads +++ b/src/fltk_binding/fltk-popups.ads @@ -15,7 +15,7 @@ package FLTK.Popups is function File_Chooser (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) + Relative : in Boolean := False) return String; diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb index b3b8344..736e32e 100644 --- a/src/fltk_binding/fltk-text_buffers.adb +++ b/src/fltk_binding/fltk-text_buffers.adb @@ -11,9 +11,6 @@ use type Interfaces.C.Strings.chars_ptr; use type Ada.Containers.Count_Type; -with Ada.Text_IO; - - package body FLTK.Text_Buffers is @@ -105,16 +102,16 @@ package body FLTK.Text_Buffers is procedure Modify_Callback_Hook (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address); + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address); pragma Convention (C, Modify_Callback_Hook); procedure Modify_Callback_Hook (Pos : in Interfaces.C.int; Inserted, Deleted, Restyled : in Interfaces.C.int; Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address) is - + UD : in System.Address) + is package UStr renames Ada.Strings.Unbounded; Action : Modification; @@ -124,7 +121,6 @@ package body FLTK.Text_Buffers is Ada_Text_Buffer : access Text_Buffer := Text_Buffer_Convert.To_Pointer (UD); - begin if Inserted > 0 then Length := Natural (Inserted); @@ -158,14 +154,13 @@ package body FLTK.Text_Buffers is procedure Predelete_Callback_Hook (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address) is - + UD : in System.Address) + is Place : Position := Position (Pos); Length : Natural := Natural (Deleted); Ada_Text_Buffer : access Text_Buffer := Text_Buffer_Convert.To_Pointer (UD); - begin for CB of Ada_Text_Buffer.Predelete_CBs loop CB.Call (Place, Length); @@ -269,12 +264,11 @@ package body FLTK.Text_Buffers is procedure Load_File (This : in Text_Buffer; - Name : in String) is - + Name : in String) + is Err_No : Interfaces.C.int := fl_text_buffer_loadfile (This.Void_Ptr, Interfaces.C.To_C (Name)); - begin if Err_No /= 0 then raise Storage_Error; @@ -295,12 +289,11 @@ package body FLTK.Text_Buffers is procedure Save_File (This : in Text_Buffer; - Name : in String) is - + Name : in String) + is Err_No : Interfaces.C.int := fl_text_buffer_savefile (This.Void_Ptr, Interfaces.C.To_C (Name)); - begin if Err_No /= 0 then raise Storage_Error; @@ -316,11 +309,10 @@ package body FLTK.Text_Buffers is Item : in String; Found_At : out Natural; Match_Case : in Boolean) - return Boolean is - + return Boolean + is Found_Raw : Interfaces.C.int; Result : Interfaces.C.int; - begin Result := fl_text_buffer_search_forward (This.Void_Ptr, diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.adb b/src/fltk_binding/fltk-widgets-groups-text_displays.adb index 473ceea..e2d62d8 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays.adb +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.adb @@ -2,6 +2,7 @@ with Interfaces.C; with System; +with FLTK.Text_Buffers; use type System.Address; @@ -112,9 +113,9 @@ package body FLTK.Widgets.Groups.Text_Displays is function Get_Buffer (This : in Text_Display) - return Text_Buffer_Cursor is + return FLTK.Text_Buffers.Text_Buffer_Cursor is begin - return Ref : Text_Buffer_Cursor (This.Buffer); + return Ref : FLTK.Text_Buffers.Text_Buffer_Cursor (This.Buffer); end Get_Buffer; @@ -122,7 +123,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Set_Buffer (This : in out Text_Display; - Buff : in out Text_Buffer) is + Buff : in out FLTK.Text_Buffers.Text_Buffer) is begin This.Buffer := Buff'Unchecked_Access; fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr); diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.ads b/src/fltk_binding/fltk-widgets-groups-text_displays.ads index 84c6551..6c2a9fe 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays.ads +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.ads @@ -1,6 +1,6 @@ -with FLTK.Text_Buffers; use FLTK.Text_Buffers; +with FLTK.Text_Buffers; with FLTK.Enums; use FLTK.Enums; @@ -18,12 +18,12 @@ package FLTK.Widgets.Groups.Text_Displays is function Get_Buffer (This : in Text_Display) - return Text_Buffer_Cursor; + return FLTK.Text_Buffers.Text_Buffer_Cursor; procedure Set_Buffer (This : in out Text_Display; - Buff : in out Text_Buffer); + Buff : in out FLTK.Text_Buffers.Text_Buffer); function Get_Text_Color @@ -75,7 +75,7 @@ private type Text_Display is new Group with record - Buffer : access Text_Buffer; + Buffer : access FLTK.Text_Buffers.Text_Buffer; end record; diff --git a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb index 2936504..8345308 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows-single-menu.adb @@ -137,11 +137,7 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (This : in Menu_Window) return Boolean is begin - if fl_menu_window_overlay (This.Void_Ptr) = 0 then - return False; - else - return True; - end if; + return fl_menu_window_overlay (This.Void_Ptr) /= 0; end Get_Overlay; diff --git a/src/fltk_binding/fltk-widgets-groups.adb b/src/fltk_binding/fltk-widgets-groups.adb index 2197d28..067407d 100644 --- a/src/fltk_binding/fltk-widgets-groups.adb +++ b/src/fltk_binding/fltk-widgets-groups.adb @@ -109,14 +109,13 @@ package body FLTK.Widgets.Groups is function Child (This : in Group; Place : in Index) - return access Widget'Class is - + return access Widget'Class + is Widget_Ptr : System.Address := fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); Actual_Widget : access Widget'Class := Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin return Actual_Widget; end Child; diff --git a/src/fltk_binding/fltk-widgets-menus.adb b/src/fltk_binding/fltk-widgets-menus.adb index be5b7c3..7669820 100644 --- a/src/fltk_binding/fltk-widgets-menus.adb +++ b/src/fltk_binding/fltk-widgets-menus.adb @@ -118,11 +118,10 @@ package body FLTK.Widgets.Menus is Text : in String; Action : access Widget_Callback'Class := null; Shortcut : in Shortcut_Key := No_Key; - Flags : in Menu_Flag := Flag_Normal) is - + Flags : in Menu_Flag := Flag_Normal) + is Place : Interfaces.C.int; Callback, User_Data : System.Address; - begin if Action = null then Callback := System.Null_Address; diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb index c6ab5c0..256b8e6 100644 --- a/src/fltk_binding/fltk-widgets.adb +++ b/src/fltk_binding/fltk-widgets.adb @@ -4,7 +4,7 @@ with Interfaces.C; with Interfaces.C.Strings; with System; with System.Address_To_Access_Conversions; -with FLTK.Widgets.Groups; use FLTK.Widgets.Groups; +with FLTK.Widgets.Groups; with FLTK.Images; use type System.Address; @@ -12,7 +12,8 @@ use type System.Address; package body FLTK.Widgets is - package Group_Convert is new System.Address_To_Access_Conversions (Group'Class); + package Group_Convert is new + System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); @@ -115,11 +116,10 @@ package body FLTK.Widgets is function Parent (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class is - + return access FLTK.Widgets.Groups.Group'Class + is Parent_Ptr : System.Address; - Actual_Parent : access Group'Class; - + Actual_Parent : access FLTK.Widgets.Groups.Group'Class; begin Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); if Parent_Ptr /= System.Null_Address then @@ -237,11 +237,10 @@ package body FLTK.Widgets is pragma Convention (C, Callback_Hook); procedure Callback_Hook - (W, U : in System.Address) is - + (W, U : in System.Address) + is Ada_Widget : access Widget'Class := Widget_Convert.To_Pointer (U); - begin Ada_Widget.Callback.Call (Ada_Widget.all); end Callback_Hook; diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads index e692a65..7af5e2b 100644 --- a/src/fltk_binding/fltk-widgets.ads +++ b/src/fltk_binding/fltk-widgets.ads @@ -90,14 +90,34 @@ package FLTK.Widgets is Func : not null access Widget_Callback'Class); - function Get_X (This : in Widget) return Integer; - function Get_Y (This : in Widget) return Integer; - function Get_W (This : in Widget) return Integer; - function Get_H (This : in Widget) return Integer; + function Get_X + (This : in Widget) + return Integer; + + + function Get_Y + (This : in Widget) + return Integer; + + + function Get_W + (This : in Widget) + return Integer; - procedure Resize (This : in out Widget; W, H : in Integer); - procedure Reposition (This : in out Widget; X, Y : in Integer); + function Get_H + (This : in Widget) + return Integer; + + + procedure Resize + (This : in out Widget; + W, H : in Integer); + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer); function Get_Image diff --git a/src/fltk_binding/fltk.adb b/src/fltk_binding/fltk.adb index aacb58b..983f308 100644 --- a/src/fltk_binding/fltk.adb +++ b/src/fltk_binding/fltk.adb @@ -14,7 +14,8 @@ package body FLTK is - function Run return Integer is + function Run + return Integer is begin return Integer (fl_run); end Run; |