X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=applet.tcl;h=04d5813bebc6042d481fb2b3941333a0e766119a;hp=1a75f1419dd406f4348d08a235c31f40d8302057;hb=3b3dad48b2bd8f43a76cf3633e0bf2ca6e6ef14d;hpb=4a30ace4afa266ebcda72e88c96c611ad33feaae diff --git a/applet.tcl b/applet.tcl index 1a75f14..04d5813 100644 --- a/applet.tcl +++ b/applet.tcl @@ -1,3 +1,15 @@ +# General purpose code for being a tray applet + +proc manyset {list args} { + foreach val $list var $args { + upvar 1 $var my + set my $val + } +} + + +package require Tclx +package require tktray #----- general machinery ----- @@ -5,41 +17,84 @@ # # tk::tktray widget is called .i # -# Inner window: -# Caller that needs access to inner window should define +# Tooltip: +# +# Caller may call +# applet::setup-tooltip ON-VISIBLE ON-INVISIBLE +# to make applet have a tooltip. +# +# ON-VISIBLE and ON-INVISIBLE will be globally eval'd +# when the tooltip becomes visible and invisible. +# +# Caller should call +# applet::tooltip-set TEXT-MAYBE-MULTILINE +# whenever they like. +# +# Button presses +# +# Caller may bind .i.i +# +# Alternatively caller may call applet::setup-button-menu $b +# which will generate a menu .m$b which the user can configure +# and which will automatically be posted and unposted etc. +# In this case the caller should arrange that all of their +# menus, when an item is selected, call +# applet::msel +# +# Icon: +# +# Caller should call: +# applet::setimage IMAGE +# as necessary. +# +# Alternatively, instead of icon, it may make other arrangements +# to use the provided subwindow +# +# Caller that needs access to inner window should call +# applet::setup-subwindow WIDTH ON-DESTROYING ON-READY +# Then the main code will call ON-DESTROYING just before +# destroying the inner window and recreating it, and ON-READY +# just after. In ON-READY the inner window is called .i.i. +# +# The user of the subwindow machinery may call +# applet::subwindow-need-recreate +# if for any reason the inner window should be destroyed and recreated. +# +# Alternatively, +# to run (repeatedly +# if necessary) a subprocess. +# # proc innerwindow {} { ... } # and run # innerwindow # This will create # .i.i.b frame to contain container # .i.i.b.c actual container -# -# Button presses -# Caller should provide -# proc pressed {b x y} { ... } -# which should examine b and do something appropriate. -# +wm withdraw . + +tktray::icon .i -class example +.i configure -docked 1 +fconfigure stdout -buffering line -package require tktray -#load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so +namespace eval applet { -wm withdraw . -tktray::icon .i -class example -.i configure -docked 1 +# used by both menus and tooltips +variable posted 0 -set posted 0 +#----- menus ----- -foreach b {1 3} { +proc setup-button-menu {b} { + bind .i.i { applet::menubuttonpressed %b %X %Y } menu .m$b -tearoff 0 } proc menubuttonpressed {b x y} { - global posted - tooltip_cancel + variable posted + tooltip-cancel if {$posted == $b} { puts "unpost $posted toggle" .m$posted unpost @@ -56,33 +111,116 @@ proc menubuttonpressed {b x y} { } proc msel {} { - global posted + variable posted set posted 0 } -proc innerwindow-event {why} { - global innerwindow_after -puts "IW-EVENT $why" +#----- tooltips ----- + +variable tooltip_on_vis {} +variable tooltip_on_invis {} + +proc tooltip-starttimer {state x y} { + variable tooltip_after + variable posted + variable tooltip_inwindow + if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return } + catch { after cancel $tooltip_after } + set tooltip_after [after 500 applet::tooltip-show $x $y] +} + +proc tooltip-cancel {} { + variable tooltip_after + variable tooltip_on_invis + catch { after cancel $tooltip_after } + catch { unset $tooltip_after } + wm withdraw .tt + uplevel #0 $tooltip_on_invis +} + +set tooltip_inwindow 0 + +proc tooltip-enter {state x y} { + variable tooltip_inwindow + set tooltip_inwindow 1 + tooltip-starttimer $state $x $y +} + +proc tooltip-leave {} { + variable tooltip_inwindow + set tooltip_inwindow 0 + tooltip-cancel +} + +proc setup-tooltip {on_vis on_invis} { + foreach v {vis invis} { + variable tooltip_on_$v [set on_$v] + } + bind .i { applet::tooltip-enter %s %X %Y } + bind .i { applet::tooltip-leave } + bind .i { + applet::tooltip-cancel + applet::tooltip-starttimer %s %X %Y + } + bind .i { applet::tooltip-starttimer %s %X %Y } + toplevel .tt -background black + wm withdraw .tt + wm overrideredirect .tt 1 + label .tt.t -justify left -background {#EEE1B3} + pack .tt.t -padx 1 -pady 1 + tooltip-set {} +} + +proc tooltip-set {s} { + .tt.t configure -text $s +} + +proc tooltip-show {x y} { + variable tooltip_on_vis + incr x 9 + incr y 9 + wm geometry .tt +$x+$y + wm deiconify .tt + uplevel #0 $tooltip_on_vis +} + +#----- simple images ----- + +proc setimage {image} { + .i configure -image $image +} + +#----- subwindow ----- + +variable subwindow_on_destroying +variable subwindow_on_ready + +proc subwindow-need-recreate {} { + variable innerwindow_after +puts "IW-EVENT" if {[info exists innerwindow_after]} return - set innerwindow_after [after idle innerwindow-resetup] + set innerwindow_after [after idle applet::innerwindow-resetup] } proc innerwindow-resetup {} { - global innerwindow_after + variable innerwindow_after + variable subwindow_on_destroying + variable subwindow_on_ready unset innerwindow_after puts RESETUP - catch { destroy .i.i.c } + if {![winfo exists .i.i]} return destroy [frame .i.i.make-exist] + + uplevel #0 $subwindow_on_destroying catch { destroy .i.i.b.c } + catch { destroy .i.i.b } + frame .i.i.b pack .i.i.b -fill both -side left -expand 1 - frame .i.i.b.c -container 1 -background orange - pack .i.i.b.c -fill both -side left -expand 1 - bind .i.i { pressed %b %X %Y } # global inner_lastw inner_lasth #set w [winfo width .i.i] @@ -93,77 +231,110 @@ puts RESETUP # set inner_lastw $w # set inner_lasth $h # innerwindow-ph-dummy configure -width $w -height 2 - innerwindow [winfo id .i.i.b.c] + + uplevel #0 $subwindow_on_ready # } } -proc setupinnerwindow {w} { +proc setup-subwindow {w on_destroying on_ready} { + foreach v {destroying ready} { + variable subwindow_on_$v [set on_$v] + } + global inner_lastw inner_lasth set inner_lastw -2 set inner_lasth -2 - image create photo innerwindow-ph-dummy -width $w -height 2 - .i configure -image innerwindow-ph-dummy + image create photo applet::innerwindow-ph-dummy -width $w -height 2 + .i configure -image applet::innerwindow-ph-dummy destroy [frame .i.make-exist] destroy [frame .i.i.make-exist] - bind .i <> { innerwindow-event "%w" } + bind .i <> { + applet::subwindow-need-recreate + } } -bind .i { pressed %b %X %Y } +#----- subprocess ----- -proc tooltip_starttimer {state x y} { - global tooltip_after posted tooltip_inwindow - if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return } - catch { after cancel $tooltip_after } - set tooltip_after [after 500 tooltip_show $x $y] +variable subproc none +variable ratelimit {} + +proc setup-subproc {w get_cmdline} { + variable subproc_get_cmdline $get_cmdline + setup-subwindow $w applet::subproc-destroying applet::subproc-ready } -proc tooltip_cancel {} { - global tooltip_after - catch { after cancel $tooltip_after } - catch { unset $tooltip_after } - wm withdraw .tt +proc subproc-destroying {} { + variable subproc + puts "DESTROYING $subproc" + switch -exact $subproc { + none { } + old { } + default { kill $subproc; set subproc old } + } } -set tooltip_inwindow 0 +proc subproc-ready {} { + variable subproc + puts "READY $subproc" -proc tooltip_enter {state x y} { - global tooltip_inwindow - set tooltip_inwindow 1 - tooltip_starttimer $state $x $y -} + frame .i.i.b.c -container 1 -background orange + pack .i.i.b.c -fill both -side left -expand 1 -proc tooltip_leave {} { - global tooltip_inwindow - set tooltip_inwindow 0 - tooltip_cancel + switch -exact $subproc { + none { + run-child + } + old { + # wait for it to die + } + default { + error "unexpected state $subproc" + } + } + puts "READY-done $subproc" } -proc setuptooltip {} { - bind .i { tooltip_enter %s %X %Y } - bind .i { tooltip_leave } - bind .i { tooltip_cancel; tooltip_starttimer %s %X %Y } - bind .i { tooltip_starttimer %s %X %Y } - toplevel .tt -background black - wm withdraw .tt - wm overrideredirect .tt 1 - label .tt.t -justify left -background {#EEE1B3} - pack .tt.t -padx 1 -pady 1 - settooltip {} -} +proc run-child {} { + variable subproc + variable ratelimit + variable subproc_get_cmdline -proc settooltip {s} { - .tt.t configure -text $s + set id [winfo id .i.i.b.c] + set cmd [uplevel #0 [concat [list $subproc_get_cmdline] $id]] + + puts "RUN-CHILD $subproc" + set now [clock seconds] + lappend ratelimit $now + while {[lindex $ratelimit 0] < {$now - 10}} { + set ratelimit [lrange $ratelimit 1 end] + } + if {[llength $ratelimit] > 10} { + puts stderr "crashing repeatedly, quitting $ratelimit" + exit 127 + } + + set subproc none + set subproc [subproc::fork applet::child-died { + execl [lindex $cmd 0] [lrange $cmd 1 end] + }] + puts "FORKED $subproc" } -proc tooltip_show {x y} { - incr x 9 - incr y 9 - wm geometry .tt +$x+$y - wm deiconify .tt +proc child-died {how how2} { + puts "DIED $how $how2" + variable subproc + switch -exact $subproc { + old { + set subproc none + run-child + } + default { + set subproc none + subwindow-need-recreate + } + } } -proc setimage {image} { - .i configure -image $image }