# 
# busy.tcl
#
# Busy feedback.
#
# Copyright (c) 1993 Xerox Corporation.
# Use and copying of this software and preparation of derivative works based
# upon this software are permitted. Any distribution of this software or
# derivative works must comply with all applicable United States export
# control laws. This software is made available AS IS, and Xerox Corporation
# makes no warranty about the software, its performance or its conformity to
# any specification.

proc busy { args } {
#    busyIcon $args
#    busyCursor $args
    busyCursorHack $args
}
proc busyIcon { cmd } {
    global exwin exmh errorInfo

    if [info exists exwin(faceCanvas)] {
	set h [$exwin(faceCanvas) create bitmap 48 48 -anchor se \
		    -bitmap @$exmh(library)/hourglass.bitmap]
	update idletasks
    }

    set error [catch {uplevel #0 $cmd} result]
    set ei $errorInfo

    if [info exists h] {
	$exwin(faceCanvas) delete $h
    }

    if $error {
	error $result $ei
    } else {
	return $result
    }

}
proc busyCursorInner { cmd busy } {
    global errorInfo
    foreach w $busy {
	catch {[lindex $w 0] config -cursor watch}
    }
    update idletasks

    set error [catch {uplevel #0 $cmd} result]
    set ei $errorInfo

    foreach w $busy {
	catch {[lindex $w 0] config -cursor [lindex $w 1]}
    }
    if $error {
	error $result $ei
    } else {
	return $result
    }
}
proc busyCursorHack {cmd} {
    set busy {}
    catch {
	#Fdisp_Busy
	global fdisp
	foreach can {canvas cache} {
	    if [info exists fdisp($can)] {
		set w $fdisp($can)
		set cursor [lindex [$w config -cursor] 4]
		lappend busy [list $w $cursor]
	    }
	}
	#Exwin_Busy
	global exwin
	foreach w [list $exwin(mtext) $exwin(ftext)] {
	    set cursor [lindex [$w config -cursor] 4]
	    lappend busy [list $w $cursor]
	}
	#Sedit_Busy
	global sedit
	foreach w $sedit(allids) {
	    set cursor [lindex [$w config -cursor] 4]
	    lappend busy [list $w $cursor]
	}
	#Label_Busy
	global label
	foreach w [list $label(main) $label(folder) $label(message) $exwin(status)] {
	    set cursor [lindex [$w config -cursor] 4]
	    lappend busy [list $w $cursor]
	}
    }
    return [busyCursorInner $cmd $busy]
}
proc busyCursor {cmd} {
    set busy {.app .root}
    set list [winfo children .]
    while {$list != ""} {
	set next {}
	foreach w $list {
	    set cursor [lindex [$w config -cursor] 4]
	    lappend busy [list $w $cursor]
	    set next [concat $next [winfo children $w]]
	}
	set list $next
    }
    return [busyCursorInner $cmd $busy]
}

