# Breakpoint window for Insight. # Copyright (C) 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} "$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 cond 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] }