example

   1 #!/usr/bin/wish8.4
   2
   3 #----- general machinery -----
   4
   5 package require tktray
   6
   7 wm withdraw .
   8
   9 tktray::icon .i -class example
  10 .i configure -docked 1
  11
  12 set posted 0
  13
  14 foreach b {1 3} {
  15     menu .m$b -tearoff 0
  16 }
  17
  18 proc pressed {b x y} {
  19     global posted
  20     tooltip_cancel
  21     if {$posted == $b} {
  22         puts "unpost $posted toggle"
  23         .m$posted unpost
  24         set posted 0
  25     } elseif {[winfo exists .m$b]} {
  26         if {$posted} {
  27             .m$posted unpost
  28             puts "unpost $posted other"
  29         }
  30         puts "post $b"
  31         set posted $b
  32         .m$b post $x $y
  33     }
  34 }
  35
  36 proc msel {} {
  37     global posted
  38     set posted 0
  39 }
  40
  41 bind .i <ButtonPress> { pressed %b %X %Y }
  42
  43 proc tooltip_starttimer {state x y} {
  44     global tooltip_after posted tooltip_inwindow
  45     if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
  46     catch { after cancel $tooltip_after }
  47     set tooltip_after [after 500 tooltip_show $x $y]
  48 }
  49
  50 proc tooltip_cancel {} {
  51     global tooltip_after
  52     catch { after cancel $tooltip_after }
  53     catch { unset $tooltip_after }
  54     wm withdraw .tt
  55 }
  56
  57 set tooltip_inwindow 0
  58
  59 proc tooltip_enter {state x y} {
  60     global tooltip_inwindow
  61     set tooltip_inwindow 1
  62     tooltip_starttimer $state $x $y
  63 }
  64
  65 proc tooltip_leave {} {
  66     global tooltip_inwindow
  67     set tooltip_inwindow 0
  68     tooltip_cancel
  69 }
  70
  71 proc setuptooltip {} {
  72     bind .i <Enter> { tooltip_enter %s %X %Y }
  73     bind .i <Leave> { tooltip_leave }
  74     bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
  75     bind .i <Motion> { tooltip_starttimer %s %X %Y }
  76     toplevel .tt -background black
  77     wm withdraw .tt
  78     wm overrideredirect .tt 1
  79     label .tt.t -justify left -background {#EEE1B3}
  80     pack .tt.t -padx 1 -pady 1
  81     settooltip {}
  82 }
  83
  84 proc settooltip {s} {
  85     .tt.t configure -text $s
  86 }
  87
  88 proc tooltip_show {x y} {
  89     incr x 9
  90     incr y 9
  91     wm geometry .tt +$x+$y
  92     wm deiconify .tt
  93 }
  94
  95 proc setimage {image} {
  96     .i configure -image $image
  97 }
  98
  99 #----- specifics -----
 100
 101 .m1 add command -command { msel; puts hi } -label hi
 102 .m3 add command -command { msel; puts boo } -label boo
 103
 104 image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm
 105 setimage ims
 106
 107 setuptooltip
 108 settooltip "line\nanother"