share/insight1.0/debugwin.itb - toolchains/skids - Git at Google

 # Debug window for GDBtk.
 # Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
 #
 # This program is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License (GPL) as published by
 # the Free Software Foundation; either version 2 of the License, or (at
 # your option) any later version.
 #
 # This program 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.


 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::constructor
 #
 # SYNOPSIS:	constructor::args
 #
 # DESC:		Creates the debug window
 #
 # ARGS:		None are used yet.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::constructor {args} {
   debug $args
   window_name "Insight Debug" "Debug"

   build_win
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::destructor
 #
 # SYNOPSIS:	Not called by hand
 #
 # DESC:		Destroys the debug window
 #
 # ARGS:		None
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::destructor {} {
   # notify debug code that window is going away
   ::debug::debugwin ""
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::reconfig
 #
 # SYNOPSIS:	Reconfigure callback
 #
 # DESC:		Fixes up window colors
 #
 # ARGS:		None
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::reconfig {} {
   # This keeps the Debug window using its unique black background.
   # Otherwise, a reconfigure event will color it to match the other windows
   $itk_interior.s configure -textbackground black
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::build_win
 #
 # SYNOPSIS:	build_win
 #
 # DESC:		Creates the Debug Window. Reads the contents of the debug log
 #		file, if it exists. Notifies the debug functions in ::debug
 #		to send output here.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::build_win {} {
   global gdb_ImageDir GDBTK_LIBRARY

   set top [winfo toplevel $itk_interior]

   # initialize the gdbtk_de array
   if {![info exists ::gdbtk_de]} {
     set ::gdbtk_de(ALL) 1
     set ::gdbtk_de(ERRORS_ONLY) 0
     set ::gdbtk_de(others) 0
     set ::gdbtk_de(filter_var) ALL
   }

   # create menubar
   set menu [menu $itk_interior.m  -tearoff 0]
   $menu add cascade -menu $menu.file -label "File" -underline 0
   set m [menu $menu.file]
   $m add command -label "Clear" -underline 1 \
     -command [code $this _clear]
   $m add command -label "Mark Old" -underline 1 \
     -command [code $this _mark_old]
   $m add separator
   $m add command -label "Save" -underline 0 \
     -command [code $this _save_contents]
   $m add separator
   $m add command -label "Close" -underline 0 \
     -command "::debug::debugwin {};delete object $this"
   $menu add cascade -menu $menu.trace -label "Trace"
   set m [menu $menu.trace]
   $m add radiobutton -label Start -variable ::debug::tracing -value 1
   $m add radiobutton -label Stop -variable ::debug::tracing -value 0
   $menu add cascade -menu $menu.rs -label "ReSource"
   set m [menu $menu.rs]
   foreach f [lsort [glob [file join $GDBTK_LIBRARY *.itb]]] {
     $m add command -label "Source [file tail $f]"\
       -command [list source $f]
   }
   $m add separator
   $m add command -label "Source ALL" -command [code $this _source_all]

   $menu add cascade -menu $menu.opt -label "Options"
   set m [menu $menu.opt]
   $m add command -label "Display" -underline 0 \
     -command [list ManagedWin::open DebugWinDOpts -over $this]
   if {!$::debug::initialized} {
     $menu entryconfigure 1 -state disabled
     $menu add cascade -label "     Tracing Not Initialized" -foreground red \
       -activeforeground red
   }
   $menu add cascade -menu $menu.help -label "Help" -underline 0
   set m [menu $menu.help]
   $m add command -label "Debugging Functions" -underline 0 \
     -command {open_help debug.html}

   $top configure -menu $menu

   iwidgets::scrolledtext $itk_interior.s -hscrollmode static \
     -vscrollmode static -wrap none -textbackground black -foreground white
   set _t [$itk_interior.s component text]
   pack $itk_interior.s -expand 1 -fill both

   # define tags
   foreach color $_colors {
     $_t tag configure [lindex $color 0] -foreground [lindex $color 1]
   }
   $_t tag configure trace -foreground gray
   $_t tag configure args -foreground blue
   $_t tag configure marked -background grey20

   loadlog

   # now notify the debug functions to use this window
   ::debug::debugwin $this

   # override the window delete procedure so the messages are
   # turned off first.
   wm protocol $top WM_DELETE_WINDOW "::debug::debugwin {};destroy $top"
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::puts
 #
 # SYNOPSIS:	puts {level cls func msg}
 #
 # DESC:		Writes debugging information into the DebugWin. A filter
 #		will be applied to determine if the message should be
 #		displayed or not.
 #
 # ARGS:		level - priority level. See debug::dbug for details.
 #		cls   - class name of caller, for example "SrcWin"
 #		func  - function name of caller
 #		msg   - message to display
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::puts {level cls func msg} {
   # filter. check if we should display this message
   # for now we always let high-level messages through
   if {$level == "I"} {

     # errors and warnings only
     if {$::gdbtk_de(ERRORS_ONLY)} { return }

     # ALL classes except those set
     if {$::gdbtk_de(ALL)} {
       if {[info exists ::gdbtk_de($cls)]} {
 	if {$::gdbtk_de($cls)} {
 	  return
 	}
       } elseif {$::gdbtk_de(others)} {
 	return
       }
     }

     # ONLY the classes set
     if {!$::gdbtk_de(ALL)} {
       if {[info exists ::gdbtk_de($cls)]} {
 	if {!$::gdbtk_de($cls)} {
 	  return
 	}
       } elseif {!$::gdbtk_de(others)} {
 	return
       }
     }
   }

   if {$func != ""} {
     append cls ::$func
   }
   $_t insert end "($cls) " {} "$msg\n" $level
   $_t see insert
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::put_trace
 #
 # SYNOPSIS:	put_trace {enter level func ar}
 #
 # DESC:		Writes trace information into the DebugWin. A filter
 #		will be applied to determine if the message should be
 #		displayed or not.
 #
 # ARGS:		enter - 1 if this is a function entry, 0 otherwise.
 #		level - stack level
 #		func  - function name
 #		ar    - function arguments
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::put_trace {enter level func ar} {
   set x [expr {$level * 2 - 2}]
   if {$enter} {
     $_t insert end "[string range $_bigstr 0 $x]$func " trace "$ar\n" args
   } else {
     $_t insert end "[string range $_bigstr 0 $x]<- $func " trace "$ar\n" args
   }
   $_t see insert
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::loadlog
 #
 # SYNOPSIS:	loadlog
 #
 # DESC:		Reads the contents of the debug log file, if it exists, into
 #		the DebugWin.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::loadlog {} {
   $_t delete 0.0 end
   # Now load in log file, if possible.
   # this is rather rude, using the logfile variable in the debug namespace
   if {$::debug::logfile != "" && $::debug::logfile != "stdout"} {
     flush $::debug::logfile
     seek $::debug::logfile 0 start
     while {[gets $::debug::logfile line] >= 0} {
       while {[catch {set f [lindex $line 0]} f]} {
 	# If the lindex failed its because the remainder of the
 	# list is on the next line.  Get it.
 	if {[gets $::debug::logfile line2] < 0} {
 	  break
 	}
 	append line \n $line2
       }
       if {$f == "T"} {
 	put_trace [lindex $line 1] [lindex $line 2] [lindex $line 3] \
 	  [lindex $line 4]
       } else {
 	puts $f [lindex $line 1] [lindex $line 2] [lindex $line 3]
       }
     }
   }
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::_source_all
 #
 # SYNOPSIS:	_source_all
 #
 # DESC:		Re-sources all the .itb files.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::_source_all {} {
   foreach f [glob [file join $::GDBTK_LIBRARY *.itb]] {
     source $f
   }
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::_clear
 #
 # SYNOPSIS:	_clear
 #
 # DESC:		Clears out the content of the debug window.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::_clear {} {
   $_t delete 1.0 end
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::_mark_old
 #
 # SYNOPSIS:	_mark_old
 #
 # DESC:		Changes the background of the current contents of the window.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::_mark_old {} {
   $_t tag add marked 1.0 "end - 1c"
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWin::_save_contents
 #
 # SYNOPSIS:	_save_contents
 #
 # DESC:		Changes the background of the current contents of the window.
 # -----------------------------------------------------------------------------
 itcl::body DebugWin::_save_contents {} {
   set file [tk_getSaveFile -title "Choose debug window dump file" \
 	      -parent [winfo toplevel $itk_interior]]
   if {$file == ""} {
     return
   }

   if {[catch {::open $file w} fileH]} {
     tk_messageBox -type ok -icon error -message \
       "Can't open file: \"$file\". \n\nThe error was:\n\n\"$fileH\""
     return
   }
   ::puts $fileH [$_t get 1.0 end]

 }

 ###############################################################################
 # -----------------------------------------------------------------------------
 # NAME:		DebugWinDOpts::constructor
 #
 # SYNOPSIS:	constructor
 #
 # DESC:		Creates the Debug Window Options Dialog.
 # -----------------------------------------------------------------------------
 itcl::body DebugWinDOpts::constructor {args} {
     window_name "Debug Window Options"
     build_win
     eval itk_initialize $args
 }

 ###############################################################################
 # -----------------------------------------------------------------------------
 # NAME:		DebugWinDOpts::destructor
 #
 # SYNOPSIS:	Not called by hand
 #
 # DESC:		Destroys the Debug Window Options Dialog.
 # -----------------------------------------------------------------------------
 itcl::body DebugWinDOpts::destructor {} {
 }


 # -----------------------------------------------------------------------------
 # NAME:		DebugWinDOpts::build_win
 #
 # SYNOPSIS:	build_win
 #
 # DESC:		Creates the Debug Window Options Dialog. This dialog allows the
 #		user to select which information is displayed in the debug
 #		window and (eventually) how it looks.
 # -----------------------------------------------------------------------------
 itcl::body DebugWinDOpts::build_win {} {
   wm title [winfo toplevel $itk_interior] "Debug Display Options"
   # initialize here so we can resource this file and update the list
   set _classes {DebugWin RegWin SrcBar SrcWin ToolBar WatchWin EmbeddedWin \
 		  ManagedWin GDBWin StackWin SrcTextWin global \
 		  BpWin TargetSelection ModalDialog ProcessWin \
 		  GDBEventHandler MemWin VarTree}
   set _classes [concat [lsort $_classes] others]

   set f [frame $itk_interior.f]
   set btns [frame $itk_interior.buttons]

   iwidgets::Labeledframe $f.display -labelpos nw -labeltext {Classes}
   set fr [$f.display childsite]
   radiobutton $fr.0 -text "Messages from ALL classes EXCEPT those selected below" \
     -variable ::gdbtk_de(filter_var) -value ALL -command [code $this _all]
   radiobutton $fr.1 -text "Messages from ONLY those classes selected below" \
     -variable ::gdbtk_de(filter_var) -value ONLY -command [code $this _all]
   radiobutton $fr.2 -text "Only WARNINGS and ERRORS" \
     -variable ::gdbtk_de(filter_var) -value ERRORS -command [code $this _all]

   grid $fr.0 -sticky w -padx 5 -pady 5
   grid $fr.1 -sticky w -padx 5 -pady 5
   grid $fr.2 -sticky w -padx 5 -pady 5

   iwidgets::Labeledframe $f.classes
   set fr [$f.classes childsite]

   set i 0
   foreach cls $_classes {
     if {![info exists ::gdbtk_de($cls)]} {
       set ::gdbtk_de($cls) 0
     }
     checkbutton $fr.$i -text $cls -variable ::gdbtk_de($cls)
     incr i
   }

   set k [expr 3*(int($i/3))]
   set more [expr $i - $k]
   set j 0
   while {$j < $k} {
     grid $fr.$j $fr.[expr $j+1] $fr.[expr $j+2] -sticky w -padx 5 -pady 5
     incr j 3
   }
   switch $more {
     1 { grid $fr.$j x x -sticky w -padx 5 -pady 5}
     2 { grid $fr.$j $fr.[expr $j+1] x -sticky w -padx 5 -pady 5}
   }

   pack $f.display -side top -expand 1 -fill both
   pack $f.classes -side top -expand 1 -fill both

   button $btns.ok -text [gettext OK] -width 7 -command [code $this _apply 1] \
     -default active
   button $btns.apply -text "Apply to All"  -width 7 \
     -command [code $this _apply 0]
   if {$::debug::logfile == "" || $::debug::logfile == "stdout"} {
     $btns.apply configure -state disabled
   }
   button $btns.help -text [gettext Help] -width 10 -command [code $this help] \
     -state disabled
   standard_button_box $btns
   bind $btns.ok <Return> "$btns.ok flash; $btns.ok invoke"
   bind $btns.apply <Return> "$btns.apply flash; $btns.apply invoke"
   bind $btns.help <Return> "$btns.help flash; $btns.help invoke"

   pack $btns $f -side bottom -expand 1 -fill both -anchor e
   focus $btns.ok
 }

 # -----------------------------------------------------------------------------
 # NAME:		DebugWinDOpts::_all
 #
 # SYNOPSIS:	_all
 #
 # DESC:		Callback for selecting ALL classes. If the user selects ALL,
 #		deselect all the individual class checkbuttons.
 # -----------------------------------------------------------------------------
 itcl::body DebugWinDOpts::_all {} {
   switch $::gdbtk_de(filter_var) {
     ALL {
       set ::gdbtk_de(ALL) 1
       set ::gdbtk_de(ERRORS_ONLY) 0
       #enable class buttons
       set num 0
       foreach class $_classes {
 	[$itk_interior.f.classes childsite].$num configure -state normal
 	incr num
       }
     }
     ONLY {
       set ::gdbtk_de(ALL) 0
       set ::gdbtk_de(ERRORS_ONLY) 0
       #enable class buttons
       set num 0
       foreach class $_classes {
 	[$itk_interior.f.classes childsite].$num configure -state normal
 	incr num
       }
     }
     ERRORS {
       set ::gdbtk_de(ALL) 0
       set ::gdbtk_de(ERRORS_ONLY) 1
       # disable class buttons
       set num 0
       foreach class $_classes {
 	[$itk_interior.f.classes childsite].$num configure -state disabled
 	incr num
       }
     }
   }
 }


 # -----------------------------------------------------------------------------
 # NAME:		DebugWinDOpts::_apply
 #
 # SYNOPSIS:	_apply
 #
 # DESC:		Callback for the "Apply" button. Loads the contents of the
 #		log file through the new filter into the debug window. The
 #		button is disabled if there is no log file.
 # -----------------------------------------------------------------------------
 itcl::body DebugWinDOpts::_apply { done } {
   set dw [ManagedWin::find DebugWin]
   debug $dw
   if {$dw != ""} {
     $dw loadlog
   }
   if {$done} {
     delete object $this
   }
 }
	# Debug window for GDBtk.
	# Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
	#
	# This program is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License (GPL) as published by
	# the Free Software Foundation; either version 2 of the License, or (at
	# your option) any later version.
	#
	# This program 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.


	# -----------------------------------------------------------------------------
	# NAME: DebugWin::constructor
	#
	# SYNOPSIS: constructor::args
	#
	# DESC: Creates the debug window
	#
	# ARGS: None are used yet.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::constructor {args} {
	debug $args
	window_name "Insight Debug" "Debug"

	build_win
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::destructor
	#
	# SYNOPSIS: Not called by hand
	#
	# DESC: Destroys the debug window
	#
	# ARGS: None
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::destructor {} {
	# notify debug code that window is going away
	::debug::debugwin ""
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::reconfig
	#
	# SYNOPSIS: Reconfigure callback
	#
	# DESC: Fixes up window colors
	#
	# ARGS: None
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::reconfig {} {
	# This keeps the Debug window using its unique black background.
	# Otherwise, a reconfigure event will color it to match the other windows
	$itk_interior.s configure -textbackground black
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::build_win
	#
	# SYNOPSIS: build_win
	#
	# DESC: Creates the Debug Window. Reads the contents of the debug log
	# file, if it exists. Notifies the debug functions in ::debug
	# to send output here.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::build_win {} {
	global gdb_ImageDir GDBTK_LIBRARY

	set top [winfo toplevel $itk_interior]

	# initialize the gdbtk_de array
	if {![info exists ::gdbtk_de]} {
	set ::gdbtk_de(ALL) 1
	set ::gdbtk_de(ERRORS_ONLY) 0
	set ::gdbtk_de(others) 0
	set ::gdbtk_de(filter_var) ALL
	}

	# create menubar
	set menu [menu $itk_interior.m -tearoff 0]
	$menu add cascade -menu $menu.file -label "File" -underline 0
	set m [menu $menu.file]
	$m add command -label "Clear" -underline 1 \
	-command [code $this _clear]
	$m add command -label "Mark Old" -underline 1 \
	-command [code $this _mark_old]
	$m add separator
	$m add command -label "Save" -underline 0 \
	-command [code $this _save_contents]
	$m add separator
	$m add command -label "Close" -underline 0 \
	-command "::debug::debugwin {};delete object $this"
	$menu add cascade -menu $menu.trace -label "Trace"
	set m [menu $menu.trace]
	$m add radiobutton -label Start -variable ::debug::tracing -value 1
	$m add radiobutton -label Stop -variable ::debug::tracing -value 0
	$menu add cascade -menu $menu.rs -label "ReSource"
	set m [menu $menu.rs]
	foreach f [lsort [glob [file join $GDBTK_LIBRARY *.itb]]] {
	$m add command -label "Source [file tail $f]"\
	-command [list source $f]
	}
	$m add separator
	$m add command -label "Source ALL" -command [code $this _source_all]

	$menu add cascade -menu $menu.opt -label "Options"
	set m [menu $menu.opt]
	$m add command -label "Display" -underline 0 \
	-command [list ManagedWin::open DebugWinDOpts -over $this]
	if {!$::debug::initialized} {
	$menu entryconfigure 1 -state disabled
	$menu add cascade -label " Tracing Not Initialized" -foreground red \
	-activeforeground red
	}
	$menu add cascade -menu $menu.help -label "Help" -underline 0
	set m [menu $menu.help]
	$m add command -label "Debugging Functions" -underline 0 \
	-command {open_help debug.html}

	$top configure -menu $menu

	iwidgets::scrolledtext $itk_interior.s -hscrollmode static \
	-vscrollmode static -wrap none -textbackground black -foreground white
	set _t [$itk_interior.s component text]
	pack $itk_interior.s -expand 1 -fill both

	# define tags
	foreach color $_colors {
	$_t tag configure [lindex $color 0] -foreground [lindex $color 1]
	}
	$_t tag configure trace -foreground gray
	$_t tag configure args -foreground blue
	$_t tag configure marked -background grey20

	loadlog

	# now notify the debug functions to use this window
	::debug::debugwin $this

	# override the window delete procedure so the messages are
	# turned off first.
	wm protocol $top WM_DELETE_WINDOW "::debug::debugwin {};destroy $top"
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::puts
	#
	# SYNOPSIS: puts {level cls func msg}
	#
	# DESC: Writes debugging information into the DebugWin. A filter
	# will be applied to determine if the message should be
	# displayed or not.
	#
	# ARGS: level - priority level. See debug::dbug for details.
	# cls - class name of caller, for example "SrcWin"
	# func - function name of caller
	# msg - message to display
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::puts {level cls func msg} {
	# filter. check if we should display this message
	# for now we always let high-level messages through
	if {$level == "I"} {

	# errors and warnings only
	if {$::gdbtk_de(ERRORS_ONLY)} { return }

	# ALL classes except those set
	if {$::gdbtk_de(ALL)} {
	if {[info exists ::gdbtk_de($cls)]} {
	if {$::gdbtk_de($cls)} {
	return
	}
	} elseif {$::gdbtk_de(others)} {
	return
	}
	}

	# ONLY the classes set
	if {!$::gdbtk_de(ALL)} {
	if {[info exists ::gdbtk_de($cls)]} {
	if {!$::gdbtk_de($cls)} {
	return
	}
	} elseif {!$::gdbtk_de(others)} {
	return
	}
	}
	}

	if {$func != ""} {
	append cls ::$func
	}
	$_t insert end "($cls) " {} "$msg\n" $level
	$_t see insert
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::put_trace
	#
	# SYNOPSIS: put_trace {enter level func ar}
	#
	# DESC: Writes trace information into the DebugWin. A filter
	# will be applied to determine if the message should be
	# displayed or not.
	#
	# ARGS: enter - 1 if this is a function entry, 0 otherwise.
	# level - stack level
	# func - function name
	# ar - function arguments
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::put_trace {enter level func ar} {
	set x [expr {$level * 2 - 2}]
	if {$enter} {
	$_t insert end "[string range $_bigstr 0 $x]$func " trace "$ar\n" args
	} else {
	$_t insert end "[string range $_bigstr 0 $x]<- $func " trace "$ar\n" args
	}
	$_t see insert
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::loadlog
	#
	# SYNOPSIS: loadlog
	#
	# DESC: Reads the contents of the debug log file, if it exists, into
	# the DebugWin.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::loadlog {} {
	$_t delete 0.0 end
	# Now load in log file, if possible.
	# this is rather rude, using the logfile variable in the debug namespace
	if {$::debug::logfile != "" && $::debug::logfile != "stdout"} {
	flush $::debug::logfile
	seek $::debug::logfile 0 start
	while {[gets $::debug::logfile line] >= 0} {
	while {[catch {set f [lindex $line 0]} f]} {
	# If the lindex failed its because the remainder of the
	# list is on the next line. Get it.
	if {[gets $::debug::logfile line2] < 0} {
	break
	}
	append line \n $line2
	}
	if {$f == "T"} {
	put_trace [lindex $line 1] [lindex $line 2] [lindex $line 3] \
	[lindex $line 4]
	} else {
	puts $f [lindex $line 1] [lindex $line 2] [lindex $line 3]
	}
	}
	}
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::_source_all
	#
	# SYNOPSIS: _source_all
	#
	# DESC: Re-sources all the .itb files.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::_source_all {} {
	foreach f [glob [file join $::GDBTK_LIBRARY *.itb]] {
	source $f
	}
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::_clear
	#
	# SYNOPSIS: _clear
	#
	# DESC: Clears out the content of the debug window.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::_clear {} {
	$_t delete 1.0 end
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::_mark_old
	#
	# SYNOPSIS: _mark_old
	#
	# DESC: Changes the background of the current contents of the window.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::_mark_old {} {
	$_t tag add marked 1.0 "end - 1c"
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWin::_save_contents
	#
	# SYNOPSIS: _save_contents
	#
	# DESC: Changes the background of the current contents of the window.
	# -----------------------------------------------------------------------------
	itcl::body DebugWin::_save_contents {} {
	set file [tk_getSaveFile -title "Choose debug window dump file" \
	-parent [winfo toplevel $itk_interior]]
	if {$file == ""} {
	return
	}

	if {[catch {::open $file w} fileH]} {
	tk_messageBox -type ok -icon error -message \
	"Can't open file: \"$file\". \n\nThe error was:\n\n\"$fileH\""
	return
	}
	::puts $fileH [$_t get 1.0 end]

	}

	###############################################################################
	# -----------------------------------------------------------------------------
	# NAME: DebugWinDOpts::constructor
	#
	# SYNOPSIS: constructor
	#
	# DESC: Creates the Debug Window Options Dialog.
	# -----------------------------------------------------------------------------
	itcl::body DebugWinDOpts::constructor {args} {
	window_name "Debug Window Options"
	build_win
	eval itk_initialize $args
	}

	###############################################################################
	# -----------------------------------------------------------------------------
	# NAME: DebugWinDOpts::destructor
	#
	# SYNOPSIS: Not called by hand
	#
	# DESC: Destroys the Debug Window Options Dialog.
	# -----------------------------------------------------------------------------
	itcl::body DebugWinDOpts::destructor {} {
	}


	# -----------------------------------------------------------------------------
	# NAME: DebugWinDOpts::build_win
	#
	# SYNOPSIS: build_win
	#
	# DESC: Creates the Debug Window Options Dialog. This dialog allows the
	# user to select which information is displayed in the debug
	# window and (eventually) how it looks.
	# -----------------------------------------------------------------------------
	itcl::body DebugWinDOpts::build_win {} {
	wm title [winfo toplevel $itk_interior] "Debug Display Options"
	# initialize here so we can resource this file and update the list
	set _classes {DebugWin RegWin SrcBar SrcWin ToolBar WatchWin EmbeddedWin \
	ManagedWin GDBWin StackWin SrcTextWin global \
	BpWin TargetSelection ModalDialog ProcessWin \
	GDBEventHandler MemWin VarTree}
	set _classes [concat [lsort $_classes] others]

	set f [frame $itk_interior.f]
	set btns [frame $itk_interior.buttons]

	iwidgets::Labeledframe $f.display -labelpos nw -labeltext {Classes}
	set fr [$f.display childsite]
	radiobutton $fr.0 -text "Messages from ALL classes EXCEPT those selected below" \
	-variable ::gdbtk_de(filter_var) -value ALL -command [code $this _all]
	radiobutton $fr.1 -text "Messages from ONLY those classes selected below" \
	-variable ::gdbtk_de(filter_var) -value ONLY -command [code $this _all]
	radiobutton $fr.2 -text "Only WARNINGS and ERRORS" \
	-variable ::gdbtk_de(filter_var) -value ERRORS -command [code $this _all]

	grid $fr.0 -sticky w -padx 5 -pady 5
	grid $fr.1 -sticky w -padx 5 -pady 5
	grid $fr.2 -sticky w -padx 5 -pady 5

	iwidgets::Labeledframe $f.classes
	set fr [$f.classes childsite]

	set i 0
	foreach cls $_classes {
	if {![info exists ::gdbtk_de($cls)]} {
	set ::gdbtk_de($cls) 0
	}
	checkbutton $fr.$i -text $cls -variable ::gdbtk_de($cls)
	incr i
	}

	set k [expr 3*(int($i/3))]
	set more [expr $i - $k]
	set j 0
	while {$j < $k} {
	grid $fr.$j $fr.[expr $j+1] $fr.[expr $j+2] -sticky w -padx 5 -pady 5
	incr j 3
	}
	switch $more {
	1 { grid $fr.$j x x -sticky w -padx 5 -pady 5}
	2 { grid $fr.$j $fr.[expr $j+1] x -sticky w -padx 5 -pady 5}
	}

	pack $f.display -side top -expand 1 -fill both
	pack $f.classes -side top -expand 1 -fill both

	button $btns.ok -text [gettext OK] -width 7 -command [code $this _apply 1] \
	-default active
	button $btns.apply -text "Apply to All" -width 7 \
	-command [code $this _apply 0]
	if {$::debug::logfile == "" \|\| $::debug::logfile == "stdout"} {
	$btns.apply configure -state disabled
	}
	button $btns.help -text [gettext Help] -width 10 -command [code $this help] \
	-state disabled
	standard_button_box $btns
	bind $btns.ok <Return> "$btns.ok flash; $btns.ok invoke"
	bind $btns.apply <Return> "$btns.apply flash; $btns.apply invoke"
	bind $btns.help <Return> "$btns.help flash; $btns.help invoke"

	pack $btns $f -side bottom -expand 1 -fill both -anchor e
	focus $btns.ok
	}

	# -----------------------------------------------------------------------------
	# NAME: DebugWinDOpts::_all
	#
	# SYNOPSIS: _all
	#
	# DESC: Callback for selecting ALL classes. If the user selects ALL,
	# deselect all the individual class checkbuttons.
	# -----------------------------------------------------------------------------
	itcl::body DebugWinDOpts::_all {} {
	switch $::gdbtk_de(filter_var) {
	ALL {
	set ::gdbtk_de(ALL) 1
	set ::gdbtk_de(ERRORS_ONLY) 0
	#enable class buttons
	set num 0
	foreach class $_classes {
	[$itk_interior.f.classes childsite].$num configure -state normal
	incr num
	}
	}
	ONLY {
	set ::gdbtk_de(ALL) 0
	set ::gdbtk_de(ERRORS_ONLY) 0
	#enable class buttons
	set num 0
	foreach class $_classes {
	[$itk_interior.f.classes childsite].$num configure -state normal
	incr num
	}
	}
	ERRORS {
	set ::gdbtk_de(ALL) 0
	set ::gdbtk_de(ERRORS_ONLY) 1
	# disable class buttons
	set num 0
	foreach class $_classes {
	[$itk_interior.f.classes childsite].$num configure -state disabled
	incr num
	}
	}
	}
	}


	# -----------------------------------------------------------------------------
	# NAME: DebugWinDOpts::_apply
	#
	# SYNOPSIS: _apply
	#
	# DESC: Callback for the "Apply" button. Loads the contents of the
	# log file through the new filter into the debug window. The
	# button is disabled if there is no log file.
	# -----------------------------------------------------------------------------
	itcl::body DebugWinDOpts::_apply { done } {
	set dw [ManagedWin::find DebugWin]
	debug $dw
	if {$dw != ""} {
	$dw loadlog
	}
	if {$done} {
	delete object $this
	}
	}