#!/usr/bin/perl 
######################################################################
# hypertext.pl
######################################################################
# Perl Power! - Michael Schilli 1998
######################################################################

use Tk;

my $ttag;
                            # create widgets
$top = MainWindow->new();

                            # text area
$text  = $top->Text(-wrap => 'word', -height => 3);

                            # bottom left hyperlink display 
$urltext = "";
$label = $top->Label(-textvariable => \$urltext);

                            # Exit button
$exit  = $top->Button(-text => 'Exit', -command => \&exit);

                            # pack
$text->pack();
$label->pack(-anchor => "w");
$exit->pack();

                            # insert text
$text->insert('end', "The hyperlink ");
                            # insert hyperlink
hyperlink_insert($text, 'end', "http://remote.com", "tag1");
                            # insert text
$text->insert('end', " may be activated!\n");

                            # make text window read-only
$text->configure(-state => "disabled");

MainLoop;

######################################################################
# Integrate an activatable hyperlink into a text widget
######################################################################
sub hyperlink_insert {
    my($text, $where, $name, $tag) = @_;

                                   # insert text
    $text->insert($where, $name, $tag); 

                                   # set highlighted text color
    $text->tag('configure', $tag, -foreground => "blue");

                                   # upon mouse pointer touch
                                   # display URL bottom left
    $text->tag('bind', $tag, '<Any-Enter>' => 
                             sub { $urltext = $name; } );

                                  # delete display when
                                  # mouse leaves area
    $text->tag('bind', $tag, '<Any-Leave>' =>
                             sub { $urltext = ""; } );

                                  # action in case of 
                                  # mouse click activation
    $text->tag('bind', $tag, '<1>' => 
               sub { print "Activated:", $name, "\n"; });
}

