#!/usr/bin/perl

=for comment

The Tk::_Extended_Text package provides
methods that override all of the Tk::Text
methods that change the selection in the
Tk::Text widget, adding a call to
eventGenerate() to generate a
virtual <<Selection>> event.

Bind a callback to the <<Selection>> event
and it will be called any time the
selection changes (including when the
selection is removed).

This code will also work with Tk::ROText,
since Tk::ROText is a subclass of Tk::Text.
Simply replace all references to Tk::Text
with Tk::ROText.

=cut

use warnings;
use strict;

use Tk;
use Tk::widgets qw(
    Frame
    Text
    Label
);

{
    package Tk::_Extended_Text;
    
    @Tk::_Extended_Text::ISA = 'Tk::Text';

    Tk::Widget->Construct('_Extended_Text');
    
    my $i = 0;
    
    my @lastranges;
    
    # subroutine: &selectionChanged
    # 
    # argument:   LIST of 'sel' tag ranges
    # 
    # Return TRUE if the ROText selection
    # has changed.
    #
    # Several of the Tk::Text methods generate
    # a lot of noise even when there's no
    # change to the selection, use
    # &selectionChanged to discover if the
    # selection has actually been modified.
    #
    # Call &selectionChanged with the current
    # 'sel' tag range, if the return value is
    # TRUE, the selection was changed,
    # otherwise no change.
    
    sub selectionChanged {
        my @ranges = @_;

        if (@ranges != @lastranges) {
            return 1;
        }

        # each array has same number of elements
        for (my $i = 0; $i < @ranges; $i++) {
            if ($ranges[$i] ne $lastranges[$i]) {
                return 1;
            }
        }
        
        return;
    }


    # override Tk::Text methods:
    # -----------------------------------------------
    # These overrides are simple wrappers that
    # provide a hook for generation of the
    # <<Selection>> event.
    
    sub selectAll {
        my $w = shift;
        $w->SUPER::selectAll(@_);
        $w->eventGenerate('<<Selection>>');
        @lastranges = $w->tagRanges('sel');
        return;
    }

    
    sub unselectAll {
        my $w = shift;
        $w->SUPER::unselectAll(@_);
        if (selectionChanged($w->tagRanges('sel'))) {
            $w->eventGenerate('<<Selection>>');
        }
        @lastranges = $w->tagRanges('sel');
        return;
    }

    
    sub SelectTo {
        my $w = shift;
        $w->SUPER::SelectTo(@_);
        if (selectionChanged($w->tagRanges('sel'))) {
            $w->eventGenerate('<<Selection>>');
        }
        @lastranges = $w->tagRanges('sel');
        return;
    }

    
    sub KeySelect {
        my $w = shift;
        $w->SUPER::KeySelect(@_);
        $w->eventGenerate('<<Selection>>');
        @lastranges = $w->tagRanges('sel');
        return;
    }


    sub FindAll {
        my $w = shift;
        $w->SUPER::FindAll(@_);
        if (selectionChanged($w->tagRanges('sel'))) {
            $w->eventGenerate('<<Selection>>');
        }
        @lastranges = $w->tagRanges('sel');
        return;
     }


    sub FindNext {
        my $w = shift;
        $w->SUPER::FindNext(@_);
        if (selectionChanged($w->tagRanges('sel'))) {
            $w->eventGenerate('<<Selection>>');
        }
        @lastranges = $w->tagRanges('sel');
        return;
     }
}


my $mw = MainWindow->new;

my $statbar = $mw->Frame(
    -relief => 'sunken',
)->pack(
    -fill   => 'x',
    -side   => 'bottom',
);

my $selview = $statbar->Label->pack;


##
### allocate an extended Tk::Text widget object:
##
my $t = $mw->_Extended_Text->pack;


my $i = 0;

$t->bind(
    '<<Selection>>',
    sub {
        print "<<Selection>> event $i\n";
        $i++;
        my @r = $t->tagRanges('sel');
        if (@r) {
            my $len = length $t->get(@r);
            $selview->configure(-text => "begin $r[0]  :  end $r[1]  :
+  length $len");
        }
        else {
            $selview->configure(-text => 'no selection');
        }
    },
);

$mw->bind('<Control-q>', sub { $mw->destroy });

$selview->configure(-text => 'Ctrl-q to exit.');

$mw->after(
    2500,
    sub {
        $selview->configure(
            -text => 'Select text with mouse or keyboard.',
        );
    },
);

$t->insert('end', "testing\ntesting\n1-2-3 testing");
$t->focus;

MainLoop;
[download]