Given a Tk::Text widget, insert a string at the current insert location which is "active", i.e. when clicked, executes some function. Actually, the behavior of the "link" is defined by the caller in terms of Tk events. Clicking (<ButtonPress>) is merely one such possibility.

{
my $hypertext_tag_name = 't000000'; # candidate for 'static'

# returns the tag name, in case there's anytyhing else
# you'd like to do with it.
sub Tk_Text_insert_active_text
{
    my( $Text, $linktext, %callbacks ) = @_;
    my $start_index = $Text->index( 'insert' );
    $Text->insert( insert => $linktext );
    my   $end_index = $Text->index( 'insert' );

    my $link_tag_name = ++$hypertext_tag_name;
    $Text->tagAdd( $link_tag_name, $start_index, $end_index );
    $Text->tagConfigure( $link_tag_name, -foreground => 'blue', -under
+line => 1 );

    $Text->tagBind( $link_tag_name, $_ => $callbacks{$_} ) for keys %c
+allbacks;

    $link_tag_name
}
}

# Example: make a real link:

sub Tk_Text_insert_hyperlink
{
    my( $Text, $url, $title ) = @_;

    Tk_Text_insert_active_text( $Text, $title,
        '<ButtonPress>' => sub { system $url }, # launch in system bro
+wser
        '<Enter>' => sub { set_status_bar($url) },
        '<Leave>' => sub { set_status_bar('') },
    );
}

[download]

Replies are listed 'Best First'.
Re: Insert something like a hyperlink in a Tk Text widget
by zentara (Cardinal) on Feb 12, 2008 at 20:07 UTC
    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__

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]

Back to Cool Uses for Perl