applet.tcl

   1 # General purpose code for being a tray applet
   2
   3 proc manyset {list args} {
   4     foreach val $list var $args {
   5         upvar 1 $var my
   6         set my $val
   7     }
   8 }
   9
  10
  11 package require Tclx
  12 package require tktray
  13
  14 #----- general machinery -----
  15
  16 # Interface:
  17 #
  18 #  tk::tktray widget is called .i
  19 #
  20 # Tooltip:
  21 #
  22 #   Caller may call
  23 #      applet::setup-tooltip ON-VISIBLE ON-INVISIBLE
  24 #   to make applet have a tooltip.
  25 #
  26 #   ON-VISIBLE and ON-INVISIBLE will be globally eval'd
  27 #   when the tooltip becomes visible and invisible.
  28 #
  29 #   Caller should call
  30 #      applet::tooltip-set TEXT-MAYBE-MULTILINE
  31 #   whenever they like.
  32 #
  33 # Icon:
  34 #
  35 #  Caller should call:
  36 #      applet::setimage IMAGE
  37 #  as necessary.
  38 #
  39 # Inner window subprocess:
  40 #
  41 #  Caller that needs access to inner window should define
  42 #     proc innerwindow {} { ... }
  43 #  and run
  44 #     innerwindow
  45 #  This will create
  46 #     .i.i.b      frame to contain container
  47 #     .i.i.b.c    actual container
  48 #
  49 #  Button presses
  50 #
  51 #    Caller may bind .i.i <ButtonPress-$b>
  52 #
  53 #    Alternatively caller may call  applet::setup-button-menu $b
  54 #    which will generate a menu .m$b which the user can configure
  55 #    and which will automatically be posted and unposted etc.
  56 #    In this case the caller should arrange that all of their
  57 #    menus, when an item is selected, call
  58 #      applet::msel
  59
  60 wm withdraw .
  61
  62 tktray::icon .i -class example
  63 .i configure -docked 1
  64
  65
  66 namespace eval applet {
  67
  68
  69 # used by both menus and tooltips
  70 variable posted 0
  71
  72 #----- menus -----
  73
  74 proc setup-button-menu {b} {
  75     bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
  76     menu .m$b -tearoff 0
  77 }
  78
  79 proc menubuttonpressed {b x y} {
  80     variable posted
  81     tooltip-cancel
  82     if {$posted == $b} {
  83         puts "unpost $posted toggle"
  84         .m$posted unpost
  85         set posted 0
  86     } elseif {[winfo exists .m$b]} {
  87         if {$posted} {
  88             .m$posted unpost
  89             puts "unpost $posted other"
  90         }
  91         puts "post $b"
  92         set posted $b
  93         .m$b post $x $y
  94     }
  95 }
  96
  97 proc msel {} {
  98     variable posted
  99     set posted 0
 100 }
 101
 102 #----- tooltips -----
 103
 104 variable tooltip_on_vis {}
 105 variable tooltip_on_invis {}
 106
 107 proc tooltip-starttimer {state x y} {
 108     variable tooltip_after
 109     variable posted
 110     variable tooltip_inwindow
 111     if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
 112     catch { after cancel $tooltip_after }
 113     set tooltip_after [after 500 applet::tooltip-show $x $y]
 114 }
 115
 116 proc tooltip-cancel {} {
 117     variable tooltip_after
 118     variable tooltip_on_invis
 119     catch { after cancel $tooltip_after }
 120     catch { unset $tooltip_after }
 121     wm withdraw .tt
 122     uplevel #0 $tooltip_on_invis
 123 }
 124
 125 set tooltip_inwindow 0
 126
 127 proc tooltip-enter {state x y} {
 128     variable tooltip_inwindow
 129     set tooltip_inwindow 1
 130     tooltip-starttimer $state $x $y
 131 }
 132
 133 proc tooltip-leave {} {
 134     variable tooltip_inwindow
 135     set tooltip_inwindow 0
 136     tooltip-cancel
 137 }
 138
 139 proc setup-tooltip {on_vis on_invis} {
 140     foreach v {vis invis} {
 141         variable tooltip_on_$v [set on_$v]
 142     }
 143     bind .i <Enter> { applet::tooltip-enter %s %X %Y }
 144     bind .i <Leave> { applet::tooltip-leave }
 145     bind .i <ButtonRelease> {
 146         applet::tooltip-cancel
 147         applet::tooltip-starttimer %s %X %Y
 148     }
 149     bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
 150     toplevel .tt -background black
 151     wm withdraw .tt
 152     wm overrideredirect .tt 1
 153     label .tt.t -justify left -background {#EEE1B3}
 154     pack .tt.t -padx 1 -pady 1
 155     tooltip-set {}
 156 }
 157
 158 proc tooltip-set {s} {
 159     .tt.t configure -text $s
 160 }
 161
 162 proc tooltip-show {x y} {
 163     variable tooltip_on_vis
 164     incr x 9
 165     incr y 9
 166     wm geometry .tt +$x+$y
 167     wm deiconify .tt
 168     uplevel #0 $tooltip_on_vis
 169 }
 170
 171 #----- simple images -----
 172
 173 proc setimage {image} {
 174     .i configure -image $image
 175 }
 176
 177 }
 178
 179
 180 proc innerwindow-resetup-required {why} {
 181     variable innerwindow_after
 182 puts "IW-EVENT $why"
 183     if {[info exists innerwindow_after]} return
 184     set innerwindow_after [after idle innerwindow-resetup]
 185 }
 186
 187 proc innerwindow-resetup {} {
 188     variable innerwindow_after
 189     unset innerwindow_after
 190
 191 puts RESETUP
 192
 193     innerwindow-destroying
 194
 195     catch { destroy .i.i.c }
 196     if {![winfo exists .i.i]} return
 197     destroy [frame .i.i.make-exist]
 198     catch { destroy .i.i.b.c }
 199     catch { destroy .i.i.b }
 200     frame .i.i.b
 201     pack .i.i.b -fill both -side left -expand 1
 202     frame .i.i.b.c -container 1 -background orange
 203     pack .i.i.b.c -fill both -side left -expand 1
 204 #
 205     global inner_lastw inner_lasth
 206     #set w [winfo width .i.i]
 207 #    set w [winfo width .i.i]
 208 #    set h [winfo height .i.i]
 209
 210 #    if {$w != $inner_lastw || $h != $inner_lasth} {
 211 #       set inner_lastw $w
 212 #       set inner_lasth $h
 213 #       innerwindow-ph-dummy configure -width $w -height 2
 214         innerwindow-ready
 215 #    }
 216 }
 217
 218 proc setupinnerwindow {w} {
 219     global inner_lastw inner_lasth
 220     set inner_lastw -2
 221     set inner_lasth -2
 222
 223     image create photo innerwindow-ph-dummy -width $w -height 2
 224     .i configure -image innerwindow-ph-dummy
 225
 226     destroy [frame .i.make-exist]
 227     destroy [frame .i.i.make-exist]
 228     bind .i <<IconConfigure>> { innerwindow-resetup-required IconConfigure }
 229 }