Wie realisiere ich HTML-Links in Textwidgets?

Hauptteil

#! /usr/bin/perl

#-------------------- Package Definition --------------------
#----------------------- Dependencies -----------------------
use strict;
use warnings;
use Tk;

#------------------------ Main Window -----------------------
my $mw = MainWindow->new( -height => 600, -width => 800);
$mw->geometry('800x600');

#---------- Adding Text
my $text7 = $mw->Scrolled( 'Text', -scrollbars => 'e');
$text7->place( -x => 0, -y => 55, -height => 545, -width => 800);

my $t = "l000000";                             #Index fuer TK-Textlinks (Tag's)
my @tag;                                       #Array fuer Tag's
my $link;                                      #Hilfsvar fuer Pfad
my %links;                                     #Hash Tag->Pfad
my @example = ("bla bla lall\n",
               "<a href=\"c:\\temp\\Link1.txt\">Link1</a>\n",
               "bla bla lall\n",
               "<a href=\"c:\\temp\\Link2.txt\">Link2</a>",
               "bla bla lall\n",
               "<a href=\"c:\\temp\\Link3.txt\">Link3</a>"); # BeispielHTMLText

$text7->delete(qw/1.0 end/);                   #Textwidget leer

foreach(@example){                             #Text einfuegen
  if (m/<a href=\"/){                          #html links erkennen
    $link = $_;
    $link = getpath($link);                    #Zielpfad extract
    $text7->insert('end', delhtml($_),++$t);   #reinen Text ins Widget
    push(@tag,$t);                             #Tagzaehler ins Array
    $links{$t}=$link;                          #Zielpfad in Hash
  }
  else{
    $text7->insert('end',$_);                  #kein HTML
  }
}

foreach (@tag){                                #alle Tags mit Prozeduren binden
  $text7->tagBind($_, '<ButtonRelease-1>' => sub{invoke(\%links,$text7);});#klick auf Tag
  $text7->tagBind($_, '<Any-Enter>'       => [\&show_link,$text7]);     #Mouse in Tag
  $text7->tagBind($_, '<Any-Leave>'       => [\&normal,$text7]);        #Mouse aus Tag
}

MainLoop;


#------------------------ Main Body -------------------------
##
# Zielpfad aus HTML-Link
##
sub getpath{
  my ($path) = @_;
  $path =~ m/<a href=\"(.*)?\">/;
  return($1);
}# end getpath

##
# HTML Entfernen
##
sub delhtml{
  my ($text) = @_;
  $text =~ s/<a href=\".*?>//;
  $text =~s/<\/a>//;
  return($text);
}# end delhtml

##
# Aktion bei Klick auf Tag
##
sub invoke{
  my ($link_ptr,$text7)   = @_;         #Referenz auf Hash Tagnummer->Zielpfad
  my $name;                             #Zielpfad
  my $index = $text7->index('current'); #aktuellen Index im Text ermitteln
  my @tags  = $text7->tagNames($index); #Tagnummern zu aktuellem Index im Text
  foreach (@tags){                      #sollte immer nur ein Tag sein!
    $name = ${$link_ptr}{$_};           #Zielpfad aus Hash für den aktuellen Tag
  }
  $text7->delete(qw/1.0 end/);          #alten Text loeschen
  $text7->insert('end',readfile($name));#dafuer Link aus Zielpfad einlesen
}# end invoke

##
# Tag hervorheben
##
sub show_link{
  my ($text7) = @_;
  my $index   = $text7->index('current');
  my @tags    = $text7->tagNames($index);
  foreach (@tags){
    $text7->tag('configure', $_, '-relief', 'raised', '-borderwidth', '1');
  }
}# end link

##
# Tag wieder normal
##
sub normal{
  my ($text7) = @_;
  my $index   = $text7->index('current');
  my @tags    = $text7->tagNames($index);
  foreach (@tags){
    $text7->tag('configure', $_, '-relief', 'flat');
  }
}# end normal

##
# Datei binaer als ein String einlesen
##
sub readfile{
  my ($filename) = @_;
  my $datei;                  #Rueckgabestring
  my $len = -s $filename;     #Dateilaenge von filename
  open(INFILE,$filename) or return("Link not found: $filename");
  binmode INFILE;
  $len = read INFILE, $datei, $len;
  close INFILE;
  return ($datei);
}# end readfile

Ergänzungen, Kommentare

---+++ Main.??? - 14 Jul 2003 - Betreff