diff options
Diffstat (limited to 'gdb/gdbtk/library/bpwin.itb')
| -rw-r--r-- | gdb/gdbtk/library/bpwin.itb | 728 |
1 files changed, 0 insertions, 728 deletions
diff --git a/gdb/gdbtk/library/bpwin.itb b/gdb/gdbtk/library/bpwin.itb deleted file mode 100644 index 6ab96c71305..00000000000 --- a/gdb/gdbtk/library/bpwin.itb +++ /dev/null @@ -1,728 +0,0 @@ -# Breakpoint window for Insight. -# Copyright 1997, 1998, 1999, 2001, 2002, 2003 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. - - -# ------------------------------------------------------------------ -# CONSTRUCTOR: create the main breakpoint window -# ------------------------------------------------------------------ -itcl::body BpWin::constructor {args} { - window_name "Breakpoints" "BPs" - - 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 - - # The scrolledframe uses a canvas, which doesn't properly - # calculate an initial size, so we must set a default - # window size here. ManagedWin could override this still - # if there is a user preference for the geometry. - wm geometry $_top 350x165 - debug "done building" -} - -# ------------------------------------------------------------------ -# DESTRUCTOR: destroy the breakpoint window -# ------------------------------------------------------------------ -itcl::body BpWin::destructor {} {} - - -# ------------------------------------------------------------------ -# METHOD: build_win - build the main breakpoint window -# ------------------------------------------------------------------ -itcl::body BpWin::build_win {} { - global _bp_en _bp_disp tcl_platform - set bg1 $::Colors(bg) - - set hsmode dynamic - set vsmode dynamic - - # FIXME: The iwidgets scrolled frame is pretty useless. - # When we get BLT, use its hiertable to do this. - itk_component add sframe { - iwidgets::scrolledframe $itk_interior.sf \ - -hscrollmode $hsmode -vscrollmode $vsmode - } - - set twin [$itk_component(sframe) childsite] - - # write header - if {$tracepoints} { - label $twin.num0 -text "Num" -relief raised -bd 2 -anchor center \ - -font global/fixed - } - label $twin.thread0 -text "Thread" -relief raised -bd 2 -anchor center \ - -font global/fixed - label $twin.addr0 -text "Address" -relief raised -bd 2 -anchor center \ - -font global/fixed - label $twin.file0 -text "File" -relief raised -bd 2 -anchor center \ - -font global/fixed - label $twin.line0 -text "Line" -relief raised -bd 2 -anchor center \ - -font global/fixed - label $twin.func0 -text "Function" -relief raised -bd 2 -anchor center \ - -font global/fixed - - if {$tracepoints} { - label $twin.pass0 -text "PassCount" -relief raised -borderwidth 2 \ - -anchor center -font global/fixed - 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] { - set e [BreakpointEvent \#auto -action create -number $i] - bp_add $e - delete object $e - } - } else { - # insert all tracepoints - foreach i [gdb_get_tracepoint_list] { - set e [TracepointEvent \#auto -action create -number $i] - bp_add $e 1 - delete object $e - } - } - - pack $itk_component(sframe) -side left -expand true -fill both -} - -# ------------------------------------------------------------------ -# METHOD: bp_add - add a breakpoint entry -# ------------------------------------------------------------------ -itcl::body BpWin::bp_add {bp_event {tracepoint 0}} { - global _bp_en _bp_disp tcl_platform _files - - set number [$bp_event get number] - set thread [$bp_event get thread] - set disposition [$bp_event get disposition] - set file [$bp_event get file] - - if {$tracepoint} { - set diposition tracepoint - set bptype tracepoint - } else { - set bptype breakpoint - } - - debug "bp_add bpnum=$number thread=$thread show=$show_threads" - set i $next_row - set _bp_en($i) [$bp_event get 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) \ - -activebackground $bg1 -command "$this bp_able $i" -fg $color - } else { - checkbutton $twin.en$i -relief flat -variable _bp_en($i) \ - -command "$this bp_able $i" -activebackground $bg1 \ - -selectcolor $color -highlightbackground $bg1 - } - - if {$tracepoints} { - label $twin.num$i -text "$number " -relief flat -anchor w -font global/fixed - } - label $twin.addr$i -text "[gdb_CA_to_TAS [$bp_event get address]] " -relief flat -anchor w -font global/fixed -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 w -font global/fixed - } - label $twin.file$i -text "$file " -relief flat -anchor w -font global/fixed - label $twin.line$i -text "[$bp_event get line] " -relief flat -anchor w -font global/fixed - label $twin.func$i -text "[$bp_event get function] " -relief flat -anchor w -font global/fixed - if {$tracepoints} { - label $twin.pass$i -text "[$bp_event get pass_count] " -relief flat -anchor w -font global/fixed - } - - 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" - bind $twin.${thing}${i} <3> [code $this _select_and_popup $i %X %Y] - } - } - - 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) $number - 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 -# ------------------------------------------------------------------ -itcl::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 user_spec} \ - [gdb_get_breakpoint_info $breakpoint] { - break - } - - if {$user_spec != ""} { - set bp_specifier $user_spec - } elseif {$file != ""} { - set filename [file tail $file] - set bp_specifier $filename:$line_no - } else { - set bp_specifier *$address - } - - # FIXME: doesn't handle watchpoints. - 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 -# ------------------------------------------------------------------ -itcl::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 -# ------------------------------------------------------------------ -itcl::body BpWin::bp_select { r } { - global _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 $::Colors(fg) -bg $bg1 - } - } - - # 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 - - return - } - - foreach thing $zz { - $twin.${thing}${r} configure -fg $::Colors(sfg) -bg $::Colors(sbg) - } - - 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 -} - -# ------------------------------------------------------------------ -# NAME: private method BpWin::_select_and_popup -# DESCRIPTION: Select the given breakpoint and popup the options -# menu at the given location. -# -# ARGUMENTS: None -# RETURNS: Nothing -# ------------------------------------------------------------------ -itcl::body BpWin::_select_and_popup {bp X Y} { - if {$selected != $bp} { - bp_select $bp - } - tk_popup $Menu $X $Y -} - -# ------------------------------------------------------------------ -# METHOD: bp_modify - modify a breakpoint entry -# ------------------------------------------------------------------ -itcl::body BpWin::bp_modify {bp_event {tracepoint 0}} { - global _bp_en _bp_disp tcl_platform _files - - set number [$bp_event get number] - set thread [$bp_event get thread] - set disposition [$bp_event get disposition] - set file [$bp_event get file] - - if {$tracepoint} { - set disposition tracepoint - set bptype tracepoint - } else { - set bptype breakpoint - } - - set found 0 - for {set i 1} {$i < $next_row} {incr i} { - if { $number == $index_to_bpnum($i) - && "$Index_to_bptype($i)" == "$bptype"} { - incr found - break - } - } - - if {!$found} { - debug "ERROR: breakpoint number $number not found!" - return - } - - if {$_bp_en($i) != [$bp_event get enabled]} { - set _bp_en($i) [$bp_event get 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 "$number " - } - $twin.addr$i configure -text "[gdb_CA_to_TAS [$bp_event get address]] " - 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 "[$bp_event get line] " - $twin.func$i configure -text "[$bp_event get function] " - if {$tracepoints} { - $twin.pass$i configure -text "[$bp_event get pass_count] " - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_able - enable/disable a breakpoint -# ------------------------------------------------------------------ -itcl::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 -# ------------------------------------------------------------------ -itcl::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) -# ------------------------------------------------------------------ -itcl::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 user_spec - 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 -# ------------------------------------------------------------------ -itcl::body BpWin::bp_delete {bp_event} { - set number [$bp_event get number] - for {set i 1} {$i < $next_row} {incr i} { - if { $number == $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 - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: breakpoint - Update widget when a breakpoint -# event is received from the backend. -# ------------------------------------------------------------------ -itcl::body BpWin::breakpoint {bp_event} { - - set action [$bp_event get action] - #debug "bp update $action [$bp_event get number] [$bp_event get type]" - - switch $action { - modify { bp_modify $bp_event 0 } - create { bp_add $bp_event 0 } - delete { bp_delete $bp_event } - default { dbug E "Unknown breakpoint action: $action" } - } -} - -# ------------------------------------------------------------------ -# METHOD: tracepoint - Update widget when a tracepoint event -# is received from the backend. -# ------------------------------------------------------------------ -itcl::body BpWin::tracepoint {tp_event} { - - set action [$tp_event get action] - #debug "tp update $action [$tp_event get number]" - - switch $action { - modify { bp_modify $tp_event 1 } - create { bp_add $tp_event 1 } - delete { bp_delete $tp_event } - default { dbug E "Unknown tracepoint action: $action" } - } -} - -# ------------------------------------------------------------------ -# METHOD: bp_all - perform a command on all breakpoints -# ------------------------------------------------------------------ -itcl::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 -# ------------------------------------------------------------------ -itcl::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 -# ------------------------------------------------------------------ -itcl::body BpWin::toggle_threads {} { - set show_threads [pref get gdb/bp/show_threads] - reconfig -} - -# ------------------------------------------------------------------ -# METHOD: reconfig - used when preferences change -# ------------------------------------------------------------------ -itcl::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.sbox]} { destroy $itk_interior.sbox } - if {[winfo exists $itk_interior.sf]} { destroy $itk_interior.sf } - if {[winfo exists $itk_interior.pop]} { destroy $itk_interior.pop } - build_win -} - -# ------------------------------------------------------------------ -# METHOD: goto_bp - show bp in source window -# ------------------------------------------------------------------ -itcl::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] - - SrcWin::choose_and_display BROWSE_TAG [gdb_loc *$pc] -} |