]>
Commit | Line | Data |
---|---|---|
1 | # button.tcl -- | |
2 | # | |
3 | # This file contains Tcl procedures used to manage Tk buttons. | |
4 | # | |
5 | # $Header: /user6/ouster/wish/scripts/RCS/button.tcl,v 1.7 92/07/28 15:41:13 ouster Exp $ SPRITE (Berkeley) | |
6 | # | |
7 | # Copyright 1992 Regents of the University of California | |
8 | # Permission to use, copy, modify, and distribute this | |
9 | # software and its documentation for any purpose and without | |
10 | # fee is hereby granted, provided that this copyright | |
11 | # notice appears in all copies. The University of California | |
12 | # makes no representations about the suitability of this | |
13 | # software for any purpose. It is provided "as is" without | |
14 | # express or implied warranty. | |
15 | # | |
16 | ||
17 | # The procedure below is invoked when the mouse pointer enters a | |
18 | # button widget. It records the button we're in and changes the | |
19 | # state of the button to active unless the button is disabled. | |
20 | ||
21 | proc tk_butEnter w { | |
22 | global tk_priv tk_strictMotif | |
23 | if {[lindex [$w config -state] 4] != "disabled"} { | |
24 | if {!$tk_strictMotif} { | |
25 | $w config -state active | |
26 | } | |
27 | set tk_priv(window) $w | |
28 | } | |
29 | } | |
30 | ||
31 | # The procedure below is invoked when the mouse pointer leaves a | |
32 | # button widget. It changes the state of the button back to | |
33 | # inactive. | |
34 | ||
35 | proc tk_butLeave w { | |
36 | global tk_priv tk_strictMotif | |
37 | if {[lindex [$w config -state] 4] != "disabled"} { | |
38 | if {!$tk_strictMotif} { | |
39 | $w config -state normal | |
40 | } | |
41 | } | |
42 | set tk_priv(window) "" | |
43 | } | |
44 | ||
45 | # The procedure below is invoked when the mouse button is pressed in | |
46 | # a button/radiobutton/checkbutton widget. It records information | |
47 | # (a) to indicate that the mouse is in the button, and | |
48 | # (b) to save the button's relief so it can be restored later. | |
49 | ||
50 | proc tk_butDown w { | |
51 | global tk_priv | |
52 | set tk_priv(relief) [lindex [$w config -relief] 4] | |
53 | if {[lindex [$w config -state] 4] != "disabled"} { | |
54 | $w config -relief sunken | |
55 | } | |
56 | } | |
57 | ||
58 | # The procedure below is invoked when the mouse button is released | |
59 | # for a button/radiobutton/checkbutton widget. It restores the | |
60 | # button's relief and invokes the command as long as the mouse | |
61 | # hasn't left the button. | |
62 | ||
63 | proc tk_butUp w { | |
64 | global tk_priv | |
65 | $w config -relief $tk_priv(relief) | |
66 | if {($w == $tk_priv(window)) | |
67 | && ([lindex [$w config -state] 4] != "disabled")} { | |
68 | uplevel #0 [list $w invoke] | |
69 | } | |
70 | } |