# 
#	(c) 1997, Michel Beaudouin-Lafon, mbl@lri.fr
#
#	debug.tcl	debugger pour Tcl/Tk
#


# (re-)create debug interpreter, load Tk into it
catch {interp delete debug}
interp create debug
load {} Tk debug

#--------  define the Debug namespace with the procs that need to be aliased
namespace eval Debug {
	# variable used to select widget
	variable pickWidget {}
}

# eval
proc Debug::EvalMain {args} {
	eval $args
}

# ---- debug simple variables

# assign a simple variable
proc Debug::SetVar {varName level value} {
	upvar $level $varName var
	set var $value
	return $var
}

# set a trace on a variable and return its current value
proc Debug::SetVarTrace {varName level args} {
	upvar $level $varName var
	trace variable var wu [namespace code "TraceVarProc $varName $level $args"]
	
	# return current value
	if [info exist var] {
		return $var
	} else {
		return "(unset)"
	}
}

# trace proc called when variable set or unset : pass new state over to debug interpreter
proc Debug::TraceVarProc {varName level args name1 name2 op} {
	upvar 2 $name1 var
	if {$op == "u"} {
		set value "(unset)"
	} else {
		set value $var
	}
	debug eval [concat ::Debug::SpyVarProc $varName $level $args [list $value] $op]
}

# unset a trace 
proc Debug::UnsetVarTrace {varName level args} {
	upvar $level $varName var
	trace vdelete var wu [namespace code "TraceVarProc $varName $level $args"]
}

#---- debug array variables

# procs used by SpyArray to get/set the value of an element of the array
proc Debug::GetArray {arrayName level index} {
	upvar $level $arrayName array
	return $array($index)
}

proc Debug::SetArray {arrayName level index value} {
	upvar $level $arrayName array
	set array($index) $value
}

# set a trace on an array and return its current value
proc Debug::SetArrayTrace {arrayName level args} {
	upvar $level $arrayName array
	trace variable array wu [namespace code "TraceArrayProc $arrayName $level $args"]
	
	# return array contents
	set value {}
	foreach index [lsort [array names array]] {
		lappend value $index $array($index)
	}
	return $value
}

# trace proc called when array set or unset : pass new state over to debug interpreter
proc Debug::TraceArrayProc {arrayName level args name1 name2 op} {
	upvar 2 $name1 array
	if {$op == "u" && $name2 == ""} {
		set value {}
	} else {
		set value {}
		set op "w"
		foreach index [lsort [array names array]] {
			lappend value $index $array($index)
		}
	}
	debug eval [concat ::Debug::SpyArrayProc $arrayName $level $args [list $value] $op]
}

# unset a trace 
proc Debug::UnsetArrayTrace {arrayName level args} {
	upvar $level $arrayName array
	trace vdelete var wu [namespace code "TraceArrayProc $arrayName $level $args"]
}

# ---- debug widgets

# select a widget by clicking on it and return its name
#
proc Debug::PickWidget {} {
	# create a unique widget to set the grab on
	set unique 1
	set gw .debug$unique
	while [winfo exist $gw] {
		incr unique
		set gw .debug$unique
	}
	# note that we don't need to make it visible for the grab to work!
	frame $gw
	grab set $gw
	
	# define bindings so that we can select the widget by clicking on it
	# it's name is stored in the variable pickWidget
	variable pickWidget
	set pickWidget {}
	bind $gw <ButtonPress-1> {
		set ::Debug::pickWidget [winfo containing %X %Y]
		break
	}
	
	# wait for selection
	tkwait variable ::Debug::pickWidget
	
	# undo the grab, destroy the widget used to set the grab and return the selected widget
	bind $gw <ButtonPress-1> {}
	grab release $gw
	destroy $gw
	return $pickWidget
}

# --- procs
proc Debug::GetProcArg {procName arg} {
	if [info default $procName $arg default] {
		return [list [list $arg $default]]
	} else {
		return "$arg "
	}
}

