# this is ali's coffee-cup version, mostly duplicate of that in guibase/interrupt.tcl
# instead of copying code into ~cvs/scrib/lib/*.tcl files, please modify the list of
# guibase files in ::ScribApp::setup_guibase. this way, we get enhancements and bug/fixes
# in the canonical-guibase version *for free*. i have renamed this one to interrupt_coffee_cup.
# thanks, jason

proc interrupt {what args} {
    global interrupt_pending interrupt_prev_pct interrupt_prev_mess
    global tk_version interrupt_disable tdv_default interrupt_totalval
    global interrupt_frame
    global interrupt_frame env  
    
    if {![info exists tk_version] || [info exists interrupt_disable]} {
	return 0
    }
    
    if [info exists interrupt_frame] {
	set frame $interrupt_frame
	set topl 0
    } else {
	set frame .progress
	set topl 1
    }
	
    
    switch $what {
	set {
	    if {$args == ""} { set args 1 }
	    set interrupt_pending $args
	}
	unset {
	    catch {unset interrupt_pending}
	}
	init {
	    set interrupt_prev_pct 0
	    set interrupt_prev_mess ""
	    set interrupt_totalval ""
	    catch {unset interrupt_pending}
	    if $topl {
		catch {top_destroy $frame}
		top_window $frame 1 "Operation in progress"
	    } else {
		foreach ch [winfo children $frame] { destroy $ch }
	    }
	    frame $frame.back -background yellow -relief flat \
		-borderwidth 0
	    frame $frame.front -background green -relief raised \
		-borderwidth 5
	    button $frame.stop -text " Interrupt " -padx 3 -pady 0 \
		-command "interrupt set 1" -background red
	    if $topl {
		$frame.back configure -width 300 -height 25
		$frame.front configure -width 0 -height 25
		$frame.stop configure -pady 3
	    }
	    set stbuts $frame.stop
	    foreach {text color val} $args {
		button $frame.stop$val -text " $text " -padx 3 -pady 3 \
		    -command "interrupt set $val" -background $color
		lappend stbuts $frame.stop$val
	    }
	    label $frame.status -relief flat -borderwidth 0 -anchor w \
		-text " 0 % done"
	    if $topl {
		$frame.status configure -relief ridge -borderwidth 2 
	    }
	    pack $frame.status -side bottom -fill both ;# -expand 1
	    pack $frame.back -side left -fill both ;# -expand 1
	    eval pack $stbuts -side left -fill both
	    place $frame.front -in $frame.back -x 0 -anchor nw \
		-y 0 -relheight 1
	    if $topl {
		top_geometry $frame +100+100
		form_auto_raise $frame
	    }
	    update
	}
	begin {
	    # this is an alternate form :
	    # interrupt begin title message totalval [ stop_func ]
	    # totalval can be 0 in which case no bar is put up
	    
	    set interrupt_prev_pct ""
	    set interrupt_prev_mess ""
	    set interrupt_totalval [lindex $args 2]
	    
	    catch {unset interrupt_pending}
	    if $topl {
		top_destroy $frame
		top_window $frame 1 [lindex $args 0]
	    } else {
		foreach ch [winfo children $frame] { destroy $ch }
	    }
	    if $interrupt_totalval {
		frame $frame.back -background yellow -relief flat \
		    -borderwidth 0
		frame $frame.front -background green -relief raised \
		    -borderwidth 5
		if $topl {
		    set stext " 0 % done"
		} else {
		    set stext "[lindex $args 1]: 0 % done"
		}
		
		label $frame.status -relief flat -borderwidth 0 -anchor w \
		    -text $stext
		if $topl {
		    $frame.back configure -width 300 -height 25
		    $frame.front configure -width 0 -height 25
		    $frame.status configure -relief ridge -borderwidth 2 
		}
	    }
	    set cmd "interrupt set 1"
	    if {[lindex $args 3] != ""} {
		append cmd "; [lindex $args 3]"
	    }
	    button $frame.stop -text " Interrupt " -padx 3 \
		-command $cmd -background red
	    if $topl {
		label $frame.mess -relief ridge -borderwidth 2 -anchor w \
		    -text "[lindex $args 1] ..."
		pack $frame.mess -side top -fill both -expand 1
		$frame.stop configure -pady 3
	    }
	    pack $frame.status -side bottom -fill both -expand 1
	    if $interrupt_totalval {
		pack $frame.back -side left -fill both -expand 1
		pack $frame.stop -side left -fill both
		place $frame.front -in $frame.back -x 0 -anchor nw \
		    -y 0 -relheight 1
	    } else {
		pack $frame.stop -side left
	    }
	    if $topl {
		top_geometry $frame +100+100
		form_auto_raise $frame
	    }
	    update
	}
	add_message {
	    if {[winfo exists $frame.stop] && !$topl} {
		set n 0
		set col black
		if {[lindex $args 3] != ""} { set col [lindex $args 3] }
		while {[winfo exists $frame.mess$n]} { incr n }
		label $frame.mess$n -relief ridge -borderwidth 2 -anchor w \
		    -text [lindex $args 2] -foreground $col
		pack $frame.mess$n -side bottom -fill both -expand 1 \
		    -before $frame.status
		update
	    }
	    return 0
	}
	finish {
	    # Just to look nice
	    interrupt check 100 100
	    
	    if $topl {
		catch {top_destroy $frame}
	    } else {
		foreach ch [winfo children $frame] { destroy $ch }
	    }
	    catch {unset interrupt_pending}
	    update
	}
	check {
	    if ![winfo exists $frame.stop] {
		# Maybe we were called recursively
		return 0
	    }
	    catch {$tdv_default configure -active 0}
	    update
	    if {[lindex $args 0] >= 0} {
		if {[lindex $args 1] > 0} {
		    set pct [expr {[lindex $args 0] / ([lindex $args 1] + 0.0)}]
		    set interrupt_prev_pct $pct
		} else {
		    set pct $interrupt_prev_pct
		}
		set mess " [expr int($pct * 100)] % done"
		if {[lindex $args 2] != ""} {
		    append mess "; [lindex $args 2]"
		    set interrupt_prev_mess [lindex $args 2]
		} elseif {$interrupt_prev_mess != ""} {
		    append mess "; $interrupt_prev_mess"
		}
		
		set col black
		if {[lindex $args 3] != ""} {
		    set col [lindex $args 3]
		}
		$frame.status configure -text $mess -fg $col
		update
		set ww [expr [winfo width $frame.back] * $pct]
		$frame.front configure -width $ww
	    }
	    update idle
	    catch {$tdv_default configure -active 1}
	    if [info exists interrupt_pending] {
		return $interrupt_pending
	    } else {
		return 0
	    }
	}
	update {
	    # This is an alternate form:
	    # interrupt update totamt message
	    if ![winfo exists $frame.stop] {
		# Maybe we were called recursively
		return 0
	    }
	    
	    set pct [expr {int(100 * [lindex $args 0] / \
				   ($interrupt_totalval + 0.0))}]
	    if {$pct == $interrupt_prev_pct} { return 0 }
	    set interrupt_prev_pct $pct
	    
	    catch {$tdv_default configure -active 0}
	    update
	    if $topl {
		$frame.status configure -text " $pct % done"
		if {[lindex $args 1] != ""} {
		    $frame.mess configure -text "[lindex $args 1] ..."
		}
	    } else {
		$frame.status configure -text "[lindex $args 1]: $pct % done"
	    }
	    update
	    set ww [expr [winfo width $frame.back] * $pct * 0.01]
	    $frame.front configure -width $ww
	    
	    update idle
	    catch {$tdv_default configure -active 1}
	    if {[info exists interrupt_pending] && $interrupt_pending} {
		mess "Interrupted\n" red
		if $topl {
		    top_destroy $frame
		} else {
		    foreach ch [winfo children $frame] { destroy $ch }
		}
		set i $interrupt_pending
		unset interrupt_pending
		return $i
	    } else {
		return 0
	    }
	}
    }
    if [winfo exist $frame.stop] {
        if ![winfo exist $frame.icon] {
	    set image [file join $env(ICEM_ACN) lib icons BatchWait.gif]
	    label $frame.icon  -padx 3 -pady 0 
	    $frame.icon configure -image [image create photo -file $image]
	    pack $frame.icon -side left
	}
    }    
}


