Skip to content

Commit

Permalink
Improve regex checking (#1258)
Browse files Browse the repository at this point in the history 
User can type regexes in 4 places: Search/Replace, Quick Search,
Word Frequency, Search->Highlight Character, String or Regex.

Only the first had regex checking, changing the text color to red
if the regex gave an error on compilation, and a weak error
message if the user tried to actually search with the bad regex.

This commit improves the error message to report a sanitized
version of the error or warning message for Search/Replace.
It also applies the same color changing, error messages, and
checks for switching between exact/regex as appropriate for
the other 3 cases.

Validating doesn't always work well with having a variable
bound to the text widget, so that has been removed if present,
and the necessary functionality coded separately.
  • Loading branch information
@windymilla
windymilla authored Oct 13, 2023
1 parent 305948c commit 9d53496
Show file tree
Hide file tree
Showing 4 changed files with 134 additions and 73 deletions.
1 change: 0 additions & 1 deletion src/guiguts.pl
View file
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
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
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

0 comments on commit 9d53496

Please sign in to comment.