balloon information for links

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)

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;
 });
 
 

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);
 	

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;