[Tkabber-dev] r795 - in trunk/tkabber: . plugins/richtext

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 19 23:10:33 MSK 2006


Author: sergei
Date: 2006-11-19 23:10:31 +0300 (Sun, 19 Nov 2006)
New Revision: 795

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/richtext/urls.tcl
Log:
	* plugins/richtext/urls.tcl: Changed balloon behaviour to
	  be consistent with other balloons.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-11-19 15:18:25 UTC (rev 794)
+++ trunk/tkabber/ChangeLog	2006-11-19 20:10:31 UTC (rev 795)
@@ -1,5 +1,8 @@
 2006-11-19  Sergei Golovan  <sgolovan at nes.ru>
 
+	* plugins/richtext/urls.tcl: Changed balloon behaviour to
+	  be consistent with other balloons.
+
 	* plugins/roster/conferences.tcl: Made conference group
 	  name translateable (thanks to Irek Chmielowiec).
 

Modified: trunk/tkabber/plugins/richtext/urls.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/urls.tcl	2006-11-19 15:18:25 UTC (rev 794)
+++ trunk/tkabber/plugins/richtext/urls.tcl	2006-11-19 20:10:31 UTC (rev 795)
@@ -157,18 +157,20 @@
 
     $w tag add $type $url_start {end - 1 char}
 
-    $w tag bind $privtag <Enter> \
+    $w tag bind $privtag <Any-Enter> \
 	[list ::richtext::highlighttext \
 	      $w $privtag $options(activeforeground) $options(cursor)]
-    $w tag bind $privtag <Leave> \
+    $w tag bind $privtag <Any-Leave> \
 	[list ::richtext::highlighttext \
 	      $w $privtag $options(foreground) xterm]
 
     if {$show_hints} {
-	$w tag bind $privtag <Enter> \
-	    +[list [namespace current]::show_hint $w %x %y %X %Y]
-	$w tag bind $privtag <Leave> \
-	    +[namespace current]::hide_hint
+	$w tag bind $privtag <Any-Enter> \
+	    +[list [namespace current]::balloon $w $privtag enter %x %y %X %Y]
+	$w tag bind $privtag <Any-Motion> \
+	    +[list [namespace current]::balloon $w $privtag motion %x %y %X %Y]
+	$w tag bind $privtag <Any-Leave> \
+	    +[list [namespace current]::balloon $w $privtag leave %x %y %X %Y]
     }
 
     eval {config_url $w $privtag} $args
@@ -178,6 +180,20 @@
     return $privtag ;# to allow further configuration of this tag
 }
 
+proc urls::balloon {w tag action x y X Y} {
+    switch -- $action {
+	enter {
+	    ::balloon::default_balloon $w:$tag enter $X $Y -text [get_url $w $x $y]
+	}
+	motion {
+	    ::balloon::default_balloon $w:$tag motion $X $Y -text [get_url $w $x $y]
+	}
+	leave {
+	    ::balloon::default_balloon $w:$tag leave $X $Y
+	}
+    }
+}
+
 # Tries to find the title for the URL $url either in the $options
 # (which are usually those passed to [render_url] or among the
 # properties of the message being processed.
@@ -195,15 +211,6 @@
     return $title
 }
 
-proc urls::show_hint {w x y X Y} {
-    ::balloon::set_text [get_url $w $x $y]
-    ::balloon::show $X $Y
-}
-
-proc urls::hide_hint {} {
-    ::balloon::destroy
-}
-
 # Configures a URL $tag rendered in a text widget $w.
 # This tag is either a metatag "url" or some other tag
 # returned by the [render_url] proc.



More information about the Tkabber-dev mailing list