diff options
| -rw-r--r-- | src/adapad.adb | 59 | ||||
| -rw-r--r-- | src/fltk_binding/c_fl_text_buffer.cpp | 10 | ||||
| -rw-r--r-- | src/fltk_binding/c_fl_text_buffer.h | 2 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-text_buffers.adb | 70 | ||||
| -rw-r--r-- | src/fltk_binding/fltk-text_buffers.ads | 15 | ||||
| -rw-r--r-- | src/windows-find.adb | 20 | ||||
| -rw-r--r-- | src/windows-find.ads | 11 | ||||
| -rw-r--r-- | to_do.txt | 5 |
8 files changed, 180 insertions, 12 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index e72d4d6..e197097 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -11,6 +11,9 @@ with Windows.Replace; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Text_IO; + + package body Adapad is @@ -187,6 +190,24 @@ package body Adapad is + procedure Find_Next_CB + (Item : in out FLTK.Widgets.Widget'Class) is + begin + Find.Do_Callback (Windows.Find.Forward); + end Find_Next_CB; + + + + + procedure Find_Prev_CB + (Item : in out FLTK.Widgets.Widget'Class) is + begin + Find.Do_Callback (Windows.Find.Backward); + end Find_Prev_CB; + + + + procedure Replace_CB (Item : in out FLTK.Widgets.Widget'Class) is begin @@ -295,17 +316,43 @@ package body Adapad is - -- callbacks for the find/replace windows + -- callbacks for the extra dialog windows procedure Do_Find_CB (Item : in String; - Match_Case : in Boolean) + Match_Case : in Boolean; + Facing : in Windows.Find.Direction) is - Current_Position, Found_At : Natural; + use type Windows.Find.Direction; + Current_Position, Select_Start, Select_End, Found_At : Natural; + Was_Found : Boolean; begin Find.Hide; - Current_Position := Editor.Get_Insert_Position; - if Buffer.Search_Forward (Current_Position, Item, Found_At, Match_Case) then + + -- is it possible to improve this abomination with a modulo type? + if Buffer.Get_Selection (Select_Start, Select_End) then + if Facing = Windows.Find.Forward then + Current_Position := Select_End; + else + if Select_Start = 0 then + Current_Position := Buffer.Length; + else + Current_Position := Select_Start - 1; + end if; + end if; + else + Current_Position := Editor.Get_Insert_Position; + end if; + + if Facing = Windows.Find.Forward then + Was_Found := Buffer.Search_Forward (Current_Position, Item, Found_At, Match_Case) + or else Buffer.Search_Forward (0, Item, Found_At, Match_Case); + else + Was_Found := Buffer.Search_Backward (Current_Position, Item, Found_At, Match_Case) + or else Buffer.Search_Backward (Buffer.Length, Item, Found_At, Match_Case); + end if; + + if Was_Found then Buffer.Set_Selection (Found_At, Found_At + Item'Length); Editor.Set_Insert_Position (Found_At + Item'Length); Editor.Show_Insert_Position; @@ -488,6 +535,8 @@ begin Bar.Add (Text => "&Search", Flags => Flag_Submenu); Bar.Add ("Search/&Find...", Find_CB'Access, Mod_Ctrl + 'f'); + Bar.Add ("Search/Find &Next", Find_Next_CB'Access, Mod_Ctrl + 'g'); + Bar.Add ("Search/Find &Previous", Find_Prev_CB'Access, Mod_Shift + Mod_Ctrl + 'g'); Bar.Add ("Search/&Replace...", Replace_CB'Access, Mod_Ctrl + 'h', Flag_Divider); Bar.Add ("Search/Jump To...", Jump_CB'Access, Mod_Ctrl + 'j'); Bar.Add ("Search/Word Count", Count_CB'Access); diff --git a/src/fltk_binding/c_fl_text_buffer.cpp b/src/fltk_binding/c_fl_text_buffer.cpp index 20699e8..623aea7 100644 --- a/src/fltk_binding/c_fl_text_buffer.cpp +++ b/src/fltk_binding/c_fl_text_buffer.cpp @@ -65,11 +65,21 @@ int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, i } +int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->search_backward(start, item, found, mcase); +} + + void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { reinterpret_cast<Fl_Text_Buffer*>(tb)->select(s, e); } +int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->selection_position(s, e); +} + + int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) { return reinterpret_cast<Fl_Text_Buffer*>(tb)->skip_lines(s, l); } diff --git a/src/fltk_binding/c_fl_text_buffer.h b/src/fltk_binding/c_fl_text_buffer.h index 0ee2e5a..4c5edb3 100644 --- a/src/fltk_binding/c_fl_text_buffer.h +++ b/src/fltk_binding/c_fl_text_buffer.h @@ -21,7 +21,9 @@ extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n); extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n); extern "C" int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); +extern "C" int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); +extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e); extern "C" int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l); extern "C" int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l); extern "C" unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p); diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb index 5db105d..6ff5b55 100644 --- a/src/fltk_binding/fltk-text_buffers.adb +++ b/src/fltk_binding/fltk-text_buffers.adb @@ -79,11 +79,26 @@ package body FLTK.Text_Buffers is return Interfaces.C.int; pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); + function fl_text_buffer_search_backward + (TB : in System.Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); + procedure fl_text_buffer_select (TB : in System.Address; S, E : in Interfaces.C.int); pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); + function fl_text_buffer_selection_position + (TB : in System.Address; + S, E : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); + function fl_text_buffer_skip_lines (TB : in System.Address; S, L : in Interfaces.C.int) @@ -327,8 +342,7 @@ package body FLTK.Text_Buffers is Match_Case : in Boolean) return Boolean is - Found_Raw : Interfaces.C.int; - Result : Interfaces.C.int; + Found_Raw, Result : Interfaces.C.int; begin Result := fl_text_buffer_search_forward (This.Void_Ptr, @@ -336,13 +350,40 @@ package body FLTK.Text_Buffers is Interfaces.C.To_C (Item), Found_Raw, Boolean'Pos (Match_Case)); - Found_At := Natural (Found_Raw); - return Boolean'Val (Result); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; end Search_Forward; + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean + is + Found_Raw, Result : Interfaces.C.int; + begin + Result := fl_text_buffer_search_backward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Found_Raw, + Boolean'Pos (Match_Case)); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; + end Search_Backward; + + + + procedure Set_Selection (This : in out Text_Buffer; Start, Finish : in Natural) is @@ -356,6 +397,27 @@ package body FLTK.Text_Buffers is + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean + is + Result, Start_Raw, Finish_Raw : Interfaces.C.int; + begin + Result := fl_text_buffer_selection_position + (This.Void_Ptr, + Start_Raw, + Finish_Raw); + if Result /= 0 then + Start := Natural (Start_Raw); + Finish := Natural (Finish_Raw); + end if; + return Result /= 0; + end Get_Selection; + + + + function Skip_Lines (This : in out Text_Buffer; Start, Lines : in Natural) diff --git a/src/fltk_binding/fltk-text_buffers.ads b/src/fltk_binding/fltk-text_buffers.ads index 171fd84..582de1d 100644 --- a/src/fltk_binding/fltk-text_buffers.ads +++ b/src/fltk_binding/fltk-text_buffers.ads @@ -86,11 +86,26 @@ package FLTK.Text_Buffers is return Boolean; + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean; + + procedure Set_Selection (This : in out Text_Buffer; Start, Finish : in Natural); + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean; + + -- only takes into account newline characters, not word wrap function Skip_Lines (This : in out Text_Buffer; diff --git a/src/windows-find.adb b/src/windows-find.adb index 4f76338..394ce2d 100644 --- a/src/windows-find.adb +++ b/src/windows-find.adb @@ -28,7 +28,8 @@ package body Windows.Find is if Dialog.Callback /= null then Dialog.Callback.all (Dialog.Find_What.Get_Value, - Dialog.Match_Case.Get_State = BU.On); + Dialog.Match_Case.Get_State = BU.On, + Forward); end if; end Find_M; @@ -120,5 +121,22 @@ package body Windows.Find is end Set_Find_Callback; + + + procedure Do_Callback + (This : in Find_Window; + Dir : in Direction := Forward) + is + use type BU.State; + begin + if This.Callback /= null then + This.Callback.all + (This.Find_What.Get_Value, + This.Match_Case.Get_State = BU.On, + Dir); + end if; + end Do_Callback; + + end Windows.Find; diff --git a/src/windows-find.ads b/src/windows-find.ads index 5931e5f..82895e7 100644 --- a/src/windows-find.ads +++ b/src/windows-find.ads @@ -12,9 +12,13 @@ package Windows.Find is type Find_Window is new FLTK.Widgets.Groups.Windows.Double.Double_Window with private; + type Direction is (Forward, Backward); + + type Find_Callback is access procedure (Item : in String; - Match_Case : in Boolean); + Match_Case : in Boolean; + Facing : in Direction); function Create @@ -37,6 +41,11 @@ package Windows.Find is Func : in Find_Callback); + procedure Do_Callback + (This : in Find_Window; + Dir : in Direction := Forward); + + private @@ -3,10 +3,13 @@ To Do: - change build to be dynamically linked -- improve find, replace, undo/redo, jump to +- improve replace, undo/redo, jump to +- add right click menu +- grey out menu entries when appropriate - suppress unnecessary left/right scrollbar - make logo colours lighter to stand out more - clean up menu widget code +- introduce maybe type to eliminate out parameters in search_forward/search_backward - eliminate image/text_buffer runtime warnings - separate fltk binding into its own repo - add license |