X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=example;h=0321c6babae35b53ff2af8b6d7d7a17cdd6e46c2;hp=457d75d3aeb8fbc30eae101a44597ba446d588fb;hb=81dfaea18e9a861fda1949e0ebf88d5c878f1b10;hpb=208895273cfa7904e09251ee19495b0c0d1ff5e8 diff --git a/example b/example index 457d75d..0321c6b 100755 --- a/example +++ b/example @@ -1,108 +1,28 @@ -#!/usr/bin/wish8.4 +#!/usr/bin/wish8.4 -f +# -*- Tcl -*- -#----- general machinery ----- +source applet.tcl +source subproc.tcl -package require tktray - -wm withdraw . - -tktray::icon .i -class example -.i configure -docked 1 - -set posted 0 +applet::setup-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] + applet::setup-button-menu $b } -proc tooltip_cancel {} { - global tooltip_after - catch { after cancel $tooltip_after } - catch { unset $tooltip_after } - wm withdraw .tt -} +.m1 add command -command { applet::msel; puts hi } -label hi +.m3 add command -command { applet::msel; puts boo } -label boo -set tooltip_inwindow 0 +#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 tooltip_enter {state x y} { - global tooltip_inwindow - set tooltip_inwindow 1 - tooltip_starttimer $state $x $y -} +applet::setup-tooltip { puts VIS } { puts INVIS } +applet::tooltip-set "line\nanother" -proc tooltip_leave {} { - global tooltip_inwindow - set tooltip_inwindow 0 - tooltip_cancel +proc cmdline {id orientation} { + return [list xacpi-simple -into $id] } -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 -} - -proc tooltip_show {x y} { - incr x 9 - incr y 9 - wm geometry .tt +$x+$y - wm deiconify .tt -} - -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 40 40 horizontal darkblue 1 cmdline