Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Insert something like a hyperlink in a Tk Text widget

by jdporter (Canon)
on Feb 12, 2008 at 18:09 UTC ( #667638=snippet: print w/ replies, xml ) Need Help??

Description: 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('') },
    );
}

Comment on Insert something like a hyperlink in a Tk Text widget
Download Code
Re: Insert something like a hyperlink in a Tk Text widget
by zentara (Archbishop) 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__

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://667638]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (7)
As of 2014-07-10 06:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (200 votes), past polls