Tk utility - change the mouse pointer to a watch cursor, execute a script, then restore the original cursor. Works properly even if the script raises an error, [break]s, [return]s, or any other exceptional return code.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | # Usage: withBusyCursor { script ... }
#
proc withBusyCursor {body} {
global errorInfo errorCode
set busy {}
set list {.}
# Traverse the widget hierarchy to locate widgets with
# a nondefault -cursor setting.
#
while {$list != ""} {
set next {}
foreach w $list {
catch {set cursor [$w cget -cursor]}
if {[winfo toplevel $w] == $w || $cursor != ""} {
lappend busy $w $cursor
set cursor {}
}
set next [concat $next [winfo children $w]]
}
set list $next
}
# Change the cursor:
#
foreach {w _} $busy {
catch {$w configure -cursor watch}
}
update idletasks
# Execute the script body.
#
set rc [catch {uplevel 1 $body} result]
set ei $errorInfo
set ec $errorCode
# Restore the original cursor settings.
#
foreach {w cursor} $busy {
catch {$w configure -cursor $cursor}
}
# Return script result to caller.
#
return -code $rc -errorinfo $ei -errorcode $ec $result
}
|
Got a section of code in a GUI that takes a few seconds to execute? Wrap it in a call to [withBusyCursor] to give the user feedback.
Known problems: Only tested on Unix; it doesn't seem to always work on Windows. I'm not sure if it should use [update] or [update idletasks].
Notes: Unlike the BLT [busy] command, this doesn't block user input. In practice this doesn't seem to be a problem -- when the cursor changes, users tend to stop clicking until it changes back.
The code also illustrates a useful idiom for breadth-first traversal, the correct way to pass exceptional return conditions up the call stack, and one of Tcl's neatest features -- the ability to define new control structures.
Block key events...
I have given this a try but it poses the same problem as my own code. When executed via the result of a key entry, the cursor fails to change. I have something such as:
proc hello {} { withBusyCursor { long task } }
button .b -text "Hit Me" -command hello entry .e
bind .e <Return> hello
pack .b .e
When I press the "Hit Me" button, all works fine and the busy cursor appears, however, if I press enter in the .e entry, the arrow cursor does not change to a busy cursor.
Any thoughts on this?