#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::LabEntry;
#code adapted from the widget demo 

my $mw = MainWindow->new( -bg => 'black' );
$mw->geometry('100x30+100+15');

# USAGE: $0 filename(optional); 

my $textin = '';

if(defined $ARGV[0]){
     if(-e $ARGV[0]){ my $file_name = $ARGV[0];
                      open (FH,"< $file_name");
                      read( FH,  $textin, -s FH );
                     close FH;
                   }
}

my $search_string = '';

my $stringframe = $mw->Frame(-bg=>'steelblue')->pack(qw/-side top -fil
+l x/);;
my $ss = $stringframe->LabEntry(
            -label        => 'Regexp:',
            -bg           => 'lightyellow',
            -width        => 40,
            -labelPack    => [qw/-side left -anchor w/],
             -textvariable => \$search_string
                 )->pack(qw/-side left/);

my $ss_button = $stringframe->Button( -text => 'Test It' )
                 ->pack(qw/-side left -pady 5 -padx 10/);

$stringframe->Button( -text => 'Exit',-bg=>'red',
                      -activebackground => 'pink',
                      -command=>[sub{Tk::exit}])
                 ->pack(qw/-side right -pady 5 -padx 10/);


$mw->Label(-text=>"         Enter your text or file below 
                   (a file can be entered on the commandline)",-bg=>'l
+ightblue'
                )->pack(qw/-side top -fill x/);


my $text = $mw->Scrolled(qw/Text -setgrid true -scrollbars e bg lighty
+ellow/);
$text->tagConfigure( 'search',   -foreground => 'yellow',-background =
+> 'black' );

$text->insert('0.0', $textin);
$text->mark(qw/set insert 0.0/);

$text->pack(qw/-expand yes -fill both/);

my $command = sub { &search_text($text,\$search_string,'search','regex
+p') };
$ss_button->configure( -command => $command );
$ss->bind( '<Return>' => $command );
$ss->focus;

MainLoop;

######################################################################
+#3 

sub search_text {

    # The utility procedure below searches for all instances of a give
+n 
    # string in a text widget and applies a given tag to each instance
+ found. 
    # Arguments: 
    # 
    # w -       The window in which to search.  Must be a text widget.
+ 
    # string -  Reference to the string to search for.  The search is 
+done 
    #           using exact matching only;  no special characters. 
    # tag -     Tag to apply to each instance of a matching string. 

    my ( $w, $string, $tag, $kind ) = @_;
#    print "@_\n"; 

    return unless ref($string) && length($$string);

    $w->tagRemove( $tag, qw/0.0 end/ );
    my ( $current, $length ) = ( '1.0', 0 );

my $current_last = 0;
my $length_last = 0;


    while (1) {
        $current =
          $w->search( -count => \$length, "-$kind", $$string, $current
+, 'end' );
        last if not $current;
        warn "Posn=$current count=$length\n"; 
 if(($current == $current_last)and($length ==    $length_last)){print 
+chr(07);return}
       $current_last = $current;
       $length_last = $length;

          $w->tagAdd( $tag, $current, "$current + $length char" );
        $current = $w->index("$current + $length char");
    }

}    # end search_text
[download]