From 18394838d3888c8523f9fe12956ebb1a1230f1c1 Mon Sep 17 00:00:00 2001 From: Nigel Date: Sun, 1 Oct 2023 20:36:52 +0100 Subject: [PATCH 1/2] Improve regex checking 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. --- src/guiguts.pl | 1 - src/lib/Guiguts/Highlight.pm | 34 ++++-- src/lib/Guiguts/SearchReplaceMenu.pm | 150 ++++++++++++++++----------- src/lib/Guiguts/WordFrequency.pm | 22 ++-- 4 files changed, 134 insertions(+), 73 deletions(-) diff --git a/src/guiguts.pl b/src/guiguts.pl index fec3eb73..8b7b4afb 100755 --- a/src/guiguts.pl +++ b/src/guiguts.pl @@ -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; diff --git a/src/lib/Guiguts/Highlight.pm b/src/lib/Guiguts/Highlight.pm index 330bdb48..323b29cb 100644 --- a/src/lib/Guiguts/Highlight.pm +++ b/src/lib/Guiguts/Highlight.pm @@ -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 ); @@ -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' ); @@ -258,7 +267,11 @@ 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, @@ -266,14 +279,16 @@ sub hilitepopup { ); 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( @@ -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, @@ -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 diff --git a/src/lib/Guiguts/SearchReplaceMenu.pm b/src/lib/Guiguts/SearchReplaceMenu.pm index 322182dd..edf5b144 100644 --- a/src/lib/Guiguts/SearchReplaceMenu.pm +++ b/src/lib/Guiguts/SearchReplaceMenu.pm @@ -7,7 +7,7 @@ BEGIN { our ( @ISA, @EXPORT ); @ISA = qw(Exporter); @EXPORT = qw(&update_sr_histories &searchtext ®_check &getnextscanno &updatesearchlabels - &isvalid &swapterms &findascanno ®hint &replace &replaceall + &checkregexforerrors &badreg &swapterms &findascanno ®hint &replace &replaceall &searchfromstartifnew &searchoptset &searchpopup &stealthscanno &find_proofer_comment &find_asterisks &find_transliterations &nextblock &orphanedbrackets &orphanedmarkup &searchsize &loadscannos &replace_incr_counter &countmatches &setsearchpopgeometry &quickcount @@ -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; } } @@ -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{quicksearchpop}; # restore saved globals $::searchstartindex = $savesearchstartindex; @@ -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 { @@ -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' ); @@ -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 @@ -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 @@ -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}; } # @@ -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', @@ -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; @@ -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 ); @@ -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( '', sub { ::quicksearch(); } ); searchbind( $::lglobal{quicksearchpop}, '', sub { ::quicksearch(); } ); # Same shortcut as popping the dialog @@ -2298,6 +2309,17 @@ sub quicksearchpopup { $::lglobal{quicksearchentry} ->bind( '', 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}, '', sub { ::searchpopup(); } ); searchbind( $::lglobal{quicksearchpop}, '', sub { ::searchpopup(); } ) if $::OS_MAC; @@ -2333,6 +2355,7 @@ 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( @@ -2340,6 +2363,7 @@ sub quicksearchpopup { -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' ); @@ -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 @@ -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", diff --git a/src/lib/Guiguts/WordFrequency.pm b/src/lib/Guiguts/WordFrequency.pm index 261896ed..9b521ce9 100644 --- a/src/lib/Guiguts/WordFrequency.pm +++ b/src/lib/Guiguts/WordFrequency.pm @@ -183,7 +183,8 @@ sub wordfrequency { 'RegExp-->', [ sub { - anythingwfcheck( 'words matching regular expression', $::regexpentry ); + anythingwfcheck( 'words matching regular expression', + $::lglobal{regexpentry}->get() ); } ] ], @@ -207,13 +208,19 @@ sub wordfrequency { ); $button->bind( '<3>' => $_->[2] ) if $_->[2]; } else { - $::lglobal{regexpentry} = - $wordfreqseframe1->Entry( -textvariable => \$::regexpentry, )->grid( + $::lglobal{regexpentry} = $wordfreqseframe1->Entry( + -validate => 'all', + -vcmd => sub { ::reg_check( $::lglobal{regexpentry}, shift, 1 ); } + )->grid( -row => $row, -column => $col, -columnspan => 3, -sticky => "nsew" - ); + ); + if ( $::lglobal{regexpentrystring} ) { + $::lglobal{regexpentry}->delete( 0, 'end' ); + $::lglobal{regexpentry}->insert( 'end', $::lglobal{regexpentrystring} ); + } } } my $wcframe = $::lglobal{wfpop}->Frame->pack( -fill => 'both', -expand => 'both', ); @@ -240,6 +247,7 @@ sub wordfrequency { ::drag( $::lglobal{wclistbox} ); $::lglobal{wfpop}->protocol( 'WM_DELETE_WINDOW' => sub { + $::lglobal{regexpentrystring} = $::lglobal{regexpentry}->get; # Save string for next time popped ::killpopup('wfpop'); undef $::lglobal{wclistbox}; $::lglobal{markuppopok}->invoke if $::lglobal{markuppop}; @@ -583,9 +591,9 @@ sub anythingwfcheck { my $top = $::top; ::operationadd( 'Check ' . $checktype ); $::lglobal{wclistbox}->delete( '0', 'end' ); - if ( not ::isvalid($checkregexp) ) { - $::lglobal{wclistbox}->insert( 'end', "Invalid regular expression: $checkregexp" ); - $::lglobal{wclistbox}->update; + my $regexerror = ::checkregexforerrors($checkregexp); + if ($regexerror) { + ::badreg($regexerror); return; } $::lglobal{wclistbox}->insert( 'end', 'Please wait, building word list....' ); From 5b6ebb0990ef01713dcd286cc48eec34183280d9 Mon Sep 17 00:00:00 2001 From: Nigel Date: Mon, 2 Oct 2023 14:30:04 +0100 Subject: [PATCH 2/2] Show Search dialog count label correctly Copy/paste error in previous commit meant count label was only shown if *Quick*Search dialog was popped, not *Search* dialog. --- src/lib/Guiguts/SearchReplaceMenu.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/Guiguts/SearchReplaceMenu.pm b/src/lib/Guiguts/SearchReplaceMenu.pm index edf5b144..ccd46f01 100644 --- a/src/lib/Guiguts/SearchReplaceMenu.pm +++ b/src/lib/Guiguts/SearchReplaceMenu.pm @@ -324,7 +324,7 @@ sub countmatches { my $count = 0; ++$count while searchtext( $searchterm, 2 ); # search very silently, counting matches $::lglobal{searchnumlabel}->configure( -text => searchnumtext($count) ) - if defined $::lglobal{quicksearchpop}; + if defined $::lglobal{searchpop}; # restore saved globals $::searchstartindex = $savesearchstartindex;