summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/adapad.adb59
-rw-r--r--src/fltk_binding/c_fl_text_buffer.cpp10
-rw-r--r--src/fltk_binding/c_fl_text_buffer.h2
-rw-r--r--src/fltk_binding/fltk-text_buffers.adb70
-rw-r--r--src/fltk_binding/fltk-text_buffers.ads15
-rw-r--r--src/windows-find.adb20
-rw-r--r--src/windows-find.ads11
-rw-r--r--to_do.txt5
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
diff --git a/to_do.txt b/to_do.txt
index 95481e0..f1b6bf6 100644
--- a/to_do.txt
+++ b/to_do.txt
@@ -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
generated by cgit (git 2.30.0) at 2024-12-22 14:18:29 +0000