Tk Library Source Code

Artifact c8b83461c837b9c6a64282fb0abc181410d85dbd:

Attachment "dynhelp.patch" to ticket [2820851fff] added by danckaert 2009-07-13 23:24:10.

---

Index: dynhelp.tcl
===================================================================
RCS file: /target/staff/koen/.cvsroot/bwidget/dynhelp.tcl,v
retrieving revision 1.1.1.2
diff -U5 -r1.1.1.2 dynhelp.tcl
--- dynhelp.tcl	9 Nov 2006 11:34:59 -0000	1.1.1.2
+++ dynhelp.tcl	13 Jul 2009 16:19:26 -0000
@@ -1,9 +1,9 @@
 # ----------------------------------------------------------------------------
 #  dynhelp.tcl
 #  This file is part of Unifix BWidget Toolkit
-#  $Id: dynhelp.tcl,v 1.1.1.2 2006/11/09 11:34:59 koen Exp $
+#  $Id: dynhelp.tcl,v 1.5 2009/03/12 10:30:21 koen Exp $
 # ----------------------------------------------------------------------------
 #  Index of commands:
 #     - DynamicHelp::configure
 #     - DynamicHelp::include
 #     - DynamicHelp::sethelp
@@ -56,12 +56,13 @@
     bind BwHelpBalloon <Motion>  {DynamicHelp::_motion_balloon motion %W %X %Y}
     bind BwHelpBalloon <Leave>   {DynamicHelp::_motion_balloon leave  %W %X %Y}
     bind BwHelpBalloon <Button>  {DynamicHelp::_motion_balloon button %W %X %Y}
     bind BwHelpBalloon <Destroy> {DynamicHelp::_unset_help %W}
 
+    # KD 2005/10/03: remove <Motion> binding (this binding usually avoided the
+    # problem of unbalanced enter/leave events, but not always)
     bind BwHelpVariable <Enter>   {DynamicHelp::_motion_info %W}
-    bind BwHelpVariable <Motion>  {DynamicHelp::_motion_info %W}
     bind BwHelpVariable <Leave>   {DynamicHelp::_leave_info  %W}
     bind BwHelpVariable <Destroy> {DynamicHelp::_unset_help  %W}
 
     bind BwHelpMenu <<MenuSelect>> {DynamicHelp::_menu_info select %W}
     bind BwHelpMenu <Unmap>        {DynamicHelp::_menu_info unmap  %W}
@@ -90,10 +91,11 @@
 # ----------------------------------------------------------------------------
 proc DynamicHelp::include { class type } {
     set helpoptions [list \
 	    [list -helptext String "" 0] \
 	    [list -helpvar  String "" 0] \
+	    [list -helpcmd  String "" 0] \
 	    [list -helptype Enum $type 0 [list balloon variable]] \
 	    ]
     Widget::declare $class $helpoptions
 }
 
@@ -453,11 +455,11 @@
 
         set varName [lindex $_registered($path,variable) 0]
         if {![info exists _saved]} { set _saved [GlobalVar::getvar $varName] }
         set string [lindex $_registered($path,variable) 1]
         if {[info exists _registered($path,command)]} {
-            set string [eval $_registered($path,command)]
+            set string [uplevel #0 $_registered($path,command)]
         }
         GlobalVar::setvar $varName $string
         set _current_variable $path
     }
 }
@@ -471,35 +473,39 @@
     variable _registered
     variable _current_variable
 
     if {$isCanvasItem} { set path [_get_canvas_path $path variable] }
 
-    if { [info exists _registered($path,variable)] } {
+    # KD 2005/10/03: leave event may be called twice (in case of pointer grab)
+    if { $_current_variable eq $path
+         && [info exists _registered($path,variable)] } {
         set varName [lindex $_registered($path,variable) 0]
         GlobalVar::setvar $varName $_saved
+        unset _saved
+        set _current_variable ""
     }
-    unset _saved
-    set _current_variable ""
 }
 
 
 # ----------------------------------------------------------------------------
 #  Command DynamicHelp::_menu_info
-#    Version of R1v1 restored, due to lack of [winfo ismapped] and <Unmap>
-#    under windows for menu.
 # ----------------------------------------------------------------------------
+# KD 2005/09/27 : we have to check for unmap event on Unix. On Windows, unmap
+# is not delivered, but <<MenuSelect>> is triggered appropriately when menu
+# is unmapped.
 proc DynamicHelp::_menu_info { event path } {
     variable _registered
 
     if { [info exists _registered($path)] } {
         set index   [$path index active]
         set varName [lindex $_registered($path) 0]
-        if { ![string equal $index "none"] &&
-             [set idx [lsearch $_registered($path) [list $index *]]] != -1 } {
+        if {$event ne "unmap" &&
+            ![string equal $index "none"] &&
+            [set idx [lsearch $_registered($path) [list $index *]]] != -1 } {
 	    set string [lindex [lindex $_registered($path) $idx] 1]
 	    if {[info exists _registered($path,$index,command)]} {
-		set string [eval $_registered($path,$index,command)]
+		set string [uplevel #0 $_registered($path,$index,command)]
 	    }
             GlobalVar::setvar $varName $string
         } else {
             GlobalVar::setvar $varName ""
         }
@@ -527,11 +533,11 @@
 	    upvar #0 $_registered($path,balloonVar) var
 	    if {[info exists var]} { set string $var }
 	}
 
         if {[info exists _registered($path,command)]} {
-            set string [eval $_registered($path,command)]
+            set string [uplevel #0 $_registered($path,command)]
         }
 
 	if {$string == ""} { return }
 
         toplevel $_top -relief flat \
@@ -592,19 +598,20 @@
 # ----------------------------------------------------------------------------
 proc DynamicHelp::_unset_help { path } {
     variable _canvases
     variable _registered
     variable _top
+    variable _current_balloon
 
     if {[info exists _registered($path)]} { unset _registered($path) }
     if {[winfo exists $path]} {
 	set cpath [BWidget::clonename $path]
 	if {[info exists _registered($cpath)]} { unset _registered($cpath) }
     }
     array unset _canvases   $path,*
     array unset _registered $path,*
-    destroy $_top
+    if {$path eq $_current_balloon} {destroy $_top}
 }
 
 # ----------------------------------------------------------------------------
 #  Command DynamicHelp::_get_canvas_path
 # ----------------------------------------------------------------------------