#!/usr/bin/perl 
######################################################################
# (c) Michael Schilli 1999
######################################################################

use Tk;

my $ttag;
                            # Widgets erzeugen
$top = MainWindow->new();

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

                            # Hyperlink-Anzeige unten
$urltext = "";
$label = $top->Label(-textvariable => \$urltext);

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

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

                            # Text einfügen
$text->insert('end', "Der Hyperlink ");
                            # Hyperlink einfügen
hyperlink_insert($text, 'end', "http://remote.com", "tag1");
                            # Text einfügen
$text->insert('end', " darf aktiviert werden!\n");

                            # Textfenster Read-only
$text->configure(-state => "disabled");

MainLoop;


###############################################################
# Einen aktivierbaren Hyperlink in ein Textwidget integrieren
###############################################################
sub hyperlink_insert {
    my($text, $where, $name, $tag) = @_;

                                   # Text einfügen
    $text->insert($where, $name, $tag); 

                                   # Farblich unterlegen
    $text->tag('configure', $tag, -foreground => "blue");

                                   # Bei Mauszeigerberührung
                                   # URL unten anzeigen
    $text->tag('bind', $tag, '<Any-Enter>' => 
                             sub { $urltext = $name; } );

                                  # Anzeige löschen, falls
                                  # Maus Bereich verläßt
    $text->tag('bind', $tag, '<Any-Leave>' =>
                             sub { $urltext = ""; } );

                                  # Aktion bei Mausklick-
                                  # Aktivierung
    $text->tag('bind', $tag, '<1>' => 
               sub { print "Aktiviert:", $name, "\n"; });
}