From 0349c2ee7dd8de362873aa14e63aa4e8f91b5009 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Mon, 16 Jan 2012 02:25:30 +0000 Subject: [PATCH] split up --- applet.tcl | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ example | 96 +----------------------------------------------------- 2 files changed, 97 insertions(+), 95 deletions(-) create mode 100644 applet.tcl diff --git a/applet.tcl b/applet.tcl new file mode 100644 index 0000000..0b0fcf6 --- /dev/null +++ b/applet.tcl @@ -0,0 +1,96 @@ + +#----- general machinery ----- + +package require tktray + +wm withdraw . + +tktray::icon .i -class example +.i configure -docked 1 + +set posted 0 + +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 +} + +set tooltip_inwindow 0 + +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 +} + +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 +} diff --git a/example b/example index 457d75d..57e8708 100755 --- a/example +++ b/example @@ -1,100 +1,6 @@ #!/usr/bin/wish8.4 -#----- general machinery ----- - -package require tktray - -wm withdraw . - -tktray::icon .i -class example -.i configure -docked 1 - -set posted 0 - -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 -} - -set tooltip_inwindow 0 - -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 -} - -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 -} +source applet.tcl #----- specifics ----- -- 2.30.2