OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tk/] [library/] [button.tcl] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# button.tcl --
2
#
3
# This file defines the default bindings for Tk label, button,
4
# checkbutton, and radiobutton widgets and provides procedures
5
# that help in implementing those bindings.
6
#
7
# SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
8
#
9
# Copyright (c) 1992-1994 The Regents of the University of California.
10
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
11
#
12
# See the file "license.terms" for information on usage and redistribution
13
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14
#
15
 
16
#-------------------------------------------------------------------------
17
# The code below creates the default class bindings for buttons.
18
#-------------------------------------------------------------------------
19
 
20
if {$tcl_platform(platform) == "macintosh"} {
21
    bind Radiobutton <Enter> {
22
        tkButtonEnter %W
23
    }
24
    bind Radiobutton <1> {
25
        tkButtonDown %W
26
    }
27
    bind Radiobutton <ButtonRelease-1> {
28
        tkButtonUp %W
29
    }
30
    bind Checkbutton <Enter> {
31
        tkButtonEnter %W
32
    }
33
    bind Checkbutton <1> {
34
        tkButtonDown %W
35
    }
36
    bind Checkbutton <ButtonRelease-1> {
37
        tkButtonUp %W
38
    }
39
}
40
if {$tcl_platform(platform) == "windows"} {
41
    bind Button <Return> {
42
        tkButtonInvoke %W
43
    }
44
    bind Checkbutton <Return> {
45
        tkCheckRadioInvoke %W
46
    }
47
    bind Radiobutton <Return> {
48
        tkCheckRadioInvoke %W
49
    }
50
    bind Checkbutton <equal> {
51
        tkCheckRadioInvoke %W select
52
    }
53
    bind Checkbutton <plus> {
54
        tkCheckRadioInvoke %W select
55
    }
56
    bind Checkbutton <minus> {
57
        tkCheckRadioInvoke %W deselect
58
    }
59
    bind Checkbutton <1> {
60
        tkCheckRadioDown %W
61
    }
62
    bind Checkbutton <ButtonRelease-1> {
63
        tkButtonUp %W
64
    }
65
    bind Checkbutton <Enter> {
66
        tkCheckRadioEnter %W
67
    }
68
 
69
    bind Radiobutton <1> {
70
        tkCheckRadioDown %W
71
    }
72
    bind Radiobutton <ButtonRelease-1> {
73
        tkButtonUp %W
74
    }
75
    bind Radiobutton <Enter> {
76
        tkCheckRadioEnter %W
77
    }
78
}
79
if {$tcl_platform(platform) == "unix"} {
80
    bind Checkbutton <Return> {
81
        if {!$tk_strictMotif} {
82
            tkCheckRadioInvoke %W
83
        }
84
    }
85
    bind Radiobutton <Return> {
86
        if {!$tk_strictMotif} {
87
            tkCheckRadioInvoke %W
88
        }
89
    }
90
    bind Checkbutton <1> {
91
        tkCheckRadioInvoke %W
92
    }
93
    bind Radiobutton <1> {
94
        tkCheckRadioInvoke %W
95
    }
96
    bind Checkbutton <Enter> {
97
        tkButtonEnter %W
98
    }
99
    bind Radiobutton <Enter> {
100
        tkButtonEnter %W
101
    }
102
}
103
 
104
bind Button <space> {
105
    tkButtonInvoke %W
106
}
107
bind Checkbutton <space> {
108
    tkCheckRadioInvoke %W
109
}
110
bind Radiobutton <space> {
111
    tkCheckRadioInvoke %W
112
}
113
 
114
bind Button <FocusIn> {}
115
bind Button <Enter> {
116
    tkButtonEnter %W
117
}
118
bind Button <Leave> {
119
    tkButtonLeave %W
120
}
121
bind Button <1> {
122
    tkButtonDown %W
123
}
124
bind Button <ButtonRelease-1> {
125
    tkButtonUp %W
126
}
127
 
128
bind Checkbutton <FocusIn> {}
129
bind Checkbutton <Leave> {
130
    tkButtonLeave %W
131
}
132
 
133
bind Radiobutton <FocusIn> {}
134
bind Radiobutton <Leave> {
135
    tkButtonLeave %W
136
}
137
 
