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::setup-debug ON-DEBUG
48 # which will result in calls to [concat ON-DEBUG [list MESSAGE]]
49 # (or ON-DEBUG may be "" in which case messages are discarded)
54 # applet::setimage IMAGE
57 # Alternatively of icon, it may provide other arrangements for
58 # using the provided subwindow. Such a caller should call
59 # applet::setup-subwindow ON-DESTROYING ON-READY
60 # Then the main code will call ON-DESTROYING just before
61 # destroying the inner window and recreating it, and
62 # [concat ON-READY [list ORIENTATION]]
63 # just after. The inner window to use is called .i.i.b.
65 # This uses variables, in the applet namespace,
66 # w h border_colour border_width deforient
67 # These should be set before setup-subwindow is called and not
68 # modified thereafter.
70 # The user of the subwindow machinery may call
71 # applet::subwindow-need-recreate
72 # if for any reason the inner window should be destroyed and recreated.
74 # Alternatively, it may request that a subprocess be spawned
75 # repeatedly with the xid of a suitable window.
76 # applet::setup-subproc GET-CMDLINE
77 # Then the main code will call [concat GET_CMDLINE [list XID ORIENTATION]]
78 # to get the command line to run.
80 # This also uses the same variables as setup-subwindow.
84 tktray::icon .i -class example
85 .i configure -docked 1
87 fconfigure stdout -buffering none
88 fconfigure stderr -buffering none
91 namespace eval applet {
97 if {![llength $debug]} return
98 uplevel #0 $debug [list $m]
101 proc setup-debug {d} {
105 # used by both menus and tooltips
110 proc setup-button-menu {b} {
111 bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
115 proc menubuttonpressed {b x y} {
119 debug "unpost $posted toggle"
122 } elseif {[winfo exists .m$b]} {
125 debug "unpost $posted other"
138 #----- tooltips -----
140 variable tooltip_on_vis {}
141 variable tooltip_on_invis {}
143 proc tooltip-starttimer {state x y} {
144 variable tooltip_after
146 variable tooltip_inwindow
147 if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
148 catch { after cancel $tooltip_after }
149 set tooltip_after [after 500 applet::tooltip-show $x $y]
152 proc tooltip-cancel {} {
153 variable tooltip_after
154 variable tooltip_on_invis
155 catch { after cancel $tooltip_after }
156 catch { unset $tooltip_after }
158 uplevel #0 $tooltip_on_invis
161 set tooltip_inwindow 0
163 proc tooltip-enter {state x y} {
164 variable tooltip_inwindow
165 set tooltip_inwindow 1
166 tooltip-starttimer $state $x $y
169 proc tooltip-leave {} {
170 variable tooltip_inwindow
171 set tooltip_inwindow 0
175 proc setup-tooltip {on_vis on_invis} {
176 foreach v {vis invis} {
177 variable tooltip_on_$v [set on_$v]
179 bind .i <Enter> { applet::tooltip-enter %s %X %Y }
180 bind .i <Leave> { applet::tooltip-leave }
181 bind .i <ButtonRelease> {
182 applet::tooltip-cancel
183 applet::tooltip-starttimer %s %X %Y
185 bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
186 toplevel .tt -background black
188 wm overrideredirect .tt 1
189 label .tt.t -justify left -background {#EEE1B3}
190 pack .tt.t -padx 1 -pady 1
194 proc tooltip-set {s} {
195 .tt.t configure -text $s
198 proc tooltip-show {x y} {
199 variable tooltip_on_vis
202 wm geometry .tt +$x+$y
204 uplevel #0 $tooltip_on_vis
207 #----- simple images -----
209 proc setimage {image} {
210 .i configure -image $image
213 #----- subwindow -----
215 variable subwindow_on_destroying
216 variable subwindow_on_ready
220 variable deforient horizontal
221 variable border_colour darkblue
222 variable border_width 1
224 proc subwindow-need-recreate {} {
225 variable innerwindow_after
227 if {[info exists innerwindow_after]} return
228 set innerwindow_after [after idle applet::innerwindow-resetup]
231 proc innerwindow-resetup {} {
232 variable innerwindow_after
233 variable subwindow_on_destroying
234 variable subwindow_on_ready
235 variable border_colour
236 variable border_width
238 unset innerwindow_after
242 if {![winfo exists .i.i]} return
243 destroy [frame .i.i.make-exist]
245 uplevel #0 $subwindow_on_destroying
246 catch { destroy .i.i.b }
248 set orientation [.i orientation]
249 debug "orientation $orientation"
250 if {![string compare $orientation unknown]} {
251 set orientation $deforient
253 .i configure -image applet::innerwindow-ph-$orientation
255 frame .i.i.b -background $border_colour -bd $border_width
256 pack .i.i.b -fill both -side left -expand 1
258 uplevel #0 $subwindow_on_ready [list $orientation]
261 proc setup-subwindow {on_destroying on_ready} {
265 foreach v {on_destroying on_ready} {
266 variable subwindow_$v [set $v]
269 image create photo applet::innerwindow-ph-horizontal -width $w -height 2
270 image create photo applet::innerwindow-ph-vertical -width 2 -height $h
271 .i configure -image applet::innerwindow-ph-horizontal
273 destroy [frame .i.make-exist]
274 destroy [frame .i.i.make-exist]
275 bind .i <<IconConfigure>> {
276 applet::subwindow-need-recreate
280 #----- subprocess -----
282 variable subproc none
283 variable ratelimit {}
285 proc setup-subproc {get_cmdline} {
286 variable subproc_get_cmdline $get_cmdline
287 setup-subwindow applet::subproc-destroying applet::subproc-ready
290 proc subproc-destroying {} {
292 debug "DESTROYING $subproc"
294 catch { destroy .i.i.b.c }
296 switch -exact $subproc {
299 default { kill $subproc; set subproc old }
303 proc subproc-ready {orientation} {
305 variable subproc_orientation $orientation
306 debug "READY $subproc"
308 frame .i.i.b.c -container 1 -background orange
309 pack .i.i.b.c -fill both -side left -expand 1
311 switch -exact $subproc {
319 error "unexpected state $subproc"
322 debug "READY-done $subproc"
328 variable subproc_get_cmdline
329 variable subproc_orientation
331 set id [winfo id .i.i.b.c]
332 set cmd [uplevel #0 $subproc_get_cmdline [list $id $subproc_orientation]]
334 debug "RUN-CHILD $subproc"
335 set now [clock seconds]
336 lappend ratelimit $now
337 while {[lindex $ratelimit 0] < {$now - 10}} {
338 set ratelimit [lrange $ratelimit 1 end]
340 if {[llength $ratelimit] > 10} {
341 puts stderr "crashing repeatedly, quitting $ratelimit"
346 set subproc [subproc::fork applet::child-died {
347 execl [lindex $cmd 0] [lrange $cmd 1 end]
349 debug "FORKED $subproc"
352 proc child-died {how how2} {
353 debug "DIED $how $how2"
355 switch -exact $subproc {
362 subwindow-need-recreate