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 \
60 # WIDTH HEIGHT DEFAULT-ORIENTATION BORDER-COLOUR BORDER-WIDTH \
61 # ON-DESTROYING ON-READY
62 # Then the main code will call ON-DESTROYING just before
63 # destroying the inner window and recreating it, and
64 # [concat ON-READY [list ORIENTATION]]
65 # just after. The inner window to use is called .i.i.b.
67 # The user of the subwindow machinery may call
68 # applet::subwindow-need-recreate
69 # if for any reason the inner window should be destroyed and recreated.
71 # Alternatively, it may request that a subprocess be spawned
72 # repeatedly with the xid of a suitable window.
73 # applet::setup-subproc \
74 # WIDTH HEIGHT DEFAULT-ORIENTATION BORDER-COLOUR BORDER-WIDTH \
76 # Then the main code will call [concat GET_CMDLINE [list XID ORIENTATION]]
77 # to get the command line to run.
81 tktray::icon .i -class example
82 .i configure -docked 1
84 fconfigure stdout -buffering none
85 fconfigure stderr -buffering none
88 namespace eval applet {
94 if {![llength $debug]} return
95 uplevel #0 $debug [list $m]
98 proc setup-debug {d} {
102 # used by both menus and tooltips
107 proc setup-button-menu {b} {
108 bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
112 proc menubuttonpressed {b x y} {
116 debug "unpost $posted toggle"
119 } elseif {[winfo exists .m$b]} {
122 debug "unpost $posted other"
135 #----- tooltips -----
137 variable tooltip_on_vis {}
138 variable tooltip_on_invis {}
140 proc tooltip-starttimer {state x y} {
141 variable tooltip_after
143 variable tooltip_inwindow
144 if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
145 catch { after cancel $tooltip_after }
146 set tooltip_after [after 500 applet::tooltip-show $x $y]
149 proc tooltip-cancel {} {
150 variable tooltip_after
151 variable tooltip_on_invis
152 catch { after cancel $tooltip_after }
153 catch { unset $tooltip_after }
155 uplevel #0 $tooltip_on_invis
158 set tooltip_inwindow 0
160 proc tooltip-enter {state x y} {
161 variable tooltip_inwindow
162 set tooltip_inwindow 1
163 tooltip-starttimer $state $x $y
166 proc tooltip-leave {} {
167 variable tooltip_inwindow
168 set tooltip_inwindow 0
172 proc setup-tooltip {on_vis on_invis} {
173 foreach v {vis invis} {
174 variable tooltip_on_$v [set on_$v]
176 bind .i <Enter> { applet::tooltip-enter %s %X %Y }
177 bind .i <Leave> { applet::tooltip-leave }
178 bind .i <ButtonRelease> {
179 applet::tooltip-cancel
180 applet::tooltip-starttimer %s %X %Y
182 bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
183 toplevel .tt -background black
185 wm overrideredirect .tt 1
186 label .tt.t -justify left -background {#EEE1B3}
187 pack .tt.t -padx 1 -pady 1
191 proc tooltip-set {s} {
192 .tt.t configure -text $s
195 proc tooltip-show {x y} {
196 variable tooltip_on_vis
199 wm geometry .tt +$x+$y
201 uplevel #0 $tooltip_on_vis
204 #----- simple images -----
206 proc setimage {image} {
207 .i configure -image $image
210 #----- subwindow -----
212 variable subwindow_on_destroying
213 variable subwindow_on_ready
215 proc subwindow-need-recreate {} {
216 variable innerwindow_after
218 if {[info exists innerwindow_after]} return
219 set innerwindow_after [after idle applet::innerwindow-resetup]
222 proc innerwindow-resetup {} {
223 variable innerwindow_after
224 variable subwindow_on_destroying
225 variable subwindow_on_ready
226 variable subwindow_border_colour
227 variable subwindow_border_width
228 variable subwindow_default_orientation
229 unset innerwindow_after
233 if {![winfo exists .i.i]} return
234 destroy [frame .i.i.make-exist]
236 uplevel #0 $subwindow_on_destroying
237 catch { destroy .i.i.b }
239 set orientation [.i orientation]
240 debug "orientation $orientation"
241 if {![string compare $orientation unknown]} {
242 set orientation $subwindow_default_orientation
244 .i configure -image applet::innerwindow-ph-$orientation
246 frame .i.i.b -background darkblue -bd 1
247 pack .i.i.b -fill both -side left -expand 1
249 uplevel #0 $subwindow_on_ready [list $orientation]
252 proc setup-subwindow {
253 w h default_orientation border_colour border_width on_destroying on_ready
256 default_orientation border_width border_colour on_destroying on_ready
258 variable subwindow_$v [set $v]
261 image create photo applet::innerwindow-ph-horizontal -width $w -height 2
262 image create photo applet::innerwindow-ph-vertical -width 2 -height $h
263 .i configure -image applet::innerwindow-ph-horizontal
265 destroy [frame .i.make-exist]
266 destroy [frame .i.i.make-exist]
267 bind .i <<IconConfigure>> {
268 applet::subwindow-need-recreate
272 #----- subprocess -----
274 variable subproc none
275 variable ratelimit {}
277 proc setup-subproc {w h deforient border_colour border_width get_cmdline} {
278 variable subproc_get_cmdline $get_cmdline
279 setup-subwindow $w $h $deforient $border_colour $border_width \
280 applet::subproc-destroying applet::subproc-ready
283 proc subproc-destroying {} {
285 debug "DESTROYING $subproc"
287 catch { destroy .i.i.b.c }
289 switch -exact $subproc {
292 default { kill $subproc; set subproc old }
296 proc subproc-ready {orientation} {
298 variable subproc_orientation $orientation
299 debug "READY $subproc"
301 frame .i.i.b.c -container 1 -background orange
302 pack .i.i.b.c -fill both -side left -expand 1
304 switch -exact $subproc {
312 error "unexpected state $subproc"
315 debug "READY-done $subproc"
321 variable subproc_get_cmdline
322 variable subproc_orientation
324 set id [winfo id .i.i.b.c]
325 set cmd [uplevel #0 $subproc_get_cmdline [list $id $subproc_orientation]]
327 debug "RUN-CHILD $subproc"
328 set now [clock seconds]
329 lappend ratelimit $now
330 while {[lindex $ratelimit 0] < {$now - 10}} {
331 set ratelimit [lrange $ratelimit 1 end]
333 if {[llength $ratelimit] > 10} {
334 debug stderr "crashing repeatedly, quitting $ratelimit"
339 set subproc [subproc::fork applet::child-died {
340 execl [lindex $cmd 0] [lrange $cmd 1 end]
342 debug "FORKED $subproc"
345 proc child-died {how how2} {
346 debug "DIED $how $how2"
348 switch -exact $subproc {
355 subwindow-need-recreate