diff options
Diffstat (limited to 'gdb/gdbtk/library/bpwin.itb')
| -rw-r--r-- | gdb/gdbtk/library/bpwin.itb | 697 |
1 files changed, 0 insertions, 697 deletions
diff --git a/gdb/gdbtk/library/bpwin.itb b/gdb/gdbtk/library/bpwin.itb deleted file mode 100644 index 17f85c05dc0..00000000000 --- a/gdb/gdbtk/library/bpwin.itb +++ /dev/null @@ -1,697 +0,0 @@ -# Breakpoint window for GDBtk. -# Copyright 1997, 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. - - -# ------------------------------------------------------------------ -# CONSTRUCTOR: create the main breakpoint window -# ------------------------------------------------------------------ -body BpWin::constructor {args} { - window_name "Breakpoints" "BPs" - - add_hook gdb_breakpoint_change_hook "$this update" - if {[pref getd gdb/bp/menu] != ""} { - set mbar 0 - } - set show_threads [pref get gdb/bp/show_threads] - debug "Ready to build" - build_win - eval itk_initialize $args - debug "done building" -} - -# ------------------------------------------------------------------ -# DESTRUCTOR: destroy the breakpoint window -# ------------------------------------------------------------------ -body BpWin::destructor {} { - remove_hook gdb_breakpoint_change_hook "$this update" -} - - -# ------------------------------------------------------------------ -# METHOD: build_win - build the main breakpoint window -# ------------------------------------------------------------------ -body BpWin::build_win {} { - global _bp_en _bp_disp tixOption tcl_platform - set bg1 $tixOption(input1_bg) - - frame $itk_interior.f -bg $bg1 - if {$tcl_platform(platform) == "windows"} { - tixScrolledWindow $itk_interior.f.sw -scrollbar both -sizebox 1 - } else { - tixScrolledWindow $itk_interior.f.sw -scrollbar auto - } - set twin [$itk_interior.f.sw subwidget window] - $twin configure -bg $bg1 - - # write header - if {$tracepoints} { - label $twin.num0 -text "Num" -relief raised -bd 2 -anchor center \ - -font src-font - } - label $twin.thread0 -text "Thread" -relief raised -bd 2 -anchor center \ - -font src-font - label $twin.addr0 -text "Address" -relief raised -bd 2 -anchor center \ - -font src-font - label $twin.file0 -text "File" -relief raised -bd 2 -anchor center \ - -font src-font - label $twin.line0 -text "Line" -relief raised -bd 2 -anchor center \ - -font src-font - label $twin.func0 -text "Function" -relief raised -bd 2 -anchor center \ - -font src-font - - if {$tracepoints} { - label $twin.pass0 -text "PassCount" -relief raised -borderwidth 2 \ - -anchor center -font src-font - grid x $twin.num0 $twin.addr0 $twin.file0 $twin.line0 $twin.func0 $twin.pass0 \ - -sticky new - } else { - if {$show_threads} { - grid x $twin.thread0 $twin.addr0 $twin.file0 $twin.line0 $twin.func0 -sticky new - # Let the File and Function columns expand; no others. - grid columnconfigure $twin 3 -weight 1 - grid columnconfigure $twin 5 -weight 1 - } else { - grid x $twin.addr0 $twin.file0 $twin.line0 $twin.func0 -sticky new - # Let the File and Function columns expand; no others. - grid columnconfigure $twin 2 -weight 1 - grid columnconfigure $twin 4 -weight 1 - } - } - - - # The last row must always suck up all the leftover vertical - # space. - set next_row 1 - grid rowconfigure $twin $next_row -weight 1 - - if { $mbar } { - menu $itk_interior.m -tearoff 0 - [winfo toplevel $itk_interior] configure -menu $itk_interior.m - if { $tracepoints == 0 } { - $itk_interior.m add cascade -menu $itk_interior.m.bp -label "Breakpoint" -underline 0 - } else { - $itk_interior.m add cascade -menu $itk_interior.m.bp -label "Tracepoint" -underline 0 - } - set m [menu $itk_interior.m.bp] - if { $tracepoints == 0 } { - $m add radio -label "Normal" -variable _bp_disp($selected) \ - -value donttouch -underline 0 -state disabled - $m add radio -label "Temporary" -variable _bp_disp($selected) \ - -value delete -underline 0 -state disabled - } else { - $m add command -label "Actions" -underline 0 -state disabled - } - - $m add separator - $m add radio -label "Enabled" -variable _bp_en($selected) -value 1 \ - -underline 0 -state disabled - $m add radio -label "Disabled" -variable _bp_en($selected) -value 0 \ - -underline 0 -state disabled - $m add separator - $m add command -label "Remove" -underline 0 -state disabled - $itk_interior.m add cascade -menu $itk_interior.m.all -label "Global" \ - -underline 0 - set m [menu $itk_interior.m.all] - $m add check -label " Show Threads" \ - -variable [pref varname gdb/bp/show_threads] \ - -underline 1 -command "$this toggle_threads" - $m add separator - $m add command -label "Disable All" -underline 0 \ - -command "$this bp_all disable" - $m add command -label "Enable All" -underline 0 \ - -command "$this bp_all enable" - $m add separator - $m add command -label "Remove All" -underline 0 \ - -command "$this bp_all delete" - $m add separator - $m add command -label "Store Breakpoints..." -underline 0 \ - -command [code $this bp_store] - $m add command -label "Restore Breakpoints..." -underline 3 \ - -command [code $this bp_restore] - } - - set Menu [menu $itk_interior.pop -tearoff 0] - - if { $tracepoints == 0 } { - $Menu add radio -label "Normal" -variable _bp_disp($selected) \ - -value donttouch -underline 0 - $Menu add radio -label "Temporary" -variable _bp_disp($selected) \ - -value delete -underline 0 - } else { - $Menu add command -label "Actions" -underline 0 - } - $Menu add separator - $Menu add radio -label "Enabled" -variable _bp_en($selected) -value 1 -underline 0 - $Menu add radio -label "Disabled" -variable _bp_en($selected) -value 0 -underline 0 - $Menu add separator - $Menu add command -label "Remove" -underline 0 - $Menu add cascade -menu $Menu.all -label "Global" -underline 0 - set m [menu $Menu.all] - $m add check -label " Show Threads" -variable [pref varname gdb/bp/show_threads] \ - -underline 1 -command "$this toggle_threads" - $m add separator - $m add command -label "Disable All" -underline 0 -command "$this bp_all disable" - $m add command -label "Enable All" -underline 0 -command "$this bp_all enable" - $m add separator - $m add command -label "Remove All" -underline 0 -command "$this bp_all delete" - - if { $tracepoints == 0 } { - # insert all breakpoints - foreach i [gdb_get_breakpoint_list] { - bp_add $i - } - } else { - # insert all tracepoints - foreach i [gdb_get_tracepoint_list] { - bp_add $i 1 - } - } - - pack $itk_interior.f.sw -side left -expand true -fill both - pack $itk_interior.f -side top -expand true -fill both - -} - -# ------------------------------------------------------------------ -# METHOD: bp_add - add a breakpoint entry -# ------------------------------------------------------------------ -body BpWin::bp_add { bpnum {tracepoint 0}} { - global _bp_en _bp_disp tcl_platform _files - - if {$tracepoint} { - set bpinfo [gdb_get_tracepoint_info $bpnum] - lassign $bpinfo file func line pc enabled pass_count \ - step_count thread hit_count actions - set disposition tracepoint - set bptype tracepoint - } else { - set bpinfo [gdb_get_breakpoint_info $bpnum] - lassign $bpinfo file func line pc type enabled disposition \ - ignore_count commands cond thread hit_count - set bptype breakpoint - } - - debug "bp_add bpnum=$bpnum thread=$thread show=$show_threads" - set i $next_row - set _bp_en($i) $enabled - set _bp_disp($i) $disposition - set temp($i) "" - switch $disposition { - donttouch { set color [pref get gdb/src/bp_fg] } - delete { - set color [pref get gdb/src/temp_bp_fg] - set temp($i) delete - } - tracepoint { - set color [pref get gdb/src/trace_fg] - } - default { set color yellow } - } - - if {$thread != "-1"} {set color [pref get gdb/src/thread_fg]} - - if {$tcl_platform(platform) == "windows"} { - checkbutton $twin.en$i -relief flat -variable _bp_en($i) -bg $bg1 \ - -activebackground $bg1 -command "$this bp_able $i" -fg $color - } else { - checkbutton $twin.en$i -relief flat -variable _bp_en($i) -selectcolor $color \ - -command "$this bp_able $i" -bg $bg1 -activebackground $bg1 - } - - if {$tracepoints} { - label $twin.num$i -text "$bpnum " -relief flat -anchor e -font src-font -bg $bg1 - } - label $twin.addr$i -text "$pc " -relief flat -anchor e -font src-font -bg $bg1 - if {[info exists _files(short,$file)]} { - set file $_files(short,$file) - } else { - # FIXME. Really need to do better than this. - set file [::file tail $file] - } - if {$show_threads} { - if {$thread == "-1"} {set thread "ALL"} - label $twin.thread$i -text "$thread " -relief flat -anchor e -font src-font -bg $bg1 - } - label $twin.file$i -text "$file " -relief flat -anchor e -font src-font -bg $bg1 - label $twin.line$i -text "$line " -relief flat -anchor e -font src-font -bg $bg1 - label $twin.func$i -text "$func " -relief flat -anchor e -font src-font -bg $bg1 - - if {$tracepoints} { - label $twin.pass$i -text "$pass_count " -relief flat -anchor e -font src-font -bg $bg1 - } - - if {$mbar} { - set zz [list addr file func line] - if {$tracepoints} {lappend zz num pass} - if {$show_threads} {lappend zz thread} - foreach thing $zz { - bind $twin.${thing}${i} <1> "$this bp_select $i" - bind $twin.${thing}${i} <Double-1> "$this goto_bp $i" - } - } - - if {$tracepoints} { - grid $twin.en$i $twin.num$i $twin.addr$i $twin.file$i $twin.line$i \ - $twin.func$i $twin.pass$i -sticky new -ipadx 4 -ipady 2 - } else { - if {$show_threads} { - grid $twin.en$i $twin.thread$i $twin.addr$i $twin.file$i $twin.line$i \ - $twin.func$i -sticky new -ipadx 4 -ipady 2 - } else { - grid $twin.en$i $twin.addr$i $twin.file$i $twin.line$i \ - $twin.func$i -sticky new -ipadx 4 -ipady 2 - } - } - - # This used to be the last row. Fix it vertically again. - grid rowconfigure $twin $i -weight 0 - - set index_to_bpnum($i) $bpnum - set Index_to_bptype($i) $bptype - incr i - set next_row $i - grid rowconfigure $twin $i -weight 1 -} - -# ------------------------------------------------------------------ -# METHOD: bp_store - stores away the breakpoints in a file of gdb -# commands -# ------------------------------------------------------------------ -body BpWin::bp_store {} { - set out_file [tk_getSaveFile] - if {$out_file == ""} { - return - } - if {[catch {::open $out_file w} outH]} { - tk_messageBox -message "Could not open $out_file: $outH" - return - } - foreach breakpoint [gdb_get_breakpoint_list] { - # This is an lassign - foreach {file function line_no address type \ - enable_p disp ignore cmds thread hit_count} \ - [gdb_get_breakpoint_info $breakpoint] { - break - } - - if {$file != ""} { - set filename [file tail $file] - set bp_specifier $filename:$line_no - } else { - set bp_specifier *$address - } - - if {[string compare $disp "delete"] == 0} { - puts $outH "tbreak $bp_specifier" - } else { - puts $outH "break $bp_specifier" - } - - if {!$enable_p} { - puts $outH "disable \$bpnum" - } - if {$ignore > 0} { - puts $outH "ignore \$bpnum $ignore" - } - } - close $outH -} - -# ------------------------------------------------------------------ -# METHOD: bp_restore - restore the breakpoints from a file of gdb -# commands -# ------------------------------------------------------------------ -body BpWin::bp_restore {} { - set inH [tk_getOpenFile] - if {$inH == ""} { - return - } - bp_all delete - if {[catch {gdb_cmd "source $inH"} err]} { - tk_messageBox -message "Error sourcing in BP file $inH: \"$err\"" - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_select - select a row in the grid -# ------------------------------------------------------------------ -body BpWin::bp_select { r } { - global tixOption _bp_en _bp_disp - - set zz [list addr file func line] - if {$tracepoints} {lappend zz num pass} - if {$show_threads} {lappend zz thread} - - if {$selected} { - set i $selected - - foreach thing $zz { - $twin.${thing}${i} configure -fg $tixOption(fg) -bg $bg1 - bind $twin.${thing}${i} <3> break - } - } - - # if we click on the same line, unselect it and return - if {$selected == $r} { - set selected 0 - - if {$tracepoints == 0} { - $itk_interior.m.bp entryconfigure "Normal" -state disabled - $itk_interior.m.bp entryconfigure "Temporary" -state disabled - } else { - $itk_interior.m.bp entryconfigure "Actions" -state disabled - } - $itk_interior.m.bp entryconfigure "Enabled" -state disabled - $itk_interior.m.bp entryconfigure "Disabled" -state disabled - $itk_interior.m.bp entryconfigure "Remove" -state disabled - - foreach thing $zz { - bind $twin.${thing}${r} <3> break - } - - return - } - - foreach thing $zz { - $twin.${thing}${r} configure -fg $tixOption(select_fg) -bg $tixOption(select_bg) - bind $twin.${thing}${r} <3> "tk_popup $Menu %X %Y" - } - - if {$tracepoints == 0} { - $itk_interior.m.bp entryconfigure "Normal" -variable _bp_disp($r) \ - -command "$this bp_type $r" -state normal - $itk_interior.m.bp entryconfigure "Temporary" -variable _bp_disp($r) \ - -command "$this bp_type $r" -state normal - $Menu entryconfigure "Normal" -variable _bp_disp($r) \ - -command "$this bp_type $r" -state normal - $Menu entryconfigure "Temporary" -variable _bp_disp($r) \ - -command "$this bp_type $r" -state normal - } else { - $itk_interior.m.bp entryconfigure "Actions" -command "$this get_actions $r" -state normal - $Menu entryconfigure "Actions" -command "$this get_actions $r" -state normal - } - $itk_interior.m.bp entryconfigure "Enabled" -variable _bp_en($r) \ - -command "$this bp_able $r" -state normal - $itk_interior.m.bp entryconfigure "Disabled" -variable _bp_en($r) \ - -command "$this bp_able $r" -state normal - $itk_interior.m.bp entryconfigure "Remove" -command "$this bp_remove $r" -state normal - $Menu entryconfigure "Enabled" -variable _bp_en($r) \ - -command "$this bp_able $r" -state normal - $Menu entryconfigure "Disabled" -variable _bp_en($r) \ - -command "$this bp_able $r" -state normal - $Menu entryconfigure "Remove" -command "$this bp_remove $r" -state normal - - set selected $r -} - -# ------------------------------------------------------------------ -# METHOD: bp_modify - modify a breakpoint entry -# ------------------------------------------------------------------ -body BpWin::bp_modify { bpnum {tracepoint 0} } { - global _bp_en _bp_disp tcl_platform _files - - if {$tracepoint} { - set bpinfo [gdb_get_tracepoint_info $bpnum] - lassign $bpinfo file func line pc enabled pass_count \ - step_count thread hit_count actions - set disposition tracepoint - set bptype tracepoint - } else { - set bpinfo [gdb_get_breakpoint_info $bpnum] - lassign $bpinfo file func line pc type enabled disposition \ - ignore_count commands cond thread hit_count - set bptype breakpoint - } - - set found 0 - for {set i 1} {$i < $next_row} {incr i} { - if { $bpnum == $index_to_bpnum($i) - && "$Index_to_bptype($i)" == "$bptype"} { - incr found - break - } - } - - if {!$found} { - debug "ERROR: breakpoint number $bpnum not found!" - return - } - - if {$_bp_en($i) != $enabled} { - set _bp_en($i) $enabled - } - - if {$_bp_disp($i) != $disposition} { - set _bp_disp($i) $disposition - } - - switch $disposition { - donttouch { set color [pref get gdb/src/bp_fg] } - delete { - set color [pref get gdb/src/temp_bp_fg] - } - tracepoint { set color [pref get gdb/src/trace_fg] } - default { set color yellow} - } - - if {$thread != "-1"} {set color [pref get gdb/src/thread_fg]} - - if {$tcl_platform(platform) == "windows"} then { - $twin.en$i configure -fg $color - } else { - $twin.en$i configure -selectcolor $color - } - if {$tracepoints} { - $twin.num$i configure -text "$bpnum " - } - $twin.addr$i configure -text "$pc " - if {[info exists _files(short,$file)]} { - set file $_files(short,$file) - } else { - # FIXME. Really need to do better than this. - set file [::file tail $file] - } - if {$show_threads} { - if {$thread == "-1"} {set thread "ALL"} - $twin.thread$i configure -text "$thread " - } - $twin.file$i configure -text "$file " - $twin.line$i configure -text "$line " - $twin.func$i configure -text "$func " - if {$tracepoints} { - $twin.pass$i configure -text "$pass_count " - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_able - enable/disable a breakpoint -# ------------------------------------------------------------------ -body BpWin::bp_able { i } { - global _bp_en - - bp_select $i - - switch $Index_to_bptype($i) { - breakpoint {set type {}} - tracepoint {set type "tracepoint"} - } - - if {$_bp_en($i) == "1"} { - set command "enable $type $temp($i) " - } else { - set command "disable $type " - } - - append command "$index_to_bpnum($i)" - gdb_cmd "$command" -} - -# ------------------------------------------------------------------ -# METHOD: bp_remove - remove a breakpoint -# ------------------------------------------------------------------ -body BpWin::bp_remove { i } { - - bp_select $i - - switch $Index_to_bptype($i) { - breakpoint { set type {} } - tracepoint { set type "tracepoint" } - } - - gdb_cmd "delete $type $index_to_bpnum($i)" -} - -# ------------------------------------------------------------------ -# METHOD: bp_type - change the breakpoint type (disposition) -# ------------------------------------------------------------------ -body BpWin::bp_type { i } { - - if {$Index_to_bptype($i) != "breakpoint"} { - return - } - - set bpnum $index_to_bpnum($i) - #debug "bp_type $i $bpnum" - set bpinfo [gdb_get_breakpoint_info $bpnum] - lassign $bpinfo file func line pc type enabled disposition \ - ignore_count commands cond thread hit_count - bp_select $i - switch $disposition { - delete { - gdb_cmd "delete $bpnum" - gdb_cmd "break *$pc" - } - donttouch { - gdb_cmd "delete $bpnum" - gdb_cmd "tbreak *$pc" - } - default { debug "Unknown breakpoint disposition: $disposition" } - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_delete - delete a breakpoint -# ------------------------------------------------------------------ -body BpWin::bp_delete { bpnum } { - for {set i 1} {$i < $next_row} {incr i} { - if { $bpnum == $index_to_bpnum($i) } { - if {$tracepoints} { - grid forget $twin.en$i $twin.num$i $twin.addr$i $twin.file$i \ - $twin.line$i $twin.func$i $twin.pass$i - destroy $twin.en$i $twin.num$i $twin.addr$i $twin.file$i \ - $twin.line$i $twin.func$i $twin.pass$i - } else { - if {$show_threads} { - grid forget $twin.thread$i - destroy $twin.thread$i - } - grid forget $twin.en$i $twin.addr$i $twin.file$i $twin.line$i $twin.func$i - destroy $twin.en$i $twin.addr$i $twin.file$i $twin.line$i $twin.func$i - } - if {$selected == $i} { - set selected 0 - } - return - } - } -} - -# ------------------------------------------------------------------ -# METHOD: update - update widget when a breakpoint changes -# ------------------------------------------------------------------ -body BpWin::update {action bpnum addr {linenum {}} {file {}} {type 0} args} { - #debug "bp update $action $bpnum $type" - - if {$type == "tracepoint"} { - set tp 1 - } else { - set tp 0 - } - - switch $action { - modify { bp_modify $bpnum $tp} - create { bp_add $bpnum $tp} - delete { bp_delete $bpnum } - default { debug "Unknown breakpoint action: $action" } - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_all - perform a command on all breakpoints -# ------------------------------------------------------------------ -body BpWin::bp_all { command } { - - if {!$tracepoints} { - # Do all breakpoints - foreach bpnum [gdb_get_breakpoint_list] { - if { $command == "enable"} { - for {set i 1} {$i < $next_row} {incr i} { - if { $bpnum == $index_to_bpnum($i) - && "$Index_to_bptype($i)" == "breakpoint"} { - gdb_cmd "enable $temp($i) $bpnum" - break - } - } - } else { - gdb_cmd "$command $bpnum" - } - } - } else { - # Do all tracepoints - foreach bpnum [gdb_get_tracepoint_list] { - if { $command == "enable"} { - for {set i 1} {$i < $next_row} {incr i} { - if { $bpnum == $index_to_bpnum($i) - && "$Index_to_bptype($i)" == "tracepoint"} { - gdb_cmd "enable tracepoint $bpnum" - break - } - } - } else { - gdb_cmd "$command tracepoint $bpnum" - } - } - } -} - -# ------------------------------------------------------------------ -# METHOD: get_actions - pops up the add trace dialog on a selected -# tracepoint -# ------------------------------------------------------------------ -body BpWin::get_actions {bpnum} { - set bpnum $index_to_bpnum($bpnum) - set bpinfo [gdb_get_tracepoint_info $bpnum] - lassign $bpinfo file func line pc enabled pass_count \ - step_count thread hit_count actions - - set filename [::file tail $file] - ManagedWin::open TraceDlg -File $filename -Lines $line -} - -# ------------------------------------------------------------------ -# METHOD: toggle_threads - callback when show_threads is toggled -# ------------------------------------------------------------------ -body BpWin::toggle_threads {} { - set show_threads [pref get gdb/bp/show_threads] - reconfig -} - -# ------------------------------------------------------------------ -# METHOD: reconfig - used when preferences change -# ------------------------------------------------------------------ -body BpWin::reconfig {} { - if {[winfo exists $itk_interior.f]} { destroy $itk_interior.f } - if {[winfo exists $itk_interior.m]} { destroy $itk_interior.m } - if {[winfo exists $itk_interior.pop]} { destroy $itk_interior.pop } - build_win -} - -# ------------------------------------------------------------------ -# METHOD: goto_bp - show bp in source window -# ------------------------------------------------------------------ -body BpWin::goto_bp {r} { - set bpnum $index_to_bpnum($r) - if {$tracepoints} { - set bpinfo [gdb_get_tracepoint_info $bpnum] - } else { - set bpinfo [gdb_get_breakpoint_info $bpnum] - } - set pc [lindex $bpinfo 3] - - # !! FIXME: multiple source windows? - set src [lindex [ManagedWin::find SrcWin] 0] - set info [gdb_loc *$pc] - $src location BROWSE_TAG $info -} - - |