#!/usr/bin/wish8.4

#----- general machinery -----

package require tktray

wm withdraw .

tktray::icon .i -class example
.i configure -docked 1

set posted 0

foreach b {1 3} {
    menu .m$b -tearoff 0
}

proc pressed {b x y} {
    global posted
    tooltip_cancel
    if {$posted == $b} {
	puts "unpost $posted toggle"
     	.m$posted unpost
	set posted 0
    } elseif {[winfo exists .m$b]} {
	if {$posted} {
	    .m$posted unpost
	    puts "unpost $posted other"
	}
	puts "post $b"
	set posted $b
	.m$b post $x $y
    }
}

proc msel {} {
    global posted
    set posted 0
}

bind .i <ButtonPress> { pressed %b %X %Y }

proc tooltip_starttimer {state x y} {
    global tooltip_after posted tooltip_inwindow
    if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
    catch { after cancel $tooltip_after }
    set tooltip_after [after 500 tooltip_show $x $y]
}

proc tooltip_cancel {} {
    global tooltip_after
    catch { after cancel $tooltip_after }
    catch { unset $tooltip_after }
    wm withdraw .tt
}

set tooltip_inwindow 0

proc tooltip_enter {state x y} {
    global tooltip_inwindow
    set tooltip_inwindow 1
    tooltip_starttimer $state $x $y
}

proc tooltip_leave {} {
    global tooltip_inwindow
    set tooltip_inwindow 0
    tooltip_cancel
}

proc setuptooltip {} {
    bind .i <Enter> { tooltip_enter %s %X %Y }
    bind .i <Leave> { tooltip_leave }
    bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
    bind .i <Motion> { tooltip_starttimer %s %X %Y }
    toplevel .tt -background black
    wm withdraw .tt
    wm overrideredirect .tt 1
    label .tt.t -justify left -background {#EEE1B3}
    pack .tt.t -padx 1 -pady 1
    settooltip {}
}

proc settooltip {s} {
    .tt.t configure -text $s
}

proc tooltip_show {x y} {
    incr x 9
    incr y 9
    wm geometry .tt +$x+$y
    wm deiconify .tt
}

proc setimage {image} {
    .i configure -image $image
}

#----- specifics -----

.m1 add command -command { msel; puts hi } -label hi
.m3 add command -command { msel; puts boo } -label boo

image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm   
setimage ims

setuptooltip
settooltip "line\nanother"