Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve regex checking #1258

Merged
merged 2 commits into from
Oct 13, 2023
Merged

Improve regex checking #1258

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
1839483
Improve regex checking
windymilla Oct 1, 2023
5b6ebb0
Show Search dialog count label correctly
windymilla Oct 2, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion src/guiguts.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -173,7 +173,6 @@
our $pngspath = q{};
our $projectid = q{};
our $recentfile_size = 9;
our $regexpentry = q();
our $rmargin = 72;
our $rmargindiff = 1;
our $rwhyphenspace = 1;
Expand Down
34 changes: 28 additions & 6 deletions src/lib/Guiguts/Highlight.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -178,7 +178,16 @@ sub hilite {
my $mark = shift;
my $matchtype = shift;

$mark = quotemeta($mark) if $matchtype eq 'exact';
if ( $matchtype eq 'exact' ) {
$mark = quotemeta($mark);
} else {
my $regexerror = ::checkregexforerrors($mark);
if ($regexerror) {
::badreg($regexerror);
return;
}
}

my @ranges = $textwindow->tagRanges('sel');
my $range_total = @ranges;
my ( $index, $lastindex );
Expand Down Expand Up @@ -246,7 +255,7 @@ sub hilitepopup {
$::lglobal{hilitepop} = $top->Toplevel;
$::lglobal{hilitepop}->title('Character Highlight');
::initialize_popup_with_deletebinding('hilitepop');
my $hilitemode = 'exact';
$::lglobal{hilitemode} = 'exact';
my $f = $::lglobal{hilitepop}->Frame->pack( -side => 'top', -anchor => 'n', -padx => 3 );
$f->Label( -text => 'Highlight Character(s) or Regex', )
->pack( -side => 'top', -pady => 2, -padx => 2, -anchor => 'n' );
Expand All @@ -258,22 +267,28 @@ sub hilitepopup {
-width => 9,
-height => 15,
)->pack( -side => 'left', -anchor => 'w' );
$::lglobal{highlightentry} = $f->Entry( -width => 40, )->pack(
$::lglobal{highlightentry} = $f->Entry(
-width => 40,
-validate => 'all',
-vcmd => sub { highlight_reg_check(shift); },
)->pack(
-expand => 1,
-fill => 'x',
-pady => 3,
-anchor => 'n'
);
my $f2 = $::lglobal{hilitepop}->Frame->pack( -side => 'top', -anchor => 'n' );
$f2->Radiobutton(
-variable => \$hilitemode,
-variable => \$::lglobal{hilitemode},
-value => 'exact',
-text => 'Exact',
-command => sub { highlight_reg_check( $::lglobal{highlightentry}->get ); }, # To unset warning color if bad regex
)->grid( -row => 0, -column => 1 );
$f2->Radiobutton(
-variable => \$hilitemode,
-variable => \$::lglobal{hilitemode},
-value => 'regex',
-text => 'Regex',
-command => sub { highlight_reg_check( $::lglobal{highlightentry}->get ); }, # Maybe set warning color if bad regex
)->grid( -row => 0, -column => 2 );
my $f3 = $::lglobal{hilitepop}->Frame->pack( -side => 'top', -anchor => 'n' );
$f3->Button(
Expand All @@ -293,8 +308,8 @@ sub hilitepopup {
)->grid( -row => 1, -column => 2, -padx => 2, -pady => 2 );
$f3->Button(
-command => sub {
hilite( $::lglobal{highlightentry}->get, $hilitemode );
::add_entry_history( $::lglobal{highlightentry}->get, \@::highlight_history );
hilite( $::lglobal{highlightentry}->get, $::lglobal{hilitemode} );
},
-text => 'Apply Highlights',
-width => 16,
Expand All @@ -308,6 +323,13 @@ sub hilitepopup {
$::lglobal{highlightentry}->focus;
}

#
# Check highlight regex, either for validation, or when switching between exact & regex modes
# Accepts regex string as argument
sub highlight_reg_check {
return ::reg_check( $::lglobal{highlightentry}, shift, $::lglobal{hilitemode} eq 'regex' );
}

#
# Enable / disable word highlighting in the text
# Set up repeating call to highlighting routine every 400ms
Expand Down
150 changes: 91 additions & 59 deletions src/lib/Guiguts/SearchReplaceMenu.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ BEGIN {
our ( @ISA, @EXPORT );
@ISA = qw(Exporter);
@EXPORT = qw(&update_sr_histories &searchtext &reg_check &getnextscanno &updatesearchlabels
&isvalid &swapterms &findascanno &reghint &replace &replaceall
&checkregexforerrors &badreg &swapterms &findascanno &reghint &replace &replaceall
&searchfromstartifnew &searchoptset &searchpopup &stealthscanno &find_proofer_comment
&find_asterisks &find_transliterations &nextblock &orphanedbrackets &orphanedmarkup &searchsize
&loadscannos &replace_incr_counter &countmatches &setsearchpopgeometry &quickcount
Expand Down Expand Up @@ -100,8 +100,9 @@ sub searchtext {
$searchterm = $::lglobal{searchentry}->get if $searchterm eq '';
return ('') unless length($searchterm);
if ( $::sopt[3] ) {
unless ( ::isvalid($searchterm) ) {
badreg();
my $regexerror = ::checkregexforerrors($searchterm);
if ($regexerror) {
::badreg($regexerror);
return;
}
}
Expand Down Expand Up @@ -322,7 +323,8 @@ sub countmatches {

my $count = 0;
++$count while searchtext( $searchterm, 2 ); # search very silently, counting matches
$::lglobal{searchnumlabel}->configure( -text => searchnumtext($count) );
$::lglobal{searchnumlabel}->configure( -text => searchnumtext($count) )
if defined $::lglobal{searchpop};

# restore saved globals
$::searchstartindex = $savesearchstartindex;
Expand Down Expand Up @@ -350,17 +352,6 @@ BEGIN { # restrict scope of $countlastterm
}
}

#
# Set search entry box to red/black text if invalid/valid search term
# Also used as a validation routine, but always returns OK because we still want
# the text to be shown, even if it's a bad regex - user may not have finished typing
sub reg_check {
my $term = shift;
my $color = ( $::sopt[3] and not ::isvalid($term) ) ? 'red' : 'black';
$::lglobal{searchentry}->configure( -foreground => $color );
return 1;
}

#
# Pop dialog for editing regexps/hints in scannos files
sub regedit {
Expand Down Expand Up @@ -472,9 +463,10 @@ sub regload {
#
# Add a new scanno
sub regadd {
my $st = $::lglobal{regsearch}->get( '1.0', '1.end' );
unless ( isvalid($st) ) {
badreg();
my $st = $::lglobal{regsearch}->get( '1.0', '1.end' );
my $regexerror = ::checkregexforerrors($st);
if ($regexerror) {
::badreg($regexerror);
return;
}
my $rt = $::lglobal{regreplace}->get( '1.0', '1.end' );
Expand Down Expand Up @@ -587,6 +579,7 @@ sub swapterms {

#
# Check if a regex is valid by attempting to eval it
# Return error message on failure, empty string on success.
#
# Two possible errors:
# 1. eval block fails to compile and $@ contains the compile error
Expand All @@ -598,42 +591,66 @@ sub swapterms {
# case 2 would not trigger. Therefore it is necessary to remember the bad regex and check
# against that as well.
#
# Block to ensure persistence of $lastbad
# Block to ensure persistence of $lastbad & $lasterror
{
my $lastbad = '^*'; # initialise to a regex that would generate a warning
my $lastbad = '^*'; # initialise to a regex that would generate a warning
my $lasterror = '';

sub isvalid {
sub checkregexforerrors {
my $regex = shift;

# assume a new regex is a good one
my $valid = $regex ne $lastbad;
return $lasterror if $regex eq $lastbad;

$lasterror = ''; # Assume OK at this point

# local warning handler to trap regex warnings
local $SIG{__WARN__} = sub {
$lastbad = $regex;
$valid = 0;
$lastbad = $regex;
$lasterror = shift;
};

# try compiling it - note warning handler may set $valid to 0 at this point
# try compiling it - note warning handler may set $lasterror at this point
eval { qr/$regex/ };
$lasterror = $@ if $@; # if compile failed

$valid = 0 if $@; # if compile failed
return $valid;
return $lasterror;
}
} # End of enclosing block

#
# Warn user if regex search term is invalid
sub badreg {
my $warning = $::top->Dialog(
-text => "Invalid Regex search term.\nDo you have mismatched\nbrackets or parentheses?",
-title => 'Invalid Regex',
-bitmap => 'warning',
-buttons => ['Ok'],
);
$warning->Icon( -image => $::icon );
$warning->Show;
}
#
# Set entry box to red/black text if invalid/valid regex
# Also used as a validation routine, but always returns OK because we still want
# the text to be shown, even if it's a bad regex - user may not have finished typing
sub reg_check {
my $widget = shift;
my $term = shift;
my $isregex = shift; # Optional regex flag - true to treat string as regex (default)
my $color = ( $isregex and ::checkregexforerrors($term) ) ? 'red' : 'black';
$widget->configure( -foreground => $color );
return 1;
}

#
# Warn user that regex search term is invalid
# Given an error message from compiling the regex, simplify it, then report it to user
sub badreg {

# Make the error more user-friendly by removing "marked by <-- HERE in m/"
# and trimming where it reports the Perl filename and line number (after "/ at ")
my $details = shift;
$details =~ s/marked by <-- HERE in m\//\n/;
my $trimpoint = rindex( $details, '/ at ' );
$details = substr( $details, 0, $trimpoint ) if $trimpoint > 0;

my $warning = $::top->Dialog(
-text => $details,
-title => 'Invalid Regex',
-bitmap => 'warning',
-buttons => ['Ok'],
);
$warning->Icon( -image => $::icon );
$warning->Show;
}
} # End of enclosing block

#
# Clear the mark that showed where match from previous search was
Expand Down Expand Up @@ -979,7 +996,8 @@ sub searchoptset {
}

# Changing options may affect if search string is valid, so re-check it
reg_check( $::lglobal{searchentry}->get ) if $::lglobal{searchpop};
reg_check( $::lglobal{searchentry}, $::lglobal{searchentry}->get, $::sopt[3] )
if $::lglobal{searchpop};
}

#
Expand Down Expand Up @@ -1073,7 +1091,7 @@ sub searchpopup {
$::lglobal{searchentry} = $sf11->Entry(
-foreground => 'black',
-validate => 'all',
-vcmd => sub { reg_check(shift); }
-vcmd => sub { reg_check( $::lglobal{searchentry}, shift, $::sopt[3] ); }
)->pack(
-side => 'left',
-anchor => 'w',
Expand Down Expand Up @@ -2234,7 +2252,7 @@ sub quickcount {
sub quicksearch {
my $reverse = shift;

return if not defined $::lglobal{statussearchtext} or $::lglobal{statussearchtext} eq '';
return if $::lglobal{quicksearchentry}->get eq '';

# Save main search settings and set up using quicksearch values
my @saveopt;
Expand All @@ -2246,10 +2264,10 @@ sub quicksearch {
$::sopt[3] = $::lglobal{statussearchregex};
$::sopt[4] = 0;

::add_entry_history( $::lglobal{quicksearchentry}->get, \@::quicksearch_history ); # Add to history menu
$::lglobal{quicksearch} = 1;
::searchtext( $::lglobal{statussearchtext} );
::searchtext( $::lglobal{quicksearchentry}->get );
$::lglobal{quicksearch} = 0;
::add_entry_history( $::lglobal{statussearchtext}, \@::quicksearch_history ); # Add to history menu

# Restore main search settings
$::sopt[$_] = $saveopt[$_] for ( 0 .. 4 );
Expand Down Expand Up @@ -2277,18 +2295,11 @@ sub quicksearchpopup {
-width => 9,
-height => 15,
)->pack( -side => 'left', -anchor => 'nw' );
$::lglobal{statussearchtext} = '' unless defined $::lglobal{statussearchtext};

# If some text is selected, put the first line only in the quick search entry field
# then clear the selection so it doesn't get in the way of the search
my @ranges = $textwindow->tagRanges('sel');
$textwindow->tagRemove( 'sel', '1.0', 'end' );
$::lglobal{statussearchtext} = $textwindow->get( $ranges[0], $ranges[1] ) if @ranges;
$::lglobal{statussearchtext} =~ s/[\n\r].*//s; # Trailing 's' makes '.' match newlines

$::lglobal{quicksearchentry} = $frame0->Entry(
-width => 12,
-textvariable => \$::lglobal{statussearchtext},
-width => 12,
-validate => 'all',
-vcmd => sub { quicksearch_reg_check(shift); }
)->pack( -expand => 1, -fill => 'x', -side => 'top' );
$::lglobal{quicksearchentry}->bind( '<Return>', sub { ::quicksearch(); } );
searchbind( $::lglobal{quicksearchpop}, '<Control-Shift-f>', sub { ::quicksearch(); } ); # Same shortcut as popping the dialog
Expand All @@ -2298,6 +2309,17 @@ sub quicksearchpopup {
$::lglobal{quicksearchentry}
->bind( '<Control-Shift-Return>', sub { ::quicksearch('reverse'); $::textwindow->focus; } );

# If some text is selected, put the first line only in the quick search entry field
# then clear the selection so it doesn't get in the way of the search
my @ranges = $textwindow->tagRanges('sel');
$textwindow->tagRemove( 'sel', '1.0', 'end' );
if (@ranges) {
my $searchterm = $textwindow->get( $ranges[0], $ranges[1] );
$searchterm =~ s/[\n\r].*//s; # Trailing 's' makes '.' match newlines
$::lglobal{quicksearchentry}->delete( 0, 'end' );
$::lglobal{quicksearchentry}->insert( 'end', $searchterm );
}

# Allow user to pop main S/R dialog while focused on Quicksearch dialog
searchbind( $::lglobal{quicksearchpop}, '<Control-f>', sub { ::searchpopup(); } );
searchbind( $::lglobal{quicksearchpop}, '<Meta-f>', sub { ::searchpopup(); } ) if $::OS_MAC;
Expand Down Expand Up @@ -2333,13 +2355,15 @@ sub quicksearchpopup {
-text => 'Word',
-command => sub {
$::lglobal{statussearchregex} = 0 if $::lglobal{statussearchword}; # Can't have word and regex
quicksearch_reg_check( $::lglobal{quicksearchentry}->get );
},
)->pack( -side => 'left' );
$frame1->Checkbutton(
-variable => \\$::lglobal{statussearchregex},
-text => 'Regex',
-command => sub {
$::lglobal{statussearchword} = 0 if $::lglobal{statussearchregex}; # Can't have word and regex
quicksearch_reg_check( $::lglobal{quicksearchentry}->get );
},
)->pack( -side => 'left' );

Expand All @@ -2359,11 +2383,18 @@ sub quicksearchpopup {
$::lglobal{quicksearchentry}->icursor('end');
}

#
# Check quick search regex - used for validation and when switching between regex/exact matches
# Takes search string as argument
sub quicksearch_reg_check {
reg_check( $::lglobal{quicksearchentry}, shift, $::lglobal{statussearchregex} );
}

#
# Do a count, using the string and settings from the quicksearch dialog,
# saving and restoring search settings in the main S/R dialog
sub quicksearchcountmatches {
return if not defined $::lglobal{statussearchtext} or $::lglobal{statussearchtext} eq '';
return if $::lglobal{quicksearchentry}->get eq '';
my $textwindow = $::textwindow;

# save selection range to restore later
Expand All @@ -2387,8 +2418,9 @@ sub quicksearchcountmatches {
my $saveselectionsearch = $::lglobal{selectionsearch};
$::lglobal{selectionsearch} = 0;

my $count = 0;
++$count while searchtext( $::lglobal{statussearchtext}, 2 ); # search very silently, counting matches
my $count = 0;
my $searchterm = $::lglobal{quicksearchentry}->get;
++$count while searchtext( $searchterm, 2 ); # search very silently, counting matches
my $dlg = $::top->Dialog(
-text => searchnumtext($count),
-bitmap => "info",
Expand Down
Loading
Loading