X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=example;fp=example;h=457d75d3aeb8fbc30eae101a44597ba446d588fb;hp=fe9794341f67fdb751d7e7f7a2b7e12198a35b38;hb=208895273cfa7904e09251ee19495b0c0d1ff5e8;hpb=d6c1639412fcfd0e262af10918fe88da2b8029eb

diff --git a/example b/example
index fe97943..457d75d 100755
--- a/example
+++ b/example
@@ -6,8 +6,6 @@ package require tktray
 
 wm withdraw .
 
-image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm   
-
 tktray::icon .i -class example
 .i configure -docked 1
 
@@ -19,6 +17,7 @@ foreach b {1 3} {
 
 proc pressed {b x y} {
     global posted
+    tooltip_cancel
     if {$posted == $b} {
 	puts "unpost $posted toggle"
      	.m$posted unpost
@@ -41,9 +40,69 @@ proc msel {} {
 
 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 -----
 
-.i configure -image ims
 .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"