1 # General purpose code for being a tray applet
3 proc manyset {list args} {
4 foreach val $list var $args {
12 package require tktray
14 #----- general machinery -----
18 # tk::tktray widget is called .i
23 # applet::setup-tooltip ON-VISIBLE ON-INVISIBLE
24 # to make applet have a tooltip.
26 # ON-VISIBLE and ON-INVISIBLE will be globally eval'd
27 # when the tooltip becomes visible and invisible.
30 # applet::tooltip-set TEXT-MAYBE-MULTILINE
35 # Caller may bind .i.i <ButtonPress-$b>
37 # Alternatively caller may call applet::setup-button-menu $b
38 # which will generate a menu .m$b which the user can configure
39 # and which will automatically be posted and unposted etc.
40 # In this case the caller should arrange that all of their
41 # menus, when an item is selected, call
47 # applet::setimage IMAGE
50 # Alternatively, instead of icon, it may make other arrangements
51 # to use the provided subwindow
53 # Caller that needs access to inner window should call
54 # applet::setup-subwindow WIDTH ON-DESTROYING ON-READY
55 # Then the main code will call ON-DESTROYING just before
56 # destroying the inner window and recreating it, and ON-READY
57 # just after. In ON-READY the inner window is called .i.i.
59 # The user of the subwindow machinery may call
60 # applet::subwindow-need-recreate
61 # if for any reason the inner window should be destroyed and recreated.
65 # if necessary) a subprocess.
67 # proc innerwindow {} { ... }
71 # .i.i.b frame to contain container
72 # .i.i.b.c actual container
76 tktray::icon .i -class example
77 .i configure -docked 1
79 fconfigure stdout -buffering line
82 namespace eval applet {
85 # used by both menus and tooltips
90 proc setup-button-menu {b} {
91 bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
95 proc menubuttonpressed {b x y} {
99 puts "unpost $posted toggle"
102 } elseif {[winfo exists .m$b]} {
105 puts "unpost $posted other"
118 #----- tooltips -----
120 variable tooltip_on_vis {}
121 variable tooltip_on_invis {}
123 proc tooltip-starttimer {state x y} {
124 variable tooltip_after
126 variable tooltip_inwindow
127 if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
128 catch { after cancel $tooltip_after }
129 set tooltip_after [after 500 applet::tooltip-show $x $y]
132 proc tooltip-cancel {} {
133 variable tooltip_after
134 variable tooltip_on_invis
135 catch { after cancel $tooltip_after }
136 catch { unset $tooltip_after }
138 uplevel #0 $tooltip_on_invis
141 set tooltip_inwindow 0
143 proc tooltip-enter {state x y} {
144 variable tooltip_inwindow
145 set tooltip_inwindow 1
146 tooltip-starttimer $state $x $y
149 proc tooltip-leave {} {
150 variable tooltip_inwindow
151 set tooltip_inwindow 0
155 proc setup-tooltip {on_vis on_invis} {
156 foreach v {vis invis} {
157 variable tooltip_on_$v [set on_$v]
159 bind .i <Enter> { applet::tooltip-enter %s %X %Y }
160 bind .i <Leave> { applet::tooltip-leave }
161 bind .i <ButtonRelease> {
162 applet::tooltip-cancel
163 applet::tooltip-starttimer %s %X %Y
165 bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
166 toplevel .tt -background black
168 wm overrideredirect .tt 1
169 label .tt.t -justify left -background {#EEE1B3}
170 pack .tt.t -padx 1 -pady 1
174 proc tooltip-set {s} {
175 .tt.t configure -text $s
178 proc tooltip-show {x y} {
179 variable tooltip_on_vis
182 wm geometry .tt +$x+$y
184 uplevel #0 $tooltip_on_vis
187 #----- simple images -----
189 proc setimage {image} {
190 .i configure -image $image
193 #----- subwindow -----
195 variable subwindow_on_destroying
196 variable subwindow_on_ready
198 proc subwindow-need-recreate {} {
199 variable innerwindow_after
201 if {[info exists innerwindow_after]} return
202 set innerwindow_after [after idle applet::innerwindow-resetup]
205 proc innerwindow-resetup {} {
206 variable innerwindow_after
207 variable subwindow_on_destroying
208 variable subwindow_on_ready
209 unset innerwindow_after
213 uplevel #0 $subwindow_on_destroying
215 catch { destroy .i.i.c }
216 if {![winfo exists .i.i]} return
217 destroy [frame .i.i.make-exist]
218 catch { destroy .i.i.b.c }
219 catch { destroy .i.i.b }
221 pack .i.i.b -fill both -side left -expand 1
222 frame .i.i.b.c -container 1 -background orange
223 pack .i.i.b.c -fill both -side left -expand 1
225 global inner_lastw inner_lasth
226 #set w [winfo width .i.i]
227 # set w [winfo width .i.i]
228 # set h [winfo height .i.i]
230 # if {$w != $inner_lastw || $h != $inner_lasth} {
233 # innerwindow-ph-dummy configure -width $w -height 2
235 uplevel #0 $subwindow_on_ready
239 proc setup-subwindow {w on_destroying on_ready} {
240 foreach v {destroying ready} {
241 variable subwindow_on_$v [set on_$v]
244 global inner_lastw inner_lasth
248 image create photo applet::innerwindow-ph-dummy -width $w -height 2
249 .i configure -image applet::innerwindow-ph-dummy
251 destroy [frame .i.make-exist]
252 destroy [frame .i.i.make-exist]
253 bind .i <<IconConfigure>> {
254 applet::subwindow-need-recreate
258 #----- subprocess -----
260 variable subproc none
261 variable ratelimit {}
263 proc setup-subproc {w get_cmdline} {
264 variable subproc_get_cmdline $get_cmdline
265 setup-subwindow $w applet::subproc-destroying applet::subproc-ready
268 proc subproc-destroying {} {
270 puts "DESTROYING $subproc"
271 switch -exact $subproc {
274 default { kill $subproc; set subproc old }
278 proc subproc-ready {} {
280 puts "READY $subproc"
281 switch -exact $subproc {
289 error "unexpected state $subproc"
292 puts "READY-done $subproc"
298 variable subproc_get_cmdline
300 set id [winfo id .i.i.b.c]
301 set cmd [uplevel #0 [concat [list $subproc_get_cmdline] $id]]
303 puts "RUN-CHILD $subproc"
304 set now [clock seconds]
305 lappend ratelimit $now
306 while {[lindex $ratelimit 0] < {$now - 10}} {
307 set ratelimit [lrange $ratelimit 1 end]
309 if {[llength $ratelimit] > 10} {
310 puts stderr "crashing repeatedly, quitting $ratelimit"
315 set subproc [subproc::fork applet::child-died {
316 execl [lindex $cmd 0] [lrange $cmd 1 end]
318 puts "FORKED $subproc"
321 proc child-died {how how2} {
322 puts "DIED $how $how2"
324 switch -exact $subproc {
331 subwindow-need-recreate