You might need to drain extra events out of the event queue. You might have a Tk application that runs for a long time, and you want to throw away all the users' frustrated clicks and keys from the event queue before returning. Or you might find your application suffering from the dreaded Windows double click bug described for tk_getOpenFile.
Note that Tk isn't actually broken. The basic problem is that the native Windows file open dialog only consumes 1.5 clicks, and after the dialog closes, the remaining <ButtonRelease> event falls to whatever window is below. This is a Windows bug, not really a Tk bug, and it happens with applications other than Tk.
Several techniques have been described on comp.lang.tcl for draining the event queue - mostly related to the Windows double click bug.
James Bonfield proposed a C code patch in Nov. 2000 that would "fix" Tk's use of the native Windows open file dialog. According to Tktoolkit bug 611615 [L1 ] the patch has been applied to Tk 8.5a0. See also bugs 220057 and 219985.
But for those of us stuck with Tcl/Tk 8.4 for a while, Bob Techentin wrote a procedure to drain the event queue on demand, inspired by Donal Fellows' suggestion to drain events to a label widget. This procedure searches children of "." for a simple label widget, then calls grab and update to syphon off any extra mouse clicks.
#-----------------------------------------------------------------
#
# drainEventQueue
#
# This code uses [grab] to direct all events to an
# inoccuous widget (a label), drains the event
# queue by calling [update], then releases the grab.
# The draining widget must be mapped, so we search
# [winfo children .].
#
#-----------------------------------------------------------------
proc drainEventQueue {} {
# Search for a mapped Label widget in children of "."
set wlist [winfo children .]
while { [llength $wlist] > 0 } {
set w [lindex $wlist 0]
set wlist [lrange $wlist 1 end]
# If we've got a mapped Label Widget, drain the queue
if { [winfo ismapped $w] } {
if { [winfo class $w] eq "Label" } {
grab $w
update
grab release $w
return
}
# Not a label, but ismapped, so add chldren to search
set wlist [concat $wlist [winfo children $w]]
}
}
# if we fall through, then there wan't a suitable widget.
# Tough luck.
}Call it like this
set filename [tk_getOpenFile]
# Evade Windows double-click bug
if { $::tcl_platform(platform) eq "windows" } {
drainEventQueue
}Mick O'Donnell presented a workaround in December 2001 which renames and wraps tk_getOpenFile/tk_getSaveFile with procs that create a temporary toplevel and use grab and update to drain extra events from the queue.
## PATCH to AVOID THE tk_getOpenFile double-click problem # Fix suggested by Bob Sheskey ([email protected]) 1997 # Packaged into a code patch by Mick O'Donnell ([email protected]) 2001 # global tcl_platform if { $tcl_platform(platform) == "windows"} { # Don't move the original procs twice if { [info commands orig_tk_getOpenFile] == {}} { # Rename the procs elsewhere rename tk_getOpenFile orig_tk_getOpenFile rename tk_getSaveFile orig_tk_getSaveFile } # Provide a new definitions proc tk_getOpenFile {args} { if [winfo exists .temp787] {destroy .temp787} wm withdraw [toplevel .temp787] grab .temp787 set file [eval [concat orig_tk_getOpenFile $args]] update destroy .temp787 return $file } proc tk_getSaveFile {args} { if [winfo exists .temp787] {destroy .temp787} wm withdraw [toplevel .temp787] grab .temp787 set file [eval [concat orig_tk_getSaveFile $args]] update destroy .temp787 return $file } }
Donald Arseneau presented a pure-Tcl workaround in February 2003 which revectors widget bindings for a fraction of a second after an expose event. I (RWT) couldn't get this to work on Windows XP. I suspect that the trailing <Key-up> event is in the queue before the <Expose> event fires.
# Disable key and button events for the first fraction of a second
# after a widget is created, mapped, or uncovered.
event add <<KeyOrButton>> <Button> <Key>
bind Nascent <<KeyOrButton>> {break}
bind all <Expose> {+
bindtags %W [linsert [bindtags %W] 0 Nascent]
after 300 {
if {[winfo exists %W]} {
bindtags %W [lreplace [bindtags %W] 0 0]
}
}
}See also tk_getOpenFile, tk_getSaveFile, and Bind Tips