~ubuntu-branches/ubuntu/gutsy/vnc4/gutsy

« back to all changes in this revision

Viewing changes to unix/xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/button.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Ola Lundqvist
  • Date: 2006-05-15 20:35:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060515203517-l4lre1ku942mn26k
Tags: 4.1.1+X4.3.0-10
* Correction of critical security issue. Thanks to Martin Kogler
  <e9925248@student.tuwien.ac.at> that informed me about the issue,
  and provided the patch.
  This flaw was originally found by Steve Wiseman of intelliadmin.com.
* Applied patch from Javier Kohen <jkohen@users.sourceforge.net> that
  inform the user that only 8 first characters of the password will
  actually be used when typing more than 8 characters, closes:
  #355619.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# 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
# @(#) button.tcl 1.17 95/05/05 16:56:01
 
8
#
 
9
# Copyright (c) 1992-1994 The Regents of the University of California.
 
10
# Copyright (c) 1994 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
bind Button <FocusIn> {}
 
21
bind Button <Enter> {
 
22
    tkButtonEnter %W
 
23
}
 
24
bind Button <Leave> {
 
25
    tkButtonLeave %W
 
26
}
 
27
bind Button <1> {
 
28
    tkButtonDown %W
 
29
}
 
30
bind Button <ButtonRelease-1> {
 
31
    tkButtonUp %W
 
32
}
 
33
bind Button <space> {
 
34
    tkButtonInvoke %W
 
35
}
 
36
bind Button <Return> {
 
37
    if !$tk_strictMotif {
 
38
        tkButtonInvoke %W
 
39
    }
 
40
}
 
41
 
 
42
bind Checkbutton <FocusIn> {}
 
43
bind Checkbutton <Enter> {
 
44
    tkButtonEnter %W
 
45
}
 
46
bind Checkbutton <Leave> {
 
47
    tkButtonLeave %W
 
48
}
 
49
bind Checkbutton <1> {
 
50
    tkCheckRadioInvoke %W
 
51
}
 
52
bind Checkbutton <space> {
 
53
    tkCheckRadioInvoke %W
 
54
}
 
55
bind Checkbutton <Return> {
 
56
    if !$tk_strictMotif {
 
57
        tkCheckRadioInvoke %W
 
58
    }
 
59
}
 
60
 
 
61
bind Radiobutton <FocusIn> {}
 
62
bind Radiobutton <Enter> {
 
63
    tkButtonEnter %W
 
64
}
 
65
bind Radiobutton <Leave> {
 
66
    tkButtonLeave %W
 
67
}
 
68
bind Radiobutton <1> {
 
69
    tkCheckRadioInvoke %W
 
70
}
 
71
bind Radiobutton <space> {
 
72
    tkCheckRadioInvoke %W
 
73
}
 
74
bind Radiobutton <Return> {
 
75
    if !$tk_strictMotif {
 
76
        tkCheckRadioInvoke %W
 
77
    }
 
78
}
 
79
 
 
80
# tkButtonEnter --
 
81
# The procedure below is invoked when the mouse pointer enters a
 
82
# button widget.  It records the button we're in and changes the
 
83
# state of the button to active unless the button is disabled.
 
84
#
 
85
# Arguments:
 
86
# w -           The name of the widget.
 
87
 
 
88
proc tkButtonEnter {w} {
 
89
    global tkPriv
 
90
    if {[$w cget -state] != "disabled"} {
 
91
        $w config -state active
 
92
        if {$tkPriv(buttonWindow) == $w} {
 
93
            $w configure -state active -relief sunken
 
94
        }
 
95
    }
 
96
    set tkPriv(window) $w
 
97
}
 
98
 
 
99
# tkButtonLeave --
 
100
# The procedure below is invoked when the mouse pointer leaves a
 
101
# button widget.  It changes the state of the button back to
 
102
# inactive.  If we're leaving the button window with a mouse button
 
103
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
 
104
# button too.
 
105
#
 
106
# Arguments:
 
107
# w -           The name of the widget.
 
108
 
 
109
proc tkButtonLeave w {
 
110
    global tkPriv
 
111
    if {[$w cget -state] != "disabled"} {
 
112
        $w config -state normal
 
113
    }
 
114
    if {$w == $tkPriv(buttonWindow)} {
 
115
        $w configure -relief $tkPriv(relief)
 
116
    }
 
117
    set tkPriv(window) ""
 
118
}
 
119
 
 
120
# tkButtonDown --
 
121
# The procedure below is invoked when the mouse button is pressed in
 
122
# a button widget.  It records the fact that the mouse is in the button,
 
123
# saves the button's relief so it can be restored later, and changes
 
124
# the relief to sunken.
 
125
#
 
126
# Arguments:
 
127
# w -           The name of the widget.
 
128
 
 
129
proc tkButtonDown w {
 
130
    global tkPriv
 
131
    set tkPriv(relief) [lindex [$w config -relief] 4]
 
132
    if {[$w cget -state] != "disabled"} {
 
133
        set tkPriv(buttonWindow) $w
 
134
        $w config -relief sunken
 
135
    }
 
136
}
 
137
 
 
138
# tkButtonUp --
 
139
# The procedure below is invoked when the mouse button is released
 
140
# in a button widget.  It restores the button's relief and invokes
 
141
# the command as long as the mouse hasn't left the button.
 
142
#
 
143
# Arguments:
 
144
# w -           The name of the widget.
 
145
 
 
146
proc tkButtonUp w {
 
147
    global tkPriv
 
148
    if {$w == $tkPriv(buttonWindow)} {
 
149
        set tkPriv(buttonWindow) ""
 
150
        $w config -relief $tkPriv(relief)
 
151
        if {($w == $tkPriv(window))
 
152
                && ([$w cget -state] != "disabled")} {
 
153
            uplevel #0 [list $w invoke]
 
154
        }
 
155
    }
 
156
}
 
157
 
 
158
# tkButtonInvoke --
 
159
# The procedure below is called when a button is invoked through
 
160
# the keyboard.  It simulate a press of the button via the mouse.
 
161
#
 
162
# Arguments:
 
163
# w -           The name of the widget.
 
164
 
 
165
proc tkButtonInvoke w {
 
166
    if {[$w cget -state] != "disabled"} {
 
167
        set oldRelief [$w cget -relief]
 
168
        set oldState [$w cget -state]
 
169
        $w configure -state active -relief sunken
 
170
        update idletasks
 
171
        after 100
 
172
        $w configure -state $oldState -relief $oldRelief
 
173
        uplevel #0 [list $w invoke]
 
174
    }
 
175
}
 
176
 
 
177
# tkCheckRadioInvoke --
 
178
# The procedure below is invoked when the mouse button is pressed in
 
179
# a checkbutton or radiobutton widget, or when the widget is invoked
 
180
# through the keyboard.  It invokes the widget if it
 
181
# isn't disabled.
 
182
#
 
183
# Arguments:
 
184
# w -           The name of the widget.
 
185
 
 
186
proc tkCheckRadioInvoke w {
 
187
    if {[$w cget -state] != "disabled"} {
 
188
        uplevel #0 [list $w invoke]
 
189
    }
 
190
}