]>
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 | # $tk_priv(window@$screen) keeps track of the button containing the mouse, | |
18 | # and $tk_priv(relief@$screen) saves the original relief of the button so | |
19 | # it can be restored when the mouse button is released. | |
20 | ||
21 | # The procedure below is invoked when the mouse pointer enters a | |
22 | # button widget. It records the button we're in and changes the | |
23 | # state of the button to active unless the button is disabled. | |
24 | ||
25 | proc tk_butEnter w { | |
26 | global tk_priv | |
27 | set screen [winfo screen $w] | |
28 | if {[lindex [$w config -state] 4] != "disabled"} { | |
29 | $w config -state active | |
30 | set tk_priv(window@$screen) $w | |
31 | } else { | |
32 | set tk_priv(window@$screen) "" | |
33 | } | |
34 | } | |
35 | ||
36 | # The procedure below is invoked when the mouse pointer leaves a | |
37 | # button widget. It changes the state of the button back to | |
38 | # inactive. | |
39 | ||
40 | proc tk_butLeave w { | |
41 | global tk_priv | |
42 | if {[lindex [$w config -state] 4] != "disabled"} { | |
43 | $w config -state normal | |
44 | } | |
45 | set screen [winfo screen $w] | |
46 | set tk_priv(window@$screen) "" | |
47 | } | |
48 | ||
49 | # The procedure below is invoked when the mouse button is pressed in | |
50 | # a button/radiobutton/checkbutton widget. It records information | |
51 | # (a) to indicate that the mouse is in the button, and | |
52 | # (b) to save the button's relief so it can be restored later. | |
53 | ||
54 | proc tk_butDown w { | |
55 | global tk_priv | |
56 | set screen [winfo screen $w] | |
57 | set tk_priv(relief@$screen) [lindex [$w config -relief] 4] | |
58 | if {[lindex [$w config -state] 4] != "disabled"} { | |
59 | $w config -relief sunken | |
60 | update idletasks | |
61 | } | |
62 | } | |
63 | ||
64 | # The procedure below is invoked when the mouse button is released | |
65 | # for a button/radiobutton/checkbutton widget. It restores the | |
66 | # button's relief and invokes the command as long as the mouse | |
67 | # hasn't left the button. | |
68 | ||
69 | proc tk_butUp w { | |
70 | global tk_priv | |
71 | set screen [winfo screen $w] | |
72 | $w config -relief $tk_priv(relief@$screen) | |
73 | update idletasks | |
74 | if {($w == $tk_priv(window@$screen)) | |
75 | && ([lindex [$w config -state] 4] != "disabled")} { | |
76 | uplevel #0 [list $w invoke] | |
77 | } | |
78 | } |