# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# busy.tcl - Comment
# Copyright (C) 1998 Cygnus Solutions.

itcl_class Busy& {
	constructor {config} {
	}

	destructor {
		foreach w [concat $host_list $others] {
			catch {sn_blt_busy forget $w}
		}
	}

	method config {args} {
		return [eval sn_blt_busy configure $args]
	}

	method status {win} {
		return [eval sn_blt_busy status $win]
	}

	method hosts {{pattern ""}} {
		return [eval sn_blt_busy hosts $pattern]
	}

	method others {func {exclude ""}} {
		switch $func {
		"hold" {
			set others {}
			foreach topl ". [winfo children .]" {
				if {($topl == "." || \
					[winfo toplevel $topl] != ".") && \
					[lsearch -exact $exclude $topl] == -1 && ![_active $topl]} {

					lappend others $topl
					sn_blt_busy hold $topl -cursor exchange
				}
			}
			set off [lsearch -exact $host_list $exclude]
			if {$off != -1} {
				set host_list [lreplace $host_list $off $off]

				sn_blt_busy release $exclude
			}
		    }
		"release" -
		default {
			foreach w $others {
				catch {sn_blt_busy forget $w}
			}
			set others {}
		    }
		}
	}

	method _active {topl} {
		if {[catch {set status [sn_blt_busy status $topl]}]} {
			return 0
		}
		return $status
	}

	method hold {{what ""} {cursor "watch"}} {
		global tcl_platform

		if {$tcl_platform(platform) == "windows"} {
			update
		}

		if {$what == ""} {
			set what "."
		}

		set host_list $what
		sn_blt_busy hold $what -cursor $cursor

		if {$tcl_platform(platform) != "windows"} {
			update idletasks;	# On windows it is not necessary !
		}
	}

	method release {} {
		sn_blt_busy release $host_list

		set host_list {}
	}

	method forget {} {
		sn_log -l 2 "Busy: forget $host_list"

		sn_blt_busy release $host_list

		set host_list {}
	}

	protected host_list {}
	protected others {}

	common busy
}

#
# My blt_busy
#
set busywidgets "Button Canvas Checkbutton Entry Listbox Menu Menubutton Radiobutton Scale Scrollbar Text TreeTable"

proc sn_blt_busy args {
	global busychilds busyhosts tcl_platform

	set type [lindex $args 0]
	set win [lindex $args 1]
	if {$win == ""} {
		set win "."
	}
	set off [lsearch -exact $args "-cursor"]
	if {$off != -1} {
		set cursor [lindex $args [expr $off + 1]]
	} else {
		set cursor watch
	}
	set nodisable [lsearch -exact $args "-nodisable"]

	if {![winfo exists $win]} {
		#tk_x_events
		return
	}

	if {![info exists busyhosts]} {
		set busyhosts {};
	}

	switch $type {
	"hold_update" -
	"hold" {
		#
		# Add to busy hosts
		#
		if {[lsearch -exact $busyhosts $win] < 0} {
			lappend busyhosts $win
		} else {
			sn_log "Busy already being hold for: $win, trace: [info level -1]"
			return
		}

		set busychilds($win) [mx_get_children -mapped -cursor $cursor $win]

		if {$tcl_platform(platform) != "windows" && $type == "hold_update"} {
			update idletasks;	# On windows it is not necessary !
		}

		if {$nodisable == -1} {
			tk_x_events disable;	# Disable X input events!
		}

#		sn_log -l 3 "Busy holding from \"$win\": [join $busychilds($win) "\n"]"
	}

	"hosts" {
		return $busyhosts
		}

	"status" {
			return [info exists busychilds($win)]
		}
	"forget" -
	"release" {
		#
		# Remove from busy hosts
		#
		set posn [lsearch -exact $busyhosts $win]
		if {$posn != -1} {
			set busyhosts [lreplace $busyhosts $posn $posn]
		}  else {
			sn_log "Busy for \"$win\" has already been released, trace: [info level -1]"
			return
		}
#		sn_log -l 3 "Busy releasing of \"$win\": [join $busychilds($win) "\n"]"

		# Restore the saved cursors and enable the X input events!
		tk_restore_cursors -reset $busychilds($win)

		unset busychilds($win)
	  }
	}
}

proc watch {{on n} {win .}} {
	global tcl_platform
	#make sure, that watch y/n is not multiple called, when this
	#happens, it will block SN.
	#the following variable make sure, that watch y and watch n is
	#called only once (and in the correct order watch y ... watch n).
	global watch_num_calls
	
	if {$on == "y"} {
		#already called
		if {! [info exists watch_num_calls($win)]} {
			sn_blt_busy hold_update $win
			set watch_num_calls($win) 1
		} else {
			sn_log "WARNING: (watch y $win) already called"; flush stderr
		}
	} else {
		#variable makes sure, that watch y has been realy called.
		if {[info exists watch_num_calls($win)]} {
			if {$tcl_platform(platform) == "windows"} {
				update idletasks;		# Important !
			}
			sn_blt_busy release $win
			catch {unset watch_num_calls($win)}
		} else {
			sn_log "WARNING: (watch n $win) wrongly called"; flush stderr
		}
	}
}