138
if {$tcl_platform(platform) == "windows"} {
139
 
140
#########################
141
# Windows implementation 
142
#########################
143
 
144
# tkButtonEnter --
145
# The procedure below is invoked when the mouse pointer enters a
146
# button widget.  It records the button we're in and changes the
147
# state of the button to active unless the button is disabled.
148
#
149
# Arguments:
150
# w -           The name of the widget.
151
 
152
proc tkButtonEnter w {
153
    global tkPriv
154
    if {[$w cget -state] != "disabled"} {
155
        if {$tkPriv(buttonWindow) == $w} {
156
            $w configure -state active -relief sunken
157
        }
158
    }
159
    set tkPriv(window) $w
160
}
161
 
162
# tkButtonLeave --
163
# The procedure below is invoked when the mouse pointer leaves a
164
# button widget.  It changes the state of the button back to
165
# inactive.  If we're leaving the button window with a mouse button
166
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
167
# button too.
168
#
169
# Arguments:
170
# w -           The name of the widget.
171
 
172
proc tkButtonLeave w {
173
    global tkPriv
174
    if {[$w cget -state] != "disabled"} {
175
        $w config -state normal
176
    }
177
    if {$w == $tkPriv(buttonWindow)} {
178
        $w configure -relief $tkPriv(relief)
179
    }
180
    set tkPriv(window) ""
181
}
182
 
183
# tkCheckRadioEnter --
184
# The procedure below is invoked when the mouse pointer enters a
185
# checkbutton or radiobutton widget.  It records the button we're in
186
# and changes the state of the button to active unless the button is
187
# disabled.
188
#
189
# Arguments:
190
# w -           The name of the widget.
191
 
192
proc tkCheckRadioEnter w {
193
    global tkPriv
194
    if {[$w cget -state] != "disabled"} {
195
        if {$tkPriv(buttonWindow) == $w} {
196
            $w configure -state active
197
        }
198
    }
199
    set tkPriv(window) $w
200
}
201
 
202
# tkButtonDown --
203
# The procedure below is invoked when the mouse button is pressed in
204
# a button widget.  It records the fact that the mouse is in the button,
205
# saves the button's relief so it can be restored later, and changes
206
# the relief to sunken.
207
#
208
# Arguments:
209
# w -           The name of the widget.
210
 
211
proc tkButtonDown w {
212
    global tkPriv
213
    set tkPriv(relief) [lindex [$w conf -relief] 4]
214
    if {[$w cget -state] != "disabled"} {
215
        set tkPriv(buttonWindow) $w
216
        $w config -relief sunken -state active
217
    }
218
}
219
 
220
# tkCheckRadioDown --
221
# The procedure below is invoked when the mouse button is pressed in
222
# a button widget.  It records the fact that the mouse is in the button,
223
# saves the button's relief so it can be restored later, and changes
224
# the relief to sunken.
225
#
226
# Arguments:
227
# w -           The name of the widget.
228
 
229
proc tkCheckRadioDown w {
230
    global tkPriv
231
    set tkPriv(relief) [lindex [$w conf -relief] 4]
232
    if {[$w cget -state] != "disabled"} {
233
        set tkPriv(buttonWindow) $w
234
        $w config -state active
235
    }
236
}
237
 
238
# tkButtonUp --
239
# The procedure below is invoked when the mouse button is released
240
# in a button widget.  It restores the button's relief and invokes
241
# the command as long as the mouse hasn't left the button.
242
#
243
# Arguments:
244
# w -           The name of the widget.
245
 
246
proc tkButtonUp w {
247
    global tkPriv
248
    if {$w == $tkPriv(buttonWindow)} {
249
        set tkPriv(buttonWindow) ""
250
        if {($w == $tkPriv(window))
251
                && ([$w cget -state] != "disabled")} {
252
            $w config -relief $tkPriv(relief) -state normal
253
            uplevel #0 [list $w invoke]
254
        }
255
    }
256
}
257
 
258
}
259
 
260
if {$tcl_platform(platform) == "unix"} {
261
 
262
#####################
263
# Unix implementation
264
#####################
265
 
266
# tkButtonEnter --
267
# The procedure below is invoked when the mouse pointer enters a
268
# button widget.  It records the button we're in and changes the
269
# state of the button to active unless the button is disabled.
270
#
271
# Arguments:
272
# w -           The name of the widget.
273
 
274
proc tkButtonEnter {w} {
275
    global tkPriv
276
    if {[$w cget -state] != "disabled"} {
277
        $w config -state active
278
        if {$tkPriv(buttonWindow) == $w} {
279
            $w configure -state active -relief sunken
280
        }
281
    }
282
    set tkPriv(window) $w
283
}
284
 
285
# tkButtonLeave --
286
# The procedure below is invoked when the mouse pointer leaves a
287
# button widget.  It changes the state of the button back to
288
# inactive.  If we're leaving the button window with a mouse button
289
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
290
# button too.
291
#
292
# Arguments:
293
# w -           The name of the widget.
294
 
295
proc tkButtonLeave w {
296
    global tkPriv
297
    if {[$w cget -state] != "disabled"} {
298
        $w config -state normal
299
    }
300
    if {$w == $tkPriv(buttonWindow)} {
301
        $w configure -relief $tkPriv(relief)
302
    }
303
    set tkPriv(window) ""
304
}
305
 
306
# tkButtonDown --
307
# The procedure below is invoked when the mouse button is pressed in
308
# a button widget.  It records the fact that the mouse is in the button,
309
# saves the button's relief so it can be restored later, and changes
310
# the relief to sunken.
311
#
312
# Arguments:
313
# w -           The name of the widget.
314
 
315
proc tkButtonDown w {
316
    global tkPriv
317
    set tkPriv(relief) [lindex [$w config -relief] 4]
318
    if {[$w cget -state] != "disabled"} {
319
        set tkPriv(buttonWindow) $w
320
        $w config -relief sunken
321
    }
322
}
323
 
324
# tkButtonUp --
325
# The procedure below is invoked when the mouse button is released
326
# in a button widget.  It restores the button's relief and invokes
327
# the command as long as the mouse hasn't left the button.
328
#
329
# Arguments:
330
# w -           The name of the widget.
331
 
332
proc tkButtonUp w {
333
    global tkPriv
334
    if {$w == $tkPriv(buttonWindow)} {
335
        set tkPriv(buttonWindow) ""
336
        $w config -relief $tkPriv(relief)
337
        if {($w == $tkPriv(window))
338
                && ([$w cget -state] != "disabled")} {
339
            uplevel #0 [list $w invoke]
340
        }
341
    }
342
}
343
 
344
}
345
 