# ---- call stack
proc Debug::GetCallStack {{skip 1}} {
	set stack {}
	set maxlevel [info level]
	set index 0
	for {set level [expr $maxlevel - $skip]} {$level > 0} {incr level -1} {
		set call [info level $level]
		set vars {}
		foreach var [uplevel \#$level info vars] {
			if [uplevel \#$level array exist $var] {
				lappend vars [list array $var]
			} else {
				lappend vars [list var $var]
			}
		}
		lappend stack [list $level $call $vars]
	}
	return $stack
}

proc breakpoint {{msg {}}} {
	debug eval [list ::Debug::Breakpoint $msg [::Debug::GetCallStack 2]]
}

# ------- alias the procs needed by the debug interpreter
foreach proc {EvalMain 
		SetVar SetVarTrace UnsetVarTrace 
		GetArray SetArray SetArrayTrace UnsetArrayTrace 
		PickWidget
		GetProcArg
} {
	debug alias ::Debug::$proc ::Debug::$proc
}

# ======== source code for the debug interpreter
debug eval {

wm withdraw .

namespace eval Debug {
	# counter to generate unique widget names
	variable dbgNum 1
	
	# current content of names entry
	variable names
	# whether to display the global lists in the main control panel
	variable displayGlobals 0
	
	# list of global var names that shouldn't be displayed
	variable excludeGlobals {}
	# list of proc names that shouldn't be displayed
	variable excludeProcs {}
	# list of widget names that shouldn't be displayed
	variable excludeWidgets {}
	# init them with the list of predefined globals and procs
	# ### TBD
	
	# array storing information about each stack entry
	variable stackInfo
	
	# variable used to continue after a breakpoint
	variable doContinue 0
}

# -------- utility procs
#

# parralel assignement : assign a list of values to a list of variable, e.g.
#	lset {a b c} {1 2 3}
#
proc Debug::lset {lvars lvals} {
	uplevel [list foreach $lvars $lvals {}]
}

# create a new toplevel debugging window and returns its pathname
#
proc Debug::NewTopLevel {{title "Debug"}} {
	variable dbgNum
	set top [toplevel .debug.dbg$dbgNum]
	wm title $top $title
	incr dbgNum
	return $top
}

# create a scrolling list with name "name" in widget "parent"
# if button is non empty, it is the pathname of the button that is invoked
# when an element in the list is double-clicked.
# return pathname of frame containing scrolling list
#
proc Debug::NewScrollingList {parent name {button {}}} {
	# enclosing frame
	frame $parent.$name
	
	# list and scrollbar
	listbox $parent.$name.list -yscrollcommand "$parent.$name.sb set"
	scrollbar $parent.$name.sb -command "$parent.$name.list yview"
	pack $parent.$name.list -side left -expand on -fill both
	pack $parent.$name.sb -side left -fill y
	
	# default button
	if {$button != {}} {
		# invoke button on double click
		bind $parent.$name.list <Double-ButtonPress-1> "$button invoke"
		# ensure button is active only when selection is non empty
		bind $parent.$name.list <ButtonRelease-1> [namespace code "EnableDisableButton $button $parent.$name.list"]
	}
	
	return $parent.$name
}

# pack a row of buttons in parent widget
#
proc Debug::ButtonRow {parent args} {
	foreach button $args {
		pack $parent.$button -side right -padx 5 -pady 5
	}
}

# update button state according to state of selection in the list
#
proc Debug::EnableDisableButton {button list} {
	if {[$list curselection] == {}} {
		$button configure -state disabled
	} else {
		$button configure -state normal
	}
}

# disable all the widgets in a subtree
#
proc Debug::DisableTree {root} {
	catch {$root configure -state disabled}
	foreach child [winfo children $root] {
		DisableTree $child
	}
}

# create a widget to edit an index/value pair
# parent is the parent widget, name is the name of the new frame containing the widget
# indexMsg and valueMsg are the text strings for the labels
# getProc is the proc used to get the value at a given index. It is called after appending the index to get
# setProc is the proc used to set the value at a given index. It is called after appending the index and value
#
proc Debug::NewIndexValueWidget {parent name indexMsg valueMsg getProc setProc} {
	set frame [frame $parent.$name]
	
	# create widgets : a label and edit field for the index, a label and edit field for the value, and 3 buttons
	label $frame.indexlbl -text $indexMsg
	entry $frame.index -width 20
	label $frame.valuelbl -text $valueMsg
	entry $frame.value -width 20
	button $frame.get -text "Get" -command [namespace code "GetIndexValue $frame $getProc"]
	button $frame.set -text "Set" -command [namespace code "SetIndexValue $frame $setProc"]
	button $frame.clear -text "Clear" -command "$frame.index delete 0 end; $frame.value delete 0 end"
	
	# place them using a grid
	grid $frame.indexlbl -row 0 -column 0 -sticky e -padx 2 -pady 2
	grid $frame.index -row 0 -column 1 -columnspan 3 -sticky ew -padx 2 -pady 2
	grid $frame.valuelbl -row 1 -column 0 -sticky e -padx 2 -pady 2
	grid $frame.value -row 1 -column 1 -columnspan 3 -sticky ew -padx 2 -pady 2
	grid $frame.clear -row 2 -column 0 -sticky e -padx 2 -pady 2
	grid $frame.get -row 2 -column 2 -sticky e -padx 2 -pady 2
	grid $frame.set -row 2 -column 3 -sticky e -padx 2 -pady 2
	grid columnconfigure $frame 1 -weight 1
	
	# define bindings for the entry fields
	bind $frame.index <Key-Return> "$frame.get invoke; focus $frame.value; $frame.value selection range 0 end"
	bind $frame.value <Key-Return> "$frame.set invoke; $frame.value selection range 0 end"
	
	return $frame
}

# proc used by NewIndexValueWidget to set a value
proc Debug::SetIndexValue {frame setProc} {
	set index [$frame.index get]
	set value [$frame.value get]
	lappend setProc $index $value
	eval $setProc
}

# proc used by NewIndexValueWidget to get a value
proc Debug::GetIndexValue {frame getProc} {
	set index [$frame.index get]
	lappend getProc $index
	if [catch {eval $getProc} value] {
		$frame.value delete 0 end
		$frame.value insert 0 $value
	} else {
		$frame.value delete 0 end
		$frame.value insert 0 $value
	}
}

# scrolled area.
# pour un widget qui sait scroller, on ecrit :
#	listbox .l -yscrollcommand ".sb set"
#	scrollbar .sb -command ".l yview"
#
# pour un scrolled area, on ecrit :
# frame .f
# frame .f.scrolled
# ScrolledAreaSetYScrollCommand .f.scrolled ".sb set"
# scrollbar .sb -command "ScrolledAreaYView .f.scrolled"
#
# ce que l'on voudrait :
# scrolled .f -yscrollcommand ".sb set"
# scrollbar .sb -command ".f yview"
#
# pour ca, scrolled doit creer un frame, et il faut renommer la 
# commande qui implemente le widget (.f ici) pour "trapper"
# les commandes comme .f yview...

# adjust the scrolled widget relative to its parent
#
proc ScrolledAreaYView {scrolled args} {
	# args is of the form:
	#	moveto fraction
	#	scroll nn unit
	#	scroll nn page
	
	set height [winfo height $scrolled]
	set hpage [winfo height [winfo parent $scrolled]]
	
	set cmd [lindex $args 0]
	switch -glob -- $cmd {
		m* {
			# move to given position
			set fraction [lindex $args 1]
			# distance from top of scrolled widget to top of view area
			set top [expr int(double($fraction) * double($height))]
		} 
		s* {
			# scroll by count units
			set count [lindex $args 1]
			set unit [lindex $args 2]
			# distance from top of scrolled widget to top of view area
			set top [expr - [winfo y $scrolled]]
			# update top according to type of scroll
			switch -glob -- $unit {
				u* {
					# scroll by units (1 unit = 5pixels here)
					set top [expr $top + 5 *$count]
				}
				p* {
					# scroll by pages (actually a bit less)
					set top [expr $top + $count * ($hpage -5)]
				}
			}
		}
	}
	
	# make sure the scrolled widget is within the view area
	if {$top > $height - $hpage} {
		set top [expr $height - $hpage]
	}
	if {$top < 0} {
		set top 0
	}
	
	# place widget and update display
	place configure $scrolled -y [expr -$top]
	update
}

# define callback for scrolled widget, to be called when its geometry or that of the view area changes.
# this is normally used to update a scrollbar
proc ScrolledAreaSetYScrollCommand {scrolled script} {
	# evaluate "script first last" when the position of the scrolled
	# area relative to its parent is changed
	bind $scrolled <Configure> [list UpdateScroll $scrolled $script]
	bind [winfo parent $scrolled] <Configure> [list UpdateScroll $scrolled $script]
	place $scrolled -x 0 -y 0
}

# event handler called when the geometry of the scrolled widget changes:
# call callback script with new position relative to parent
proc UpdateScroll {scrolled script} {
	# height of viewing area
	set hpage [winfo height [winfo parent $scrolled]]
	set height [winfo height $scrolled]
	set top [expr - [winfo y $scrolled]]
	
	set from [expr double($top) / double($height)]
	set to [expr (double($top) + double($hpage)) / double($height)]
	if {$to > 1.0} {
		set to 1.0
	}
#puts "update scroll : from=$from to=$to"
	eval $script $from $to
}

# -------- toplevel UI
#

#	initialize debug package
#
proc Debug::Init {} {
	# clean up
	catch {destroy .debug}
	
	# create main control panel
	toplevel .debug
	wm title .debug "Debug Control Panel"
	wm geometry .debug +20+20

	# entry field for list a var names
	set frame [frame .debug.names]
	label $frame.label -text "Variables / arrays / procs / widgets to spy :"
	entry $frame.names -width 25 -textvariable ::Debug::names
	bind $frame.names <Key-Return> "$frame.spy invoke"
	button $frame.spy -text "Spy" -command [namespace code {eval Spy $names}]
	button $frame.pickwidget -text "Pick widget" -command [namespace code "PickWidgetMode $frame.pickwidget"]
	pack $frame.label -side top -anchor w -padx 2 -pady 2
	pack $frame.names -side left -expand on -fill x -padx 2 -pady 2
	ButtonRow $frame pickwidget spy
	pack $frame -side top -fill x
	
	# toggle global state
	checkbutton .debug.toggle -text "More" -variable ::Debug::displayGlobals -command [namespace code {
		if {$displayGlobals} {
			ListVars
			ListProcs
			ListWidgetTree
		} else {
			destroy .debug.varlist .debug.proclist .debug.widgettree
		}
	}]
	pack .debug.toggle -side left -padx 2 -pady 2 -anchor n
}

# spy all variables/arrays/procs/widgets in args in a new window and return its pathname
# if an argument starts with "." it is considered a widget
# if an arguemtn ends with {} it is considered a procedure
# if an argument ends with () it is considered an array
# other arguments are considered variables unless they are already declared as arrays
#
proc Debug::Spy {args} {
	# do noting if there is no argument
	if {[llength $args] == 0} {
		return
	}
	
	# let the spy proc create the toplevel window if there is only one argument
	# otherwise create the toplevel window
	if {[llength $args] == 1} {
		set parent {}
	} else {
		set parent [NewTopLevel "Spy window"]
	}
	
	# scan each argument, creating the appropriate spy widget
	variable dbgNum
	foreach varName $args {
		# create a frame if there is more than one item
		if {$parent != {}} {
			set frame [frame $parent.spy$dbgNum]
			incr dbgNum
			pack $frame -side top -expand on -fill both
		} else {
			set frame $parent
		}
		
		global $varName
		if [string match .* $varName] {
			# name starts with . : it's a widget
			SpyWidget $varName $frame
		} elseif [string match *\{\} $varName] {
			# consider it a proc
			# ### problem because we use an independant window and we have already created a frame...
			set procName [string trimright $varName \{\}]
			EditProc $procName
		} elseif [EvalMain uplevel #0 array exists $varName] {
			# name is declared as an array
			SpyArray $varName #0 $frame
		} else {
			if [string match *() $varName] {
				# name ends with () : it's an array
				set varName [string trimright $varName ()]
				SpyArray $varName #0 $frame
			} else {
				# all other cases : it's a variable
				SpyVar $varName #0 $frame
			}
		}
	}
	return $parent
}

# -------- spying variables
#

# create or update the list of global variables
#
proc Debug::ListVars {} {
	set parent .debug.varlist
	
	# create window if it does not exist
	if {! [winfo exist $parent]} {
##		toplevel $parent
##		wm title $parent "Global vars"
		frame $parent
		label $parent.title -text "Global variables"
		pack $parent.title -side top -anchor w
		pack $parent -side left -expand on -fill both -padx 5
##		
		set vars [NewScrollingList $parent vars $parent.spyvar]
		$vars.list configure -selectmode extended
		pack $vars -side top -expand on -fill both
		
		button $parent.update -text "Update" -command [namespace code {ListVars}]
		button $parent.spyvar -text "Spy var" -command [namespace code {
				# open a spy variables window for all the selected variables
				set vars {}
				foreach index [.debug.varlist.vars.list curselection] {
					lappend vars [.debug.varlist.vars.list get $index]
				}
				eval Spy $vars
		}]
		ButtonRow $parent update spyvar
	}
	
	# update contents of list
	$parent.vars.list delete 0 end
	foreach var [lsort [EvalMain namespace eval :: info globals]] {
		$parent.vars.list insert end $var
	}
	EnableDisableButton $parent.spyvar $parent.vars.list
}

# ---- spying simple variables

# spy variable varName in widget parent.
# if parent is empty (the default) a new toplevel window is created.
# level specifies the level in the stack at which the variable is defined
# return pathname of frame containing variable.
#
proc Debug::SpyVar {varName {level #0} {parent {}}} {
	if {$parent == ""} {
		set parent [NewTopLevel Variable]
	}
	
	# create label and entry area
	set lbl [label $parent.name -text $varName]
	set val [entry $parent.val -width 15]
	pack $lbl -side left -anchor e -padx 5 -pady 5
	pack $val -side left -expand on -fill both -padx 5 -pady 5
	
	# set trace on var
	set value [SetVarTrace $varName $level $parent]
	
	# init value
	$val insert 0 $value
	
	# define binding to edit variable value
	bind $val <Key-Return> [namespace code "SetSpiedVar $varName $level $val"]
	
	return $parent
}

# trace proc to update var spy window
#
proc Debug::SpyVarProc {varName level parent value op} {
	# if the widget has been destroyed : remove the trace
	if {! [winfo exist $parent]} {
		UnsetVarTrace $varName $level $parent
		return
	}
	
	# if the var is unset : disable window
	if {$op == "u"} {
		$parent.val delete 0 end
		$parent.val insert 0 "(unset)"
		DisableTree $parent
		return
	}
	
	# other operation : update display
	$parent.val delete 0 end
	$parent.val insert 0 $value
}

# proc used by SpyVar to set the value of a variable
proc Debug::SetSpiedVar {varName level valWidget} {
	set val [$valWidget get]
	set new [SetVar $varName $level $val]
	if {$new != $val} {
		$valWidget delete 0 end
		$valWidget insert 0 $new
	}
	$valWidget selection range 0 end
}

# ---- spying arrays
#

# spy the contents of an array.
# level is the level at which the array is defined
# if parent is empty (the default) a new toplevel window is created.
# return pathname of frame containing array.
#
proc Debug::SpyArray {arrayName {level #0} {parent {}}} {
	if {$parent == {}} {
		set parent [NewTopLevel "Array $arrayName"]
	} else {
		label $parent.title -text "Array $arrayName"
		pack $parent.title -side top -anchor w -padx 5 -pady 5
	}
	
	# scrolling list to display contents of array
	set contents [NewScrollingList $parent array]
	pack $contents -side top -expand on -fill both
	
	# edit widget for changing array values
	set edit [NewIndexValueWidget $parent edit "index" "value" \
		[list [namespace code "GetArray $arrayName $level"]] \
		[list [namespace code "SetArray $arrayName $level"]]
	]
	pack $edit -side top -fill x
	bind $contents.list <Double-ButtonPress-1> [namespace code "SetArrayEditFields $arrayName $level $parent"]
	
	# set trace on array
	set value [SetArrayTrace $arrayName $level $parent]
	
	# initialize contents
	foreach {index val} $value {
		$contents.list insert end "$index -> $val"
	}
	
	return $parent
}

# trace proc to update array spy window
#
proc Debug::SpyArrayProc {arrayName level parent value op} {
	# if the widget has been destroyed : remove the trace
	if {! [winfo exist $parent]} {
		UnsetArrayTrace $arrayName $level $parent
		return
	}
	
	# if the array is unset : disable window
	if {$op == "u"} {
		DisableTree $parent
		return
	}
	
	# other operation : update display
	$parent.array.list delete 0 end
	foreach {index val} $value {
		$parent.array.list insert end "$index -> $val"
	}
}

# proc used by SpyArray to set edit fields values when double-clicking an item in the list
proc Debug::SetArrayEditFields {arrayName level parent} {
	set sel [$parent.array.list curselection]
	if {$sel == {}} {
		return
	}
	
	set index [lindex [$parent.array.list get $sel] 0]
	set val [GetArray $arrayName $level $index]
	
	$parent.edit.index delete 0 end
	$parent.edit.index insert 0 $index
	
	$parent.edit.value delete 0 end
	$parent.edit.value insert 0 $val
}

# -------- spying widgets
#

# create or update the widget tree
#
proc Debug::ListWidgetTree {} {
	set parent .debug.widgettree
	
	# create window if it does not exist
	if {! [winfo exist $parent]} {
##		toplevel $parent
##		wm title $parent "Widget tree"
		frame $parent
		label $parent.title -text "Widget tree"
		pack $parent.title -side top -anchor w
		pack $parent -side left -expand on -fill both -padx 5
##
		
		set tree [NewScrollingList $parent tree $parent.spywidget]
		$tree.list configure -selectmode extended
		pack $tree -side top -expand on -fill both
		
		button $parent.update -text "Update" -command [namespace code ListWidgetTree]
		button $parent.spywidget -text "Spy widget" -command [namespace code {
				# open a spy widget window on each selected widget
				set widgets {}
				foreach index [.debug.widgettree.tree.list curselection] {
					lappend widgets [lindex [.debug.widgettree.tree.list get $index] 0]
				}
				eval Spy $widgets
		}]
		ButtonRow $parent update spywidget
	}
	
	# update contents of list
	$parent.tree.list delete 0 end
	UpdateWidgetSubTree $parent.tree.list . 0
	EnableDisableButton $parent.spywidget $parent.tree.list
}

# auxiliary proc for ListWidgetTree
#
proc Debug::UpdateWidgetSubTree {list root level} {
	$list insert end "$root - [EvalMain winfo class $root]"
	incr level 4
	foreach widget [EvalMain winfo children $root] {
		UpdateWidgetSubTree $list $widget $level
	}
}

# pick a widget anywhere on the screen
#
proc Debug::PickWidgetMode {button} {
	global tcl_platform
	
	# feedback : active button until widget is selected
	if {$tcl_platform(platform) == "macintosh"} {
		$button configure -state active
	} else {
		$button configure -relief sunken
	}
	
	set widget [PickWidget]
	
	# reset button state
	if {$tcl_platform(platform) == "macintosh"} {
		$button configure -state normal
	} else {
		$button configure -relief raised
	}
	
	# select widget in widget tree
	set tree .debug.widgettree.tree
	if [winfo exist $tree] {
		set i 0
		# find widget in list
		foreach item [$tree.list get 0 end] {
			if {$widget == [lindex $item 0]} {
				# select it and make it visible
				$tree.list select clear 0 end
				$tree.list select set $i
				$tree.list see $i
				break
			}
			incr i
		}
	}
	
	# display spy window for the widget that was just clicked
	SpyWidget $widget
}

# create a window displaying the state of a widget
# if parent is empty (the default) a new toplevel window is created.
# return pathname of frame containing widget.
#
proc Debug::SpyWidget {widget {parent {}}} {
	if {! [EvalMain winfo exists $widget]} {
		return
	}
	
	set title "[EvalMain winfo class $widget] $widget"
	if {$parent == {}} {
		set parent [NewTopLevel $title]
	} else {
		label $parent.title -text $title
		pack $parent.title -side top -anchor w -padx 5 -pady 5
	}
	
	# scrolling list to display contents of array
	set opts [NewScrollingList $parent opts]
	pack $opts -side top -expand on -fill both
	
	# button to refresh content
	button $parent.update -text Update -command [namespace code "UpdateWidget $widget $parent"]
	pack $parent.update -side top -anchor e -padx 5 -pady 5
	
	# edit fields to change options
	set edit [NewIndexValueWidget $parent edit "option" "value" \
		[list [namespace code "GetOption $widget"]] \
		[list [namespace code "SetOption $widget $parent"]]
	]
	pack $edit -side top -fill x
	bind $opts.list <Double-ButtonPress-1> [namespace code "SetOptionsEditFields $widget $parent"]
	
	# init content
	UpdateWidget $widget $parent
	return $parent
}

# procs used by SpyWidget to get/set the value of an option
proc Debug::GetOption {widget option} {
	return [EvalMain $widget cget $option]
}

proc Debug::SetOption {widget parent option value} {
	EvalMain $widget configure $option $value
	UpdateWidget $widget $parent
}

# proc used by SpyWidget to set edit fields values when double-clicking an option in the list
proc Debug::SetOptionsEditFields {widget parent} {
	set sel [$parent.opts.list curselection]
	if {$sel == {}} {
		return
	}
	
	set option [lindex [$parent.opts.list get $sel] 0]
	
	$parent.edit.index delete 0 end
	$parent.edit.index insert 0 $option
	
	$parent.edit.value delete 0 end
	$parent.edit.value insert 0 [EvalMain $widget cget $option]
}

# update the display of a widget spy window
#
proc Debug::UpdateWidget {widget parent} {
	if {! [EvalMain winfo exists $widget]} {
		destroy $widget
	}
	
	# display options
	$parent.opts.list delete 0 end
	foreach options [EvalMain $widget configure] {
		foreach {opt name class dflt val} $options {}
		if {$val != $dflt} {
			set str [list $opt $val]
			$parent.opts.list insert end $str
		}
	}
}

# -------- spying procedures
#

# create or update the list of procedures
#
proc Debug::ListProcs {} {
	set parent .debug.proclist
	
	# create window if it does not exist
	if {! [winfo exist $parent]} {
##		toplevel $parent
##		wm title $parent "Procedures"
		frame $parent
		label $parent.title -text "Procedures"
		pack $parent.title -side top -anchor w
		pack $parent -side left -expand on -fill both -padx 5
##
		
		set procs [NewScrollingList $parent procs $parent.edit]
		$procs.list configure -selectmode extended
		pack $procs -side top -expand on -fill both
		
		button $parent.update -text "Update" -command [namespace code ListProcs]
		button $parent.edit -text "Edit proc" -command [namespace code "EditSelectedProcs $procs.list"]
		ButtonRow $parent update edit
	}
	
	# update contents of list
	$parent.procs.list delete 0 end
	foreach proc [lsort [EvalMain namespace eval :: info procs]] {
		$parent.procs.list insert end "$proc [EvalMain info args $proc]"
	}
	EnableDisableButton $parent.edit $parent.procs.list
}

# called by ListProcs to edit selected procs
proc Debug::EditSelectedProcs {listwidget} {
	foreach index [$listwidget curselection] {
		EditProc [lindex [$listwidget get $index] 0]
	}
}

# create an edit window for a procedure
#
proc Debug::EditProc {procName} {
	set parent [NewTopLevel "proc $procName"]
	
	# create the frame for the texte edit
	frame $parent.text
	text $parent.text.edit -yscrollcommand "$parent.text.sb set" -borderwidth 2 -relief sunken
	scrollbar $parent.text.sb -command "$parent.text.edit yview"
	pack $parent.text.edit -side left -expand on -fill both
	pack $parent.text.sb -side left -fill y
	pack $parent.text -side top -expand on -fill both
	
	# insert proc in text edit
	set edit $parent.text.edit
	$edit delete 1.0 end
	$edit insert end "proc $procName \{ "
	foreach arg [EvalMain info args $procName] {
		 $edit insert end [GetProcArg $procName $arg]
	}
	$edit insert end "\} \{"
	$edit insert end [EvalMain info body $procName]
	$edit insert end "\}"
	
	# buttons to define the contents
	button $parent.define -text "Define" -command [namespace code "DefineProc $parent.text.edit"]
	ButtonRow $parent define
}

proc Debug::DefineProc {textWidget} {
	EvalMain uplevel #0 [$textWidget get 1.0 end]
}

# ---- tracing the call stack
#

# display the current call stack
# if parent is empty (the default) a default toplevel window is used (.debug.stack).
# return pathname of frame containing callstack.
#
proc Debug::Breakpoint {msg callStack} {
	set parent .debug.stack
	if [winfo exists $parent] {
		set stack $parent.scrolled.stack
		eval destroy [winfo children $stack]
	} else {
		toplevel $parent
		wm title $parent "Call stack"
		
		# message
		label $parent.msg -text "Breakpoint"
		pack $parent.msg -side top -anchor w -padx 5 -pady 5
	
		# continue button
		variable doContinue
		set doContinue 0
		button $parent.cont -text "Continue" -command [namespace code {
			variable doContinue
			set doContinue 1
			eval destroy [winfo children .debug.stack.scrolled.stack]
			.debug.stack.msg configure -text "Running"
		}]
		pack $parent.cont -side top -anchor e -padx 2 -pady 2
	
		# continue evaluation if window is destroyed
		bind $parent <Destroy> [namespace code {
			variable doContinue
			set doContinue 1
		}]
		
		# scrolling frame to display stack
		set scrolled [frame $parent.scrolled -borderwidth 2 -relief sunken -width 150 -height 300]
		set stack [frame $scrolled.stack]
		set sb [scrollbar $parent.sb -orient vertical -command "ScrolledAreaYView $stack"]
		ScrolledAreaSetYScrollCommand $stack "$sb set"

		pack $scrolled -side left -expand on -fill both
		pack $sb -side left -fill y
}
		
	# message
	if {$msg == {}} {
		set msg "Breakpoint"
	}
	$parent.msg configure -text $msg
	
	# create stack trace
	foreach stackFrame $callStack {
		lset {level call vars} $stackFrame
		
		set frame [frame $stack.level$level]
		pack $frame -side top -fill x
		label $frame.call -text $call -anchor w -fg white -bg black
		pack $frame.call -side top -fill x
		bind $frame.call <Double-ButtonPress-1> [namespace code "EditProc [lindex $call 0]"]
		
		foreach var $vars {
			lset {type varName} $var
			
			set spy [frame $frame.var-$varName]
			pack $spy -side top -fill x
			if {$type == "array"} {
				SpyArray $varName \#$level $spy
			} else {
				SpyVar $varName \#$level $spy
			}
		}
	}
	
	# wait until hitting continue or closing window
	# code can be executed in the context of the currently active procedure
	# through the bpExec variable. This is used to set local variables.
	$parent.cont configure -state normal
	variable doContinue
	set doContinue 0
puts "breakpoint..."
	tkwait variable ::Debug::doContinue
puts "continuing..."
	$parent.cont configure -state disabled
	
	return $parent
}

# --- end of debug interpreter source code
}

# -------- init package
#

# create control panel
#
debug eval Debug::Init