
proc ToolTip {w type opt} {

		global Help

		set tip {}
		switch $type {
			entry -
			label -
			menubutton -
			checkbutton {
				if { [regexp {variable [^(]+[(]([^)]+)[)]} $opt x vname] } {
					set tip var,$vname
				}
				if { $tip == {} } {
					set pos [lsearch -exact $opt -text]
					if { $pos > -1 } {
						set tip text,[lindex $opt [expr $pos + 1]]
					} 
				}
			}
			label -
			radiobutton -
			button {
				set pos [lsearch -exact $opt -text]
				if { $pos > -1 } {
					set tip text,[lindex $opt [expr $pos + 1]]
				} 
			}
		}
		if { ! [info exists Help(Tip,$tip)] } {
			return
		} 

        bind $w <Enter> "after 200 TipAux %W $Help(Tip,$tip)"
        bind $w <Leave> "after cancel TipAux %W [list $Help(Tip,$tip)];
                         after 100 {catch {destroy .balloon_help}}"
}

proc TipAux {w args} {
		set msg [join $args]
        set t .balloon_help
        catch {destroy $t}
        toplevel $t
        wm overrideredirect $t 1
        pack [label $t.l -text $msg -relief groove -bd 1 -bg gold] -fill both
        set x [expr [winfo rootx $w]+6+[winfo width $w]/2]
        set y [expr [winfo rooty $w]+6+[winfo height $w]/2]
        wm geometry $t +$x\+$y
        bind $t <Enter> {after cancel {catch {destroy .balloon_help}}}
        bind $t <Leave> "catch {destroy .balloon_help}"
}



