Subversion Repositories or1k

# Breakpoint window for GDBtk.

# Copyright 1997, 1998, 1999, 2001 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

# ------------------------------------------------------------------

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

  debug "done building"

}

# ------------------------------------------------------------------

#  DESTRUCTOR:  destroy the breakpoint window

# ------------------------------------------------------------------

body BpWin::destructor {} {}

# ------------------------------------------------------------------

#  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] {

      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_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 {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) -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 "$number " -relief flat -anchor e -font src-font -bg $bg1

  }

  label $twin.addr$i -text "[$bp_event get address] " -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 "[$bp_event get line] " -relief flat -anchor e -font src-font -bg $bg1

  label $twin.func$i -text "[$bp_event get function] " -relief flat -anchor e -font src-font -bg $bg1

  if {$tracepoints} {

    label $twin.pass$i -text "[$bp_event get 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}  "$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) $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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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 {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 "[$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

# ------------------------------------------------------------------

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 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

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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]

  SrcWin::choose_and_display BROWSE_TAG [gdb_loc *$pc]

}