chiark / gitweb /
wip subwindow
[chiark-tcl-applet.git] / 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 # Alternatively, instead of icon, it may arrange to run (repeatedly
40 # if necessary) a subprocess.
41 #
42 #  Caller that needs access to inner window should call
43 #      applet::setup-subwindow WIDTH ON-DESTROYING ON-READY
44 #  Then the main code will call ON-DESTROYING just before
45 #  destroying the inner window and recreating it, and ON-READY
46 #  just after.  Afterwards, theh inner window is called
47 #      .
48 #     
49 #     proc innerwindow {} { ... }
50 #  and run
51 #     innerwindow
52 #  This will create
53 #     .i.i.b      frame to contain container
54 #     .i.i.b.c    actual container
55
56 #  Button presses
57 #
58 #    Caller may bind .i.i <ButtonPress-$b>
59 #
60 #    Alternatively caller may call  applet::setup-button-menu $b
61 #    which will generate a menu .m$b which the user can configure
62 #    and which will automatically be posted and unposted etc.
63 #    In this case the caller should arrange that all of their
64 #    menus, when an item is selected, call
65 #      applet::msel
66
67 wm withdraw .
68
69 tktray::icon .i -class example
70 .i configure -docked 1
71
72
73 namespace eval applet {
74
75
76 # used by both menus and tooltips
77 variable posted 0
78
79 #----- menus -----
80
81 proc setup-button-menu {b} {
82     bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
83     menu .m$b -tearoff 0
84 }
85
86 proc menubuttonpressed {b x y} {
87     variable posted
88     tooltip-cancel
89     if {$posted == $b} {
90         puts "unpost $posted toggle"
91         .m$posted unpost
92         set posted 0
93     } elseif {[winfo exists .m$b]} {
94         if {$posted} {
95             .m$posted unpost
96             puts "unpost $posted other"
97         }
98         puts "post $b"
99         set posted $b
100         .m$b post $x $y
101     }
102 }
103
104 proc msel {} {
105     variable posted
106     set posted 0
107 }
108
109 #----- tooltips -----
110
111 variable tooltip_on_vis {}
112 variable tooltip_on_invis {}
113
114 proc tooltip-starttimer {state x y} {
115     variable tooltip_after
116     variable posted
117     variable tooltip_inwindow
118     if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
119     catch { after cancel $tooltip_after }
120     set tooltip_after [after 500 applet::tooltip-show $x $y]
121 }
122
123 proc tooltip-cancel {} {
124     variable tooltip_after
125     variable tooltip_on_invis
126     catch { after cancel $tooltip_after }
127     catch { unset $tooltip_after }
128     wm withdraw .tt
129     uplevel #0 $tooltip_on_invis
130 }
131
132 set tooltip_inwindow 0
133
134 proc tooltip-enter {state x y} {
135     variable tooltip_inwindow
136     set tooltip_inwindow 1
137     tooltip-starttimer $state $x $y
138 }
139
140 proc tooltip-leave {} {
141     variable tooltip_inwindow
142     set tooltip_inwindow 0
143     tooltip-cancel
144 }
145
146 proc setup-tooltip {on_vis on_invis} {
147     foreach v {vis invis} {
148         variable tooltip_on_$v [set on_$v]
149     }
150     bind .i <Enter> { applet::tooltip-enter %s %X %Y }
151     bind .i <Leave> { applet::tooltip-leave }
152     bind .i <ButtonRelease> { 
153         applet::tooltip-cancel
154         applet::tooltip-starttimer %s %X %Y
155     }
156     bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
157     toplevel .tt -background black
158     wm withdraw .tt
159     wm overrideredirect .tt 1
160     label .tt.t -justify left -background {#EEE1B3}
161     pack .tt.t -padx 1 -pady 1
162     tooltip-set {}
163 }
164
165 proc tooltip-set {s} {
166     .tt.t configure -text $s
167 }
168
169 proc tooltip-show {x y} {
170     variable tooltip_on_vis
171     incr x 9
172     incr y 9
173     wm geometry .tt +$x+$y
174     wm deiconify .tt
175     uplevel #0 $tooltip_on_vis
176 }
177
178 #----- simple images -----
179
180 proc setimage {image} {
181     .i configure -image $image
182 }
183
184 #----- subwindow -----
185
186 variable subwindow_on_destroying
187 variable subwindow_on_ready
188
189 proc innerwindow-resetup-required {why} {
190     variable innerwindow_after
191 puts "IW-EVENT $why"
192     if {[info exists innerwindow_after]} return
193     set innerwindow_after [after idle applet::innerwindow-resetup]
194 }
195
196 proc innerwindow-resetup {} {
197     variable innerwindow_after
198     variable subwindow_on_destroying
199     variable subwindow_on_ready
200     unset innerwindow_after
201
202 puts RESETUP
203
204     uplevel #0 $subwindow_on_destroying
205
206     catch { destroy .i.i.c }
207     if {![winfo exists .i.i]} return
208     destroy [frame .i.i.make-exist]
209     catch { destroy .i.i.b.c }
210     catch { destroy .i.i.b }
211     frame .i.i.b
212     pack .i.i.b -fill both -side left -expand 1
213     frame .i.i.b.c -container 1 -background orange
214     pack .i.i.b.c -fill both -side left -expand 1
215 #
216     global inner_lastw inner_lasth
217     #set w [winfo width .i.i]
218 #    set w [winfo width .i.i]
219 #    set h [winfo height .i.i]
220
221 #    if {$w != $inner_lastw || $h != $inner_lasth} {
222 #       set inner_lastw $w
223 #       set inner_lasth $h
224 #       innerwindow-ph-dummy configure -width $w -height 2
225
226     uplevel #0 $subwindow_on_ready
227 #    }
228 }
229
230 proc setup-subwindow {w on_destroying on_ready} {
231     foreach v {destroying ready} {
232         variable subwindow_on_$v [set on_$v]
233     }
234
235     global inner_lastw inner_lasth
236     set inner_lastw -2
237     set inner_lasth -2
238
239     image create photo applet::innerwindow-ph-dummy -width $w -height 2
240     .i configure -image applet::innerwindow-ph-dummy
241
242     destroy [frame .i.make-exist]
243     destroy [frame .i.i.make-exist]
244     bind .i <<IconConfigure>> { 
245         applet::innerwindow-resetup-required IconConfigure
246     }
247 }
248
249 }