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 WIDTH BORDER-COLOUR BORDER-WIDTH \
60 # ON-DESTROYING ON-READY
61 # Then the main code will call ON-DESTROYING just before
62 # destroying the inner window and recreating it, and ON-READY
63 # just after. The inner window to use is called .i.i.b.
65 # The user of the subwindow machinery may call
66 # applet::subwindow-need-recreate
67 # if for any reason the inner window should be destroyed and recreated.
69 # Alternatively, it may request that a subprocess be spawned
70 # repeatedly with the xid of a suitable window.
71 # applet::setup-subproc WIDTH BORDER-COLOUR BORDER-WIDTH \
73 # Then the main code will call [concat GET_CMDLINE [list XID]]
74 # to get the command line to run.
78 tktray::icon .i -class example
79 .i configure -docked 1
81 fconfigure stdout -buffering none
82 fconfigure stderr -buffering none
85 namespace eval applet {
91 if {![llength debug]} return
92 uplevel #0 $debug [list $m]
95 proc setup-debug {d} {
99 # used by both menus and tooltips
104 proc setup-button-menu {b} {
105 bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
109 proc menubuttonpressed {b x y} {
113 debug "unpost $posted toggle"
116 } elseif {[winfo exists .m$b]} {
119 debug "unpost $posted other"
132 #----- tooltips -----
134 variable tooltip_on_vis {}
135 variable tooltip_on_invis {}
137 proc tooltip-starttimer {state x y} {
138 variable tooltip_after
140 variable tooltip_inwindow
141 if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
142 catch { after cancel $tooltip_after }
143 set tooltip_after [after 500 applet::tooltip-show $x $y]
146 proc tooltip-cancel {} {
147 variable tooltip_after
148 variable tooltip_on_invis
149 catch { after cancel $tooltip_after }
150 catch { unset $tooltip_after }
152 uplevel #0 $tooltip_on_invis
155 set tooltip_inwindow 0
157 proc tooltip-enter {state x y} {
158 variable tooltip_inwindow
159 set tooltip_inwindow 1
160 tooltip-starttimer $state $x $y
163 proc tooltip-leave {} {
164 variable tooltip_inwindow
165 set tooltip_inwindow 0
169 proc setup-tooltip {on_vis on_invis} {
170 foreach v {vis invis} {
171 variable tooltip_on_$v [set on_$v]
173 bind .i <Enter> { applet::tooltip-enter %s %X %Y }
174 bind .i <Leave> { applet::tooltip-leave }
175 bind .i <ButtonRelease> {
176 applet::tooltip-cancel
177 applet::tooltip-starttimer %s %X %Y
179 bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
180 toplevel .tt -background black
182 wm overrideredirect .tt 1
183 label .tt.t -justify left -background {#EEE1B3}
184 pack .tt.t -padx 1 -pady 1
188 proc tooltip-set {s} {
189 .tt.t configure -text $s
192 proc tooltip-show {x y} {
193 variable tooltip_on_vis
196 wm geometry .tt +$x+$y
198 uplevel #0 $tooltip_on_vis
201 #----- simple images -----
203 proc setimage {image} {
204 .i configure -image $image
207 #----- subwindow -----
209 variable subwindow_on_destroying
210 variable subwindow_on_ready
212 proc subwindow-need-recreate {} {
213 variable innerwindow_after
215 if {[info exists innerwindow_after]} return
216 set innerwindow_after [after idle applet::innerwindow-resetup]
219 proc innerwindow-resetup {} {
220 variable innerwindow_after
221 variable subwindow_on_destroying
222 variable subwindow_on_ready
223 variable subwindow_border_colour
224 variable subwindow_border_width
225 unset innerwindow_after
229 if {![winfo exists .i.i]} return
230 destroy [frame .i.i.make-exist]
232 uplevel #0 $subwindow_on_destroying
233 catch { destroy .i.i.b }
235 frame .i.i.b -background darkblue -bd 1
236 pack .i.i.b -fill both -side left -expand 1
238 uplevel #0 $subwindow_on_ready
241 proc setup-subwindow {w border_colour border_width on_destroying on_ready} {
242 foreach v {border_width border_colour on_destroying on_ready} {
243 variable subwindow_$v [set $v]
246 image create photo applet::innerwindow-ph-dummy -width $w -height 2
247 .i configure -image applet::innerwindow-ph-dummy
249 destroy [frame .i.make-exist]
250 destroy [frame .i.i.make-exist]
251 bind .i <<IconConfigure>> {
252 applet::subwindow-need-recreate
256 #----- subprocess -----
258 variable subproc none
259 variable ratelimit {}
261 proc setup-subproc {w border_colour border_width get_cmdline} {
262 variable subproc_get_cmdline $get_cmdline
263 setup-subwindow $w $border_colour $border_width \
264 applet::subproc-destroying applet::subproc-ready
267 proc subproc-destroying {} {
269 debug "DESTROYING $subproc"
271 catch { destroy .i.i.b.c }
273 switch -exact $subproc {
276 default { kill $subproc; set subproc old }
280 proc subproc-ready {} {
282 debug "READY $subproc"
284 frame .i.i.b.c -container 1 -background orange
285 pack .i.i.b.c -fill both -side left -expand 1
287 switch -exact $subproc {
295 error "unexpected state $subproc"
298 debug "READY-done $subproc"
304 variable subproc_get_cmdline
306 set id [winfo id .i.i.b.c]
307 set cmd [uplevel #0 [concat [list $subproc_get_cmdline] $id]]
309 debug "RUN-CHILD $subproc"
310 set now [clock seconds]
311 lappend ratelimit $now
312 while {[lindex $ratelimit 0] < {$now - 10}} {
313 set ratelimit [lrange $ratelimit 1 end]
315 if {[llength $ratelimit] > 10} {
316 debug stderr "crashing repeatedly, quitting $ratelimit"
321 set subproc [subproc::fork applet::child-died {
322 execl [lindex $cmd 0] [lrange $cmd 1 end]
324 debug "FORKED $subproc"
327 proc child-died {how how2} {
328 debug "DIED $how $how2"
330 switch -exact $subproc {
337 subwindow-need-recreate