diff options
Diffstat (limited to 'gdb/gdbtk/library/debugwin.itb')
| -rw-r--r-- | gdb/gdbtk/library/debugwin.itb | 468 |
1 files changed, 0 insertions, 468 deletions
diff --git a/gdb/gdbtk/library/debugwin.itb b/gdb/gdbtk/library/debugwin.itb deleted file mode 100644 index baeadab300e..00000000000 --- a/gdb/gdbtk/library/debugwin.itb +++ /dev/null @@ -1,468 +0,0 @@ -# Debug window for GDBtk. -# Copyright 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::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 - } -} |