applet.tcl

   1
   2 #----- general machinery -----
   3
   4 # Interface:
   5 #
   6 #  tk::tktray widget is called .i
   7 #
   8 # Inner window:
   9 #  Caller that needs access to inner window should define
  10 #     proc innerwindow {} { ... }
  11 #  and run
  12 #     innerwindow
  13 #  This will create
  14 #     .i.i.b      frame to contain container
  15 #     .i.i.b.c    actual container
  16 #
  17 #  Button presses
  18 #    Caller should provide
  19 #       proc pressed {b x y} { ... }
  20 #    which should examine b and do something appropriate.
  21 #
  22
  23
  24
  25 package require tktray
  26 #load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so
  27
  28
  29 wm withdraw .
  30
  31 tktray::icon .i -class example
  32 .i configure -docked 1
  33
  34 set posted 0
  35
  36 foreach b {1 3} {
  37     menu .m$b -tearoff 0
  38 }
  39
  40 proc menubuttonpressed {b x y} {
  41     global posted
  42     tooltip_cancel
  43     if {$posted == $b} {
  44         puts "unpost $posted toggle"
  45         .m$posted unpost
  46         set posted 0
  47     } elseif {[winfo exists .m$b]} {
  48         if {$posted} {
  49             .m$posted unpost
  50             puts "unpost $posted other"
  51         }
  52         puts "post $b"
  53         set posted $b
  54         .m$b post $x $y
  55     }
  56 }
  57
  58 proc msel {} {
  59     global posted
  60     set posted 0
  61 }
  62
  63 proc innerwindow-event {why} {
  64     global innerwindow_after
  65 puts "IW-EVENT $why"
  66     if {[info exists innerwindow_after]} return
  67     set innerwindow_after [after idle innerwindow-resetup]
  68 }
  69
  70 proc innerwindow-resetup {} {
  71     global innerwindow_after
  72     unset innerwindow_after
  73
  74 puts RESETUP
  75
  76     catch { destroy .i.i.c }
  77     if {![winfo exists .i.i]} return
  78     destroy [frame .i.i.make-exist]
  79     catch { destroy .i.i.b.c }
  80     catch { destroy .i.i.b }
  81     frame .i.i.b
  82     pack .i.i.b -fill both -side left -expand 1
  83     frame .i.i.b.c -container 1 -background orange
  84     pack .i.i.b.c -fill both -side left -expand 1
  85     bind .i.i <ButtonPress> { pressed %b %X %Y }
  86 #
  87     global inner_lastw inner_lasth
  88     #set w [winfo width .i.i]
  89 #    set w [winfo width .i.i]
  90 #    set h [winfo height .i.i]
  91
  92 #    if {$w != $inner_lastw || $h != $inner_lasth} {
  93 #       set inner_lastw $w
  94 #       set inner_lasth $h
  95 #       innerwindow-ph-dummy configure -width $w -height 2
  96         innerwindow [winfo id .i.i.b.c]
  97 #    }
  98 }
  99
 100 proc setupinnerwindow {w} {
 101     global inner_lastw inner_lasth
 102     set inner_lastw -2
 103     set inner_lasth -2
 104
 105     image create photo innerwindow-ph-dummy -width $w -height 2
 106     .i configure -image innerwindow-ph-dummy
 107
 108     destroy [frame .i.make-exist]
 109     destroy [frame .i.i.make-exist]
 110     bind .i <<IconConfigure>> { innerwindow-event "%w" }
 111 }
 112
 113 bind .i <ButtonPress> { pressed %b %X %Y }
 114
 115 proc tooltip_starttimer {state x y} {
 116     global tooltip_after posted tooltip_inwindow
 117     if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
 118     catch { after cancel $tooltip_after }
 119     set tooltip_after [after 500 tooltip_show $x $y]
 120 }
 121
 122 proc tooltip_cancel {} {
 123     global tooltip_after
 124     catch { after cancel $tooltip_after }
 125     catch { unset $tooltip_after }
 126     wm withdraw .tt
 127 }
 128
 129 set tooltip_inwindow 0
 130
 131 proc tooltip_enter {state x y} {
 132     global tooltip_inwindow
 133     set tooltip_inwindow 1
 134     tooltip_starttimer $state $x $y
 135 }
 136
 137 proc tooltip_leave {} {
 138     global tooltip_inwindow
 139     set tooltip_inwindow 0
 140     tooltip_cancel
 141 }
 142
 143 proc setuptooltip {} {
 144     bind .i <Enter> { tooltip_enter %s %X %Y }
 145     bind .i <Leave> { tooltip_leave }
 146     bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
 147     bind .i <Motion> { tooltip_starttimer %s %X %Y }
 148     toplevel .tt -background black
 149     wm withdraw .tt
 150     wm overrideredirect .tt 1
 151     label .tt.t -justify left -background {#EEE1B3}
 152     pack .tt.t -padx 1 -pady 1
 153     settooltip {}
 154 }
 155
 156 proc settooltip {s} {
 157     .tt.t configure -text $s
 158 }
 159
 160 proc tooltip_show {x y} {
 161     incr x 9
 162     incr y 9
 163     wm geometry .tt +$x+$y
 164     wm deiconify .tt
 165 }
 166
 167 proc setimage {image} {
 168     .i configure -image $image
 169 }