#!/usr/bin/perl
use warnings;
use strict;
use Tk;
#subs borrowed from widget demo
my $usage = "USAGE: $0 filename searchstring (regexp|exact)\n";

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

my ($file_name, $search_string, $kind) = @ARGV;
if(! -e $file_name){print $usage; die "No file found $!\n"}
if($search_string eq ''){print $usage; die "Need a search string";}

my $file;
open (FH,"< $file_name");
read( FH,  $file, -s FH );
close FH;

$kind ||= 'exact';

my $text = $mw->Scrolled(qw/Text -setgrid true -scrollbars e/);
$text->tagConfigure( 'search',   -foreground => 'red',-background => 'white' );

$text->insert('0.0', $file);
$text->mark(qw/set insert 0.0/);
$text->pack(qw/-expand yes -fill both/);

&search_text($text,\$search_string,'search',$kind);

MainLoop;

#######################################################################3

sub search_text {

    # The utility procedure below searches for all instances of a given
    # 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, $length_last);
    while (1) {
        $current =
          $w->search( -count => \$length, "-$kind", $$string, $current, 'end' );
        last if not $current;
        warn "Posn=$current count=$length\n",
          $w->tagAdd( $tag, $current, "$current + $length char" );
        $current = $w->index("$current + $length char");
    }

}    # end search_text