346
if {$tcl_platform(platform) == "macintosh"} {
347
 
348
####################
349
# Mac implementation
350
####################
351
 
352
# tkButtonEnter --
353
# The procedure below is invoked when the mouse pointer enters a
354
# button widget.  It records the button we're in and changes the
355
# state of the button to active unless the button is disabled.
356
#
357
# Arguments:
358
# w -           The name of the widget.
359
 
360
proc tkButtonEnter {w} {
361
    global tkPriv
362
    if {[$w cget -state] != "disabled"} {
363
        if {$tkPriv(buttonWindow) == $w} {
364
            $w configure -state active
365
        }
366
    }
367
    set tkPriv(window) $w
368
}
369
 
370
# tkButtonLeave --
371
# The procedure below is invoked when the mouse pointer leaves a
372
# button widget.  It changes the state of the button back to
373
# inactive.  If we're leaving the button window with a mouse button
374
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
375
# button too.
376
#
377
# Arguments:
378
# w -           The name of the widget.
379
 
380
proc tkButtonLeave w {
381
    global tkPriv
382
    if {$w == $tkPriv(buttonWindow)} {
383
        $w configure -state normal
384
    }
385
    set tkPriv(window) ""
386
}
387
 
388
# tkButtonDown --
389
# The procedure below is invoked when the mouse button is pressed in
390
# a button widget.  It records the fact that the mouse is in the button,
391
# saves the button's relief so it can be restored later, and changes
392
# the relief to sunken.
393
#
394
# Arguments:
395
# w -           The name of the widget.
396
 
397
proc tkButtonDown w {
398
    global tkPriv
399
    if {[$w cget -state] != "disabled"} {
400
        set tkPriv(buttonWindow) $w
401
        $w config -state active
402
    }
403
}
404
 
405
# tkButtonUp --
406
# The procedure below is invoked when the mouse button is released
407
# in a button widget.  It restores the button's relief and invokes
408
# the command as long as the mouse hasn't left the button.
409
#
410
# Arguments:
411
# w -           The name of the widget.
412
 
413
proc tkButtonUp w {
414
    global tkPriv
415
    if {$w == $tkPriv(buttonWindow)} {
416
        $w config -state normal
417
        set tkPriv(buttonWindow) ""
418
        if {($w == $tkPriv(window))
419
                && ([$w cget -state] != "disabled")} {
420
            uplevel #0 [list $w invoke]
421
        }
422
    }
423
}
424
 
425
}
426
 
427
##################
428
# Shared routines
429
##################
430
 
431
# tkButtonInvoke --
432
# The procedure below is called when a button is invoked through
433
# the keyboard.  It simulate a press of the button via the mouse.
434
#
435
# Arguments:
436
# w -           The name of the widget.
437
 
438
proc tkButtonInvoke w {
439
    if {[$w cget -state] != "disabled"} {
440
        set oldRelief [$w cget -relief]
441
        set oldState [$w cget -state]
442
        $w configure -state active -relief sunken
443
        update idletasks
444
        after 100
445
        $w configure -state $oldState -relief $oldRelief
446
        uplevel #0 [list $w invoke]
447
    }
448
}
449
 
450
# tkCheckRadioInvoke --
451
# The procedure below is invoked when the mouse button is pressed in
452
# a checkbutton or radiobutton widget, or when the widget is invoked
453
# through the keyboard.  It invokes the widget if it
454
# isn't disabled.
455
#
456
# Arguments:
457
# w -           The name of the widget.
458
# cmd -         The subcommand to invoke (one of invoke, select, or deselect).
459
 
460
proc tkCheckRadioInvoke {w {cmd invoke}} {
461
    if {[$w cget -state] != "disabled"} {
462
        uplevel #0 [list $w $cmd]
463
    }
464
}
465
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.