Tk Library Source Code

Artifact 65af1e698ccc1858728ca5a67afcb86cd9614617:

Attachment "tree.patch" to ticket [2825354fff] added by danckaert 2009-07-22 20:10:46.

---

Index: tree.tcl
===================================================================
RCS file: /cvsroot/tcllib/bwidget/tree.tcl,v
retrieving revision 1.59
diff -b -u -r1.59 tree.tcl
--- tree.tcl	30 Jun 2009 16:17:37 -0000	1.59
+++ tree.tcl	22 Jul 2009 12:20:16 -0000
@@ -1370,11 +1370,6 @@
         set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
     }
     if { $showlines && [llength $nodes] } {
-	if {$y0 < 0} {
-	    # Adjust the drawing of the line to the first root node
-	    # to start at the vertical point (not go up).
-	    incr y0 $deltay
-	}
         set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
                     -fill    [Widget::getoption $path -linesfill]   \
                     -stipple [Widget::getoption $path -linestipple] \
@@ -2151,7 +2146,8 @@
 #	list		The list of tags to apply to the canvas item
 proc Tree::_get_node_tags {path node {tags ""}} {
     eval [linsert $tags 0 lappend list TreeItemSentinal]
-    if {[Widget::getoption $path.$node -helptext] == ""} { return $list }
+    if {[Widget::getoption $path.$node -helptext] == "" &&
+        [Widget::getoption $path.$node -helpcmd]  == ""} { return $list }
 
     switch -- [Widget::getoption $path.$node -helptype] {
 	balloon {
@@ -2179,29 +2175,22 @@
     Widget::getVariable $path help
 
     set item $path.$node
-    set opts [list -helptype -helptext -helpvar]
-    foreach {cty ctx cv} [eval [linsert $opts 0 Widget::hasChangedX $item]] break
+    set opts [list -helptype -helptext -helpvar -helpcmd]
+    foreach {cty ctx cv cc} [eval [linsert $opts 0 Widget::hasChangedX $item]] break
     set text [Widget::getoption $item -helptext]
+    set cmd  [Widget::getoption $item -helpcmd]
 
     ## If we've never set help for this item before, and text is not blank,
     ## we need to setup help.  We also need to reset help if any of the
     ## options have changed.
-    if { (![info exists help($node)] && $text != "") || $cty || $ctx || $cv } {
+    if { (![info exists help($node)] && ($text ne "" || $cmd ne ""))
+         || $cty || $ctx || $cv || $cc} {
 	set help($node) 1
 	set type [Widget::getoption $item -helptype]
-        switch $type {
-            balloon {
-		DynamicHelp::register $path.c balloon n:$node $text
-		DynamicHelp::register $path.c balloon i:$node $text
-		DynamicHelp::register $path.c balloon b:$node $text
-            }
-            variable {
 		set var [Widget::getoption $item -helpvar]
-		DynamicHelp::register $path.c variable n:$node $var $text
-		DynamicHelp::register $path.c variable i:$node $var $text
-		DynamicHelp::register $path.c variable b:$node $var $text
-            }
-        }
+        DynamicHelp::add $path.c -item n:$node -type $type -text $text -variable $var -command $cmd
+        DynamicHelp::add $path.c -item i:$node -type $type -text $text -variable $var -command $cmd
+        DynamicHelp::add $path.c -item b:$node -type $type -text $text -variable $var -command $cmd
     }
 }