applet.tcl

   1
   2 #----- general machinery -----
   3
   4 package require tktray
   5 #load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so
   6
   7
   8 wm withdraw .
   9
  10 tktray::icon .i -class example
  11 .i configure -docked 1
  12
  13 set posted 0
  14
  15 foreach b {1 3} {
  16     menu .m$b -tearoff 0
  17 }
  18
  19 proc pressed {b x y} {
  20     global posted
  21     tooltip_cancel
  22     if {$posted == $b} {
  23         puts "unpost $posted toggle"
  24         .m$posted unpost
  25         set posted 0
  26     } elseif {[winfo exists .m$b]} {
  27         if {$posted} {
  28             .m$posted unpost
  29             puts "unpost $posted other"
  30         }
  31         puts "post $b"
  32         set posted $b
  33         .m$b post $x $y
  34     }
  35 }
  36
  37 proc msel {} {
  38     global posted
  39     set posted 0
  40 }
  41
  42 proc setupinnerwindow {} {
  43     global innerwindow_after innerwindow
  44     catch { after cancel $innerwindow_after }
  45     catch { unset innerwindow_after }
  46     if {[info exists innerwindow]} return
  47     set children {}
  48     foreach child [winfo children .i] {
  49         if {![winfo exists $child]} continue
  50         lappend children $child
  51     }
  52     if {[llength $children]==1} {
  53         set innerwindow [lindex $children 0]
  54         bind $innerwindow <Destroy> {
  55             innerwindow-unavailable
  56             catch { unset innerwindow }
  57             after idle setupinnerwindow
  58         }
  59         innerwindow-available
  60     } else {
  61         after 5000 setupinnerwindow
  62     }
  63 }
  64
  65 bind .i <ButtonPress> { pressed %b %X %Y }
  66
  67 proc tooltip_starttimer {state x y} {
  68     global tooltip_after posted tooltip_inwindow
  69     if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
  70     catch { after cancel $tooltip_after }
  71     set tooltip_after [after 500 tooltip_show $x $y]
  72 }
  73
  74 proc tooltip_cancel {} {
  75     global tooltip_after
  76     catch { after cancel $tooltip_after }
  77     catch { unset $tooltip_after }
  78     wm withdraw .tt
  79 }
  80
  81 set tooltip_inwindow 0
  82
  83 proc tooltip_enter {state x y} {
  84     global tooltip_inwindow
  85     set tooltip_inwindow 1
  86     tooltip_starttimer $state $x $y
  87 }
  88
  89 proc tooltip_leave {} {
  90     global tooltip_inwindow
  91     set tooltip_inwindow 0
  92     tooltip_cancel
  93 }
  94
  95 proc setuptooltip {} {
  96     bind .i <Enter> { tooltip_enter %s %X %Y }
  97     bind .i <Leave> { tooltip_leave }
  98     bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
  99     bind .i <Motion> { tooltip_starttimer %s %X %Y }
 100     toplevel .tt -background black
 101     wm withdraw .tt
 102     wm overrideredirect .tt 1
 103     label .tt.t -justify left -background {#EEE1B3}
 104     pack .tt.t -padx 1 -pady 1
 105     settooltip {}
 106 }
 107
 108 proc settooltip {s} {
 109     .tt.t configure -text $s
 110 }
 111
 112 proc tooltip_show {x y} {
 113     incr x 9
 114     incr y 9
 115     wm geometry .tt +$x+$y
 116     wm deiconify .tt
 117 }
 118
 119 proc setimage {image} {
 120     .i configure -image $image
 121 }