diff options
Diffstat (limited to 'gdb/gdbtk/library/debugwin.itb')
| -rw-r--r-- | gdb/gdbtk/library/debugwin.itb | 409 |
1 files changed, 409 insertions, 0 deletions
diff --git a/gdb/gdbtk/library/debugwin.itb b/gdb/gdbtk/library/debugwin.itb new file mode 100644 index 00000000000..7ba9b7d0bea --- /dev/null +++ b/gdb/gdbtk/library/debugwin.itb @@ -0,0 +1,409 @@ +# Debug window for GDBtk. +# Copyright 1998, 1999 Cygnus Solutions +# +# 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. +# ----------------------------------------------------------------------------- +body DebugWin::constructor {args} { + debug "" + window_name "GDBTK Debug" "Debug" + + build_win + incr numTopWins +} + +# ----------------------------------------------------------------------------- +# NAME: DebugWin::destructor +# +# SYNOPSIS: Not called by hand +# +# DESC: Destroys the debug window +# +# ARGS: None +# ----------------------------------------------------------------------------- +body DebugWin::destructor {} { + # notify debug code that window is going away + ::debug::debugwin "" + incr numTopWins -1 +} + +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- +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(others) 0 + } + + # 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 {ManagedWin::open HtmlViewer -force -file debug.html \ + -topics {{{"Debug Functions" 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 +# ----------------------------------------------------------------------------- +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 {!$::gdbtk_de(ALL) && $level == "I"} { + 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 +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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. +# ----------------------------------------------------------------------------- +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 VariableWin global BPWin \ + TargetSelection ModalDialog ProcessWin} + set f [frame $itk_interior.f] + set btns [frame $itk_interior.buttons] + + iwidgets::Labeledframe $f.classes -labelpos nw -labeltext {Classes} + set fr [$f.classes childsite] + + checkbutton $fr.0 -text ALL -variable ::gdbtk_de(ALL) -command [code $this _all] + set i 1 + foreach cls [lsort $_classes] { + if {![info exists ::gdbtk_de($cls)]} { + set ::gdbtk_de($cls) 0 + } + checkbutton $fr.$i -text $cls -variable ::gdbtk_de($cls) + incr i + } + checkbutton $fr.$i -text others -variable ::gdbtk_de(others) + 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.classes -side top -expand 1 -fill both + + button $btns.ok -text [gettext OK] -width 7 -command [code delete object $this] \ + -default active + button $btns.apply -text "Apply to All" -width 7 \ + -command [code $this _apply] + 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. +# ----------------------------------------------------------------------------- +body DebugWinDOpts::_all {} { + if {$::gdbtk_de(ALL)} { + foreach cls $_classes { + set ::gdbtk_de($cls) 0 + } + set ::gdbtk_de(others) 0 + } +} + + +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- +body DebugWinDOpts::_apply {} { + set dw [ManagedWin::find DebugWin] + if {$dw != ""} { + $dw loadlog + } +} |