X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=example;h=2d07e86d135c6cb5a952452febc8c9f1af4c86e0;hb=2e355f70ace81b18ef77f3fdc45f347326165c08;hp=457d75d3aeb8fbc30eae101a44597ba446d588fb;hpb=208895273cfa7904e09251ee19495b0c0d1ff5e8;p=chiark-tcl-applet.git diff --git a/example b/example index 457d75d..2d07e86 100755 --- a/example +++ b/example @@ -1,108 +1,33 @@ -#!/usr/bin/wish8.4 +#!/usr/bin/wish8.4 -f +# -*- Tcl -*- -#----- general machinery ----- +# usage: +# xbatmon-simple-tray -package require tktray +source applet.tcl +source subproc.tcl +source utils.tcl -wm withdraw . - -tktray::icon .i -class example -.i configure -docked 1 - -set posted 0 +set debug::debug puts foreach b {1 3} { - menu .m$b -tearoff 0 -} - -proc pressed {b x y} { - global posted - tooltip_cancel - if {$posted == $b} { - puts "unpost $posted toggle" - .m$posted unpost - set posted 0 - } elseif {[winfo exists .m$b]} { - if {$posted} { - .m$posted unpost - puts "unpost $posted other" - } - puts "post $b" - set posted $b - .m$b post $x $y - } -} - -proc msel {} { - global posted - set posted 0 -} - -bind .i { pressed %b %X %Y } - -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] -} - -proc tooltip_cancel {} { - global tooltip_after - catch { after cancel $tooltip_after } - catch { unset $tooltip_after } - wm withdraw .tt + applet::setup-button-menu $b } -set tooltip_inwindow 0 +.m1 add command -command { applet::msel; puts hi } -label hi +.m3 add command -command { applet::msel; puts boo } -label boo -proc tooltip_enter {state x y} { - global tooltip_inwindow - set tooltip_inwindow 1 - tooltip_starttimer $state $x $y -} - -proc tooltip_leave {} { - global tooltip_inwindow - set tooltip_inwindow 0 - tooltip_cancel -} +#image create bitmap ims -file gs_s.xbm +#image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm +#setimage ims +#setimage ims -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 settooltip {s} { - .tt.t configure -text $s -} +applet::setup-tooltip { puts VIS } { puts INVIS } +applet::tooltip-set "line\nanother" -proc tooltip_show {x y} { - incr x 9 - incr y 9 - wm geometry .tt +$x+$y - wm deiconify .tt +proc cmdline {id orientation} { + global argv + return [concat $argv $id] } -proc setimage {image} { - .i configure -image $image -} - -#----- specifics ----- - -.m1 add command -command { msel; puts hi } -label hi -.m3 add command -command { msel; puts boo } -label boo - -image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm -setimage ims - -setuptooltip -settooltip "line\nanother" +applet::setup-subproc cmdline