view release on metacpan or  search on metacpan

lib/Tkx/FindBar.pm  view on Meta::CPAN

#              for Tkx::Ev to work when binding.
#-------------------------------------------------------------------------------
sub _find {
	my $what   = shift;                 # proposed text (Tcl %P)
	my $self   = shift;                 # megawidget instance
	my $which  = shift;                 # first|next|prev
	my $data   = $self->_data();        # instance data
	my $where  = $data->{-textwidget};  # where to search

	return 1 unless defined $where;

	# Restart new searches at the beginning. Advance the start position for
	# 'next' searches so we don't find the same text again.
	$data->{start}  = '1.0'       if $which eq 'first';
	$data->{start} .= '+ 1 chars' if $which eq 'next';

	# Build search options
	my @how = ('-count' => \$data->{count});
	push @how, '-backwards' if $which eq 'prev';
	push @how, '-regex'     if   $data->{regex};
	push @how, '-nocase'    if ! $data->{case};

	# Clear any results from the last search
	$where->tag('remove', 'highlight', '0.0', 'end');

	# Search for text
	# The eval{} is to catch exceptions caused by incomplete or invalid
	# regular expressions when the -regex option is used. Note that we can't
	# pre-check the regex because it's being evaluated by Tcl, not Perl, and
	# there are subtle syntax differences.
	my $i = eval { $where->search(@how, $what, $data->{start}) };

	if ($@) {
		# invalid regex (presumably)
		Tkx::eval("$self.e", 'configure', -foreground => 'red');
	}
	elsif ($i) {
		# text found / normal mode / no indication
		Tkx::eval("$self.e", 'configure', -foreground => 'black');

		# Highlight the match, scroll to it, and reset the start
		# position for finding the prev/next instance
		$where->tag('add', 'highlight', $i, "$i + $data->{count} chars");
		$where->see($i);
		$data->{start} = $i;
	}
	else {
		# text not found
		Tkx::eval("$self.e", 'configure', -foreground => '#808080');
	}

	# We only wanted to search, not prevent text entry.
	return 1;
}

1;

__DATA__
#name:format:height:width:data
close16:png:16:16:iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QwDARgOPQO6ugAAAZNJREFUOMudk71SGzEUhT/J9hriPEDGBTCTN2B4Axc0FHQ01KFPCbUzjtN7Jn3SU/IuTIoQ90S7lvfPq5Nis2vIuonV6M5I57v3niuZ2Xz6...
close16:gif89:16:16:R0lGODlhEAAQAOYAANnZ2YiKhYqMh////+Pj4/39/eLd3eHY2OHT0+HQ0ODOzuDNzeHPz+HS0uHW1uLa2uLf3+DHx+DCwuHBweHAwOHAv+HDwuDGx+HLzODGxuC+vuC4uOGvr+K3t+G9veDIx/v7+9+8vN+xsOGqquGpqeK/vuCzs9+houCbm+CVleGVleKamuGhoeK1tvj4+OCqqt6UlN+MjN+FheCEhOCKiu...
go-down16:png:16:16:iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAI9SURBVDiNhZNNaBNBGIbfmezmD2vAYNJD/MGq9SIaj0m04MGL8SIULx4q4kEU6qFV8SoI0hU8qVCEnBQholJTW3Kx1lUItS0Ue6hVtFTNmq79C+...
go-down16:gif89:16:16:R0lGODlhEAAQAOYAANnZ2Tp0BDpzBMfesMPcq7/aprHSkaPKfsjfsY2+X4a6VXGuN06aBsffsXiyQYy9XYW5VHy0Rzt1BDt2BMXdrYm8WYK4UG+tNFaJJ8Lbqsber8Lcqoi9VoK6TWOqH1OiCKXOf6TNfqTMfp/HeEuCGDt0BHqlT7jWm42+XYrAWIfAUX68QlqrDFmrC1mqClipDJfHaGWaNJm/danRg4nC...
go-up16:png:16:16:iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAIeSURBVDiNlZNPaBNBFMa/N7sz2Y2FemhM/9GCBO3BQCqo0NWKaERiRS0UcmtKyUmQYhbBq8dSkaAXD0VPHqVC8eJNKl5EUNBDKbQqlZQ0iaaaJtnZ...
go-up16:gif89:16:16:R0lGODlhEAAQAOYAANnZ2Tt1BDpzBFeJKFaJJkF5D6fKh6LHfkF5Djp0BJa9cprFcpXCaoazWzt0BHilTrDSkX20SHaxP2qcO1eKKLvXoIy9X4C2TXqzRFyiGprEcU+EHUB4DbfUnKDJeou+Woa8UXS0OFOjCGyvLJfDbj53CqHEgLXVl5bFaZHFYIvDVmawHVmsC1mrC4XBTYS0VX+pVsffsKDLd5rKbJbKY4...
__END__

=pod

=head1 NAME

Tkx::FindBar - Perl Tkx extension for an incremental search toolbar

=head1 SYNOPSIS

   use Tkx;
   use Tkx::FindBar;

   my $mw      = Tkx::widget->new('.');
   my $text    = $mw->new_text();
   my $findbar = $mw->new_tkx_FindBar(-textwidget => $text);

   $text->g_pack();
   $findbar->g_pack();
   $findbar->hide();  # remove until requested by user

   # Bindings to display and hide toolbar and navigate matches.
   $findbar->add_bindings($mw,
      '<Control-f>'  => 'show',
      '<Escape>'     => 'hide',
      '<F3>'         => 'next',
      '<Control-F3>' => 'previous',
   );

   Tkx::MainLoop();

=head1 DESCRIPTION

Tkx::FindBar is a Tkx megawidget that provides a toolbar for searching in a text
widget. Using a toolbar for a search UI is much less obtrusive than a dialog
box. The search is done incrementally (also known as "find as you type"). The
toolbar may be hidden and shown as needed.

Tkx::FindBar was inspired by the great find toolbar in Mozilla Firefox.

=head1 WIDGET-SPECIFIC OPTIONS

=head2 C<-textwidget =E<gt> I<widget>>

Defines the widget to search in. This must be a text widget (or act like
one).

=head2 C<-highlightcolor =E<gt> I<color>>

Defines the background color used to highlight found text. The default
value is #80FF80.

=head2 C<-tile>

If set to 1 (the default) and the Tk tile package is available, the FindBar will
be drawn using themed widgets to acheive a platform native appearance. If set to