Re: Insert something like a hyperlink in a Tk Text widget

[zentara]

Here are some other enhancements, like changing the cursor to an hand. It would be cool to add a different color on visited links too.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new( -title => "hyperlinks" );
my $t   = $mw->Scrolled('Text')->pack;
my $tag = "tag000";

foreach (<DATA>) {
    chomp;
    my (@items) = split (/(http:\S+)/,$_);

    foreach (@items) {
        if (/(http:\S+)/) {
            $t->insert( 'end', $_, $tag );
            $t->tagConfigure( $tag, -foreground => 'blue' );
            $t->tagBind( $tag,
                '<Any-Enter>' => [ \&manipulate_link, $tag, 'raised', 
+'hand2' ]
            );
            $t->tagBind( $tag,
                '<Any-Leave>' => [ \&manipulate_link, $tag, 'flat', 'x
+term' ] );
            $t->tagBind( $tag,
                '<Button-1>' => [ \&manipulate_link, $tag, 'sunken' ] 
+);
            $t->tagBind( $tag,
                '<ButtonRelease-1>' =>
                  [ \&manipulate_link, $tag, 'raised', undef, \&printm
+e ] );
            $tag++;
        }
        else {
            $t->insert( 'end', $_ );
        }
    }
    $t->insert( 'end', "\n" );
}
MainLoop;

sub printme {
    local ($,) = " ";
    print "printme:", @_, "\n";
}

sub manipulate_link {

    # manipulate the link as you press the mouse key

    my ($a)      = shift;
    my ($tag)    = shift;
    my ($relief) = shift;
    my ($cursor) = shift;
    my ($after)  = shift;

    # by configuring the relief (to simulate a button press)
    $a->tagConfigure( $tag, -relief => $relief, -borderwidth => 1 );

    # by changing the cursor between hand and xterm
    $a->configure( -cursor => $cursor ) if ($cursor);

    # and by scheduling the specified action to run "soon"
    if ($after) {
        my ($s) = $a->get( $a->tagRanges($tag) );
        $mw->after( 200, [ $after, $a, $s, $tag, @_ ] ) if ($after);
    }
}
__DATA__
Hi there.  This is text.
THis is more text but http://this.is.a/hyperlink in a line.
http://this.is.another/hyperlink followed by
http://this.is.a.third/hyperlink
__END__