diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/adapad.adb | 29 | ||||
| -rw-r--r-- | src/windows-jump.adb | 111 | ||||
| -rw-r--r-- | src/windows-jump.ads | 51 |
3 files changed, 179 insertions, 12 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index fb34196..82aa1ad 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -8,6 +8,7 @@ with Windows.Editor; with Windows.About; with Windows.Find; with Windows.Replace; +with Windows.Jump; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; @@ -34,6 +35,7 @@ package body Adapad is About : Windows.About.About_Window := Windows.About.Create; Find : Windows.Find.Find_Window := Windows.Find.Create; Replace : Windows.Replace.Replace_Window := Windows.Replace.Create; + Jump : Windows.Jump.Jump_Window := Windows.Jump.Create; Changed : Boolean := False; Filename : Unbounded_String := To_Unbounded_String (0); @@ -216,19 +218,10 @@ package body Adapad is procedure Jump_CB - (Item : in out FLTK.Widgets.Widget'Class) - is - User_Input : String := FLTK.Dialogs.Text_Input ("Line number: "); - Line_Number : Integer; + (Item : in out FLTK.Widgets.Widget'Class) is begin - Line_Number := Integer'Value (User_Input); - if Line_Number > 0 then - Editor.Set_Insert_Position (Buffer.Skip_Lines (0, Line_Number - 1)); - Editor.Show_Insert_Position; - end if; - exception - when Constraint_Error => - null; -- user has entered nonsense input, do nothing + Centre (Jump); + Jump.Show; end Jump_CB; @@ -427,6 +420,17 @@ package body Adapad is + procedure Do_Jump_CB + (Line_Number : in Positive) is + begin + Jump.Hide; + Editor.Set_Insert_Position (Buffer.Skip_Lines (0, Line_Number - 1)); + Editor.Show_Insert_Position; + end Do_Jump_CB; + + + + -- helper functions procedure Set_Title is @@ -592,6 +596,7 @@ begin Find.Set_Find_Callback (Do_Find_CB'Access); Replace.Set_Replace_Callback (Do_Replace_CB'Access); + Jump.Set_Jump_Callback (Do_Jump_CB'Access); Buffer.Add_Modify_Callback (Mod_CB'Access); Editor.Set_Callback (Quit_CB'Access); diff --git a/src/windows-jump.adb b/src/windows-jump.adb new file mode 100644 index 0000000..64bd6f6 --- /dev/null +++ b/src/windows-jump.adb @@ -0,0 +1,111 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Buttons.Enter; +with FLTK.Widgets.Inputs.Int; + + +package body Windows.Jump is + + + package WD renames FLTK.Widgets.Groups.Windows.Double; + package BU renames FLTK.Widgets.Buttons; + package EN renames FLTK.Widgets.Buttons.Enter; + package IT renames FLTK.Widgets.Inputs.Int; + + + + + procedure Jump_M + (Item : in out FLTK.Widgets.Widget'Class) + is + type Jump_Window_Access is access all Jump_Window; + Dialog : access Jump_Window := Jump_Window_Access (Item.Parent); + + Line : Integer := Dialog.To_Line.Get_Value; + begin + if Dialog.Callback /= null and Line > 0 then + Dialog.Callback.all (Line); + end if; + end Jump_M; + + + + + function Create + return Jump_Window + is + My_Width : Integer := 350; + My_Height : Integer := 110; + + Button_Width : Integer := 140; + Button_Height : Integer := 40; + + Input_Line : Integer := 10; + Button_Line : Integer := 60; + + Input_Width : Integer := 240; + Input_Height : Integer := 25; + Input_Margin_Right : Integer := 10; + begin + return This : Jump_Window := + (WD.Double_Window'(WD.Create (0, 0, My_Width, My_Height, "Jump")) with + + To_Line => IT.Integer_Input'(IT.Create + (My_Width - Input_Width - Input_Margin_Right, + Input_Line, Input_Width, Input_Height, "Jump to:")), + Cancel => BU.Button'(BU.Create + ((My_Width - 2 * Button_Width) / 3, + Button_Line, Button_Width, Button_Height, "Cancel")), + Go_Jump => EN.Enter_Button'(EN.Create + ((My_Width - 2 * Button_Width) * 2 / 3 + Button_Width, + Button_Line, Button_Width, Button_Height, "Jump")), + + Callback => null) do + + This.Add (This.To_Line); + This.Add (This.Cancel); + This.Cancel.Set_Callback (Hide_CB'Access); + This.Add (This.Go_Jump); + This.Go_Jump.Set_Callback (Jump_M'Access); + + This.Set_Callback (Hide_CB'Access); + This.Set_Icon (Logo); + This.Set_Modal; + end return; + end Create; + + + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Jump_Window is + begin + return Create; + end Create; + + + + + function Create + (W, H : in Integer) + return Jump_Window is + begin + return Create; + end Create; + + + + + procedure Set_Jump_Callback + (This : in out Jump_Window; + Func : in Jump_Callback) is + begin + This.Callback := Func; + end Set_Jump_Callback; + + +end Windows.Jump; + diff --git a/src/windows-jump.ads b/src/windows-jump.ads new file mode 100644 index 0000000..baf355c --- /dev/null +++ b/src/windows-jump.ads @@ -0,0 +1,51 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +private with FLTK.Widgets.Buttons.Enter; +private with FLTK.Widgets.Inputs.Int; + + +package Windows.Jump is + + + type Jump_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + + + type Jump_Callback is access procedure + (Line_Number : in Positive); + + + function Create + return Jump_Window; + + + function Create + (X, Y, W, H : in Integer; + Label_Text : in String) + return Jump_Window; + + + function Create + (W, H : in Integer) + return Jump_Window; + + + procedure Set_Jump_Callback + (This : in out Jump_Window; + Func : in Jump_Callback); + + +private + + + type Jump_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with + record + To_Line : FLTK.Widgets.Inputs.Int.Integer_Input; + Cancel : FLTK.Widgets.Buttons.Button; + Go_Jump : FLTK.Widgets.Buttons.Enter.Enter_Button; + Callback : Jump_Callback; + end record; + + +end Windows.Jump; + |