From 91d3e98ba25e7e7a15d97b83f0fea2d4fb55e070 Mon Sep 17 00:00:00 2001
From: milkbone57 <milkbone57>
Date: Thu, 16 Oct 2003 01:51:37 +0000
Subject: [PATCH] balloon information for links

---
 docs/VERSION.txt             |  1 +
 plugins/Tk-GUI/Tk-GUI.pl     |  7 ++++---
 plugins/Tk-GUI/Tk/Browser.pm | 32 +++++++++++++++++++++++++++++++-
 plugins/Tk-GUI/test.pl       |  6 ++++++
 4 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/docs/VERSION.txt b/docs/VERSION.txt
index 2a471a9..73afcfd 100644
--- a/docs/VERSION.txt
+++ b/docs/VERSION.txt
@@ -1,6 +1,7 @@
 0.37
 --
 
+* Balloon information for link mouseovers
 * Error dialog now properly focuses the OK button
 * Idle time fixed
 * Useless sounds removed (except for msg_in and go_away)
diff --git a/plugins/Tk-GUI/Tk-GUI.pl b/plugins/Tk-GUI/Tk-GUI.pl
index 46f3f4a..99be9ed 100644
--- a/plugins/Tk-GUI/Tk-GUI.pl
+++ b/plugins/Tk-GUI/Tk-GUI.pl
@@ -83,18 +83,19 @@ register_hook("error", sub {
     ($text) = $text =~ m/^(.*?)\n/;
     my $error_box = $mw->Toplevel(-title => "Milkbone Error");
     $error_box->Label(-text => $ARGS{-short}, -wraplength => 200)->pack;
-    $error_box->Button(-text => "OK", -command => [sub {
+    my $button = $error_box->Button(-text => "OK", -command => [sub {
         my ($self, $fatal) = @_;
         $self->destroy;
         hook("protocol_signoff") if $fatal;
         $mw->destroy if $fatal  && hook("protocol_signed_in");
-    }, $error_box, $ARGS{-fatal}])->pack->focus;
+    }, $error_box, $ARGS{-fatal}]);
+    $button->pack->focus;
     hook("tk_seticon", -wnd => $error_box);
     $error_box->withdraw;
     $error_box->geometry("+" . int(($mw->screenwidth() / 2) - int($error_box->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($error_box->height() / 2)) );
     $error_box->deiconify;
     $error_box->update;
-    $error_box->focus;
+    $button->focus;
 });
 
 
diff --git a/plugins/Tk-GUI/Tk/Browser.pm b/plugins/Tk-GUI/Tk/Browser.pm
index d603c21..9e62409 100644
--- a/plugins/Tk-GUI/Tk/Browser.pm
+++ b/plugins/Tk-GUI/Tk/Browser.pm
@@ -2,6 +2,7 @@ package Tk::Browser;
 
 use Tk;
 use Tk::Font;
+use Tk::Balloon;
 use base 'Tk::ROText';
 use Cwd qw(abs_path);
 
@@ -125,11 +126,40 @@ sub u_end
 	delete $data->{tags}->{'<u>'};
 }
 
+sub balloon_handle {
+  my ($self) = @_;
+  my ($x, $y) = (
+                 $self->pointerx - $self->rootx,
+                 $self->pointery - $self->rooty);
+  my $index = $self->index("\@$x,$y");
+  my @tags = $self->tagNames($index);
+  for(@tags) {
+    print;
+    next unless /^<a.*href="(.*?)"/i 
+      and defined($1);
+    $self->{msg} = $1;
+    return "$x, $y";  
+  }
+  return 0;
+}
+
 sub a_begin
 {
-	# this assumes that no one will nest anchor tags ( a silly thing to do anyway )
+    # this assumes that no one will nest anchor tags 
+    #( a silly thing to do anyway )
 
 	my ($self, $tag, $data, $font) = @_;
+        unless(defined($self->{balloon}))
+          {
+          $self->{msg} = "test";
+          $self->{balloon} = $self->parent->Balloon;
+          $self->{balloon}->attach($self,
+                  -msg => \$self->{msg},
+                  -balloonposition => 'mouse',
+                  -postcommand => [\&balloon_handle,$self],
+                  #-motioncommand => sub { print "erer"; 1; }
+                 );
+      }
 
 	my ($href) = ($tag =~ m/href=\"(.*?)\"/i);
 	
diff --git a/plugins/Tk-GUI/test.pl b/plugins/Tk-GUI/test.pl
index db6992a..5322dfe 100644
--- a/plugins/Tk-GUI/test.pl
+++ b/plugins/Tk-GUI/test.pl
@@ -1,6 +1,12 @@
 use Tk;
 use Tk::Browser;
 
+use Milkbone;
+
+register_hook "tk_getmain", sub {
+  return $mw;
+}
+
 $mw = MainWindow->new;
 
 $edit = $mw->Browser->pack;