1 # General purpose code for being a tray applet
6 #----- general machinery -----
10 # tk::tktray widget is called .i
15 # applet::setup-tooltip ON-VISIBLE ON-INVISIBLE
16 # to make applet have a tooltip.
18 # ON-VISIBLE and ON-INVISIBLE will be globally eval'd
19 # when the tooltip becomes visible and invisible.
22 # applet::tooltip-set TEXT-MAYBE-MULTILINE
27 # Caller may bind .i.i <ButtonPress-$b>
29 # Alternatively caller may call applet::setup-button-menu $b
30 # which will generate a menu .m$b which the user can configure
31 # and which will automatically be posted and unposted etc.
32 # In this case the caller should arrange that all of their
33 # menus, when an item is selected, call
39 # applet::setimage IMAGE
42 # Alternatively of icon, it may provide other arrangements for
43 # using the provided subwindow. Such a caller should call
44 # applet::setup-subwindow ON-DESTROYING ON-READY
45 # Then the main code will call ON-DESTROYING just before
46 # destroying the inner window and recreating it, and
47 # [concat ON-READY [list ORIENTATION]]
48 # just after. The inner window to use is called .i.i.b.
50 # This uses variables, in the applet namespace,
51 # w h border_colour border_width deforient
52 # These should be set before setup-subwindow is called and not
53 # modified thereafter.
55 # The user of the subwindow machinery may call
56 # applet::subwindow-need-recreate
57 # if for any reason the inner window should be destroyed and recreated.
59 # Alternatively, it may request that a subprocess be spawned
60 # repeatedly with the xid of a suitable window.
61 # applet::setup-subproc GET-CMDLINE
62 # Then the main code will call [concat GET_CMDLINE [list XID ORIENTATION]]
63 # to get the command line to run.
65 # This also uses the same variables as setup-subwindow.
69 tktray::icon .i -class example
70 .i configure -docked 1
72 fconfigure stdout -buffering none
73 fconfigure stderr -buffering none
76 namespace eval applet {
78 # used by both menus and tooltips
83 proc setup-button-menu {b} {
84 bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
88 proc menubuttonpressed {b x y} {
92 debug::debug "unpost $posted toggle"
95 } elseif {[winfo exists .m$b]} {
98 debug::debug "unpost $posted other"
100 debug::debug "post $b"
111 #----- tooltips -----
113 variable tooltip_on_vis {}
114 variable tooltip_on_invis {}
116 proc tooltip-starttimer {state x y} {
117 variable tooltip_after
119 variable tooltip_inwindow
120 if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
121 catch { after cancel $tooltip_after }
122 set tooltip_after [after 500 applet::tooltip-show $x $y]
125 proc tooltip-cancel {} {
126 variable tooltip_after
127 variable tooltip_on_invis
128 catch { after cancel $tooltip_after }
129 catch { unset $tooltip_after }
131 uplevel #0 $tooltip_on_invis
134 set tooltip_inwindow 0
136 proc tooltip-enter {state x y} {
137 variable tooltip_inwindow
138 set tooltip_inwindow 1
139 tooltip-starttimer $state $x $y
142 proc tooltip-leave {} {
143 variable tooltip_inwindow
144 set tooltip_inwindow 0
148 proc setup-tooltip {on_vis on_invis} {
149 foreach v {vis invis} {
150 variable tooltip_on_$v [set on_$v]
152 bind .i <Enter> { applet::tooltip-enter %s %X %Y }
153 bind .i <Leave> { applet::tooltip-leave }
154 bind .i <ButtonRelease> {
155 applet::tooltip-cancel
156 applet::tooltip-starttimer %s %X %Y
158 bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
159 toplevel .tt -background black
161 wm overrideredirect .tt 1
162 label .tt.t -justify left -background {#EEE1B3}
163 pack .tt.t -padx 1 -pady 1
167 proc tooltip-set {s} {
168 .tt.t configure -text $s
171 proc tooltip-show {x y} {
172 variable tooltip_on_vis
175 wm geometry .tt +$x+$y
177 uplevel #0 $tooltip_on_vis
180 #----- simple images -----
182 proc setimage {image} {
183 .i configure -image $image
186 #----- subwindow -----
188 variable subwindow_on_destroying
189 variable subwindow_on_ready
193 variable deforient horizontal
194 variable border_colour darkblue
195 variable border_width 1
197 proc subwindow-need-recreate {} {
198 variable innerwindow_after
199 debug::debug "IW-EVENT"
200 if {[info exists innerwindow_after]} return
201 set innerwindow_after [after idle applet::innerwindow-resetup]
204 proc innerwindow-resetup {} {
205 variable innerwindow_after
206 variable subwindow_on_destroying
207 variable subwindow_on_ready
208 variable border_colour
209 variable border_width
211 unset innerwindow_after
215 if {![winfo exists .i.i]} return
216 destroy [frame .i.i.make-exist]
218 uplevel #0 $subwindow_on_destroying
219 catch { destroy .i.i.b }
221 set orientation [.i orientation]
222 debug::debug "orientation $orientation"
223 if {![string compare $orientation unknown]} {
224 set orientation $deforient
226 .i configure -image applet::innerwindow-ph-$orientation
228 frame .i.i.b -background $border_colour -bd $border_width
229 pack .i.i.b -fill both -side left -expand 1
231 uplevel #0 $subwindow_on_ready [list $orientation]
234 proc setup-subwindow {on_destroying on_ready} {
238 foreach v {on_destroying on_ready} {
239 variable subwindow_$v [set $v]
242 image create photo applet::innerwindow-ph-horizontal -width $w -height 2
243 image create photo applet::innerwindow-ph-vertical -width 2 -height $h
244 .i configure -image applet::innerwindow-ph-horizontal
246 destroy [frame .i.make-exist]
247 destroy [frame .i.i.make-exist]
248 bind .i <<IconConfigure>> {
249 applet::subwindow-need-recreate
253 #----- subprocess -----
255 variable subproc none
256 variable ratelimit {}
258 proc setup-subproc {get_cmdline} {
259 variable subproc_get_cmdline $get_cmdline
260 setup-subwindow applet::subproc-destroying applet::subproc-ready
263 proc subproc-destroying {} {
265 debug::debug "DESTROYING $subproc"
267 catch { destroy .i.i.b.c }
269 switch -exact $subproc {
272 default { kill $subproc; set subproc old }
276 proc subproc-ready {orientation} {
278 variable subproc_orientation $orientation
279 debug::debug "READY $subproc"
281 frame .i.i.b.c -container 1 -background orange
282 pack .i.i.b.c -fill both -side left -expand 1
284 switch -exact $subproc {
292 error "unexpected state $subproc"
295 debug::debug "READY-done $subproc"
301 variable subproc_get_cmdline
302 variable subproc_orientation
304 set id [winfo id .i.i.b.c]
305 set cmd [uplevel #0 $subproc_get_cmdline [list $id $subproc_orientation]]
307 debug::debug "RUN-CHILD $subproc"
308 set now [clock seconds]
309 lappend ratelimit $now
310 while {[lindex $ratelimit 0] < {$now - 10}} {
311 set ratelimit [lrange $ratelimit 1 end]
313 if {[llength $ratelimit] > 10} {
314 puts stderr "crashing repeatedly, quitting $ratelimit"
319 set subproc [subproc::fork applet::child-died {
320 execl [lindex $cmd 0] [lrange $cmd 1 end]
322 debug::debug "FORKED $subproc"
325 proc child-died {how how2} {
326 debug::debug "DIED $how $how2"
328 switch -exact $subproc {
335 subwindow-need-recreate