# Register display window for Insight.
# Copyright 1998, 1999, 2001 Red Hat, Inc.
#
# Written by Keith Seitz (keiths@redhat.com)
# based on work by Martin Hunt (hunt@redhat.com)
#
# 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.
# TODO
#
# Must fix:
# o Edit menus -- weirdo interaction with tkTable. Seems okay on windows.
# Needs more testing on unix (popup edit menu item).
#
# Want really badly:
# o Multiple selections
# o Register groups (gdb and user-defined)
# o format register values before inserting into table?
# (Instead of displaying "0x0", we should use "0x00000000" on
# machines with 32-bit regs, "0x0000000000000000" on machines
# with 64-bit regs, etc. Maybe user-defined formats, i.e.,
# "0x0000 0000 0000 0000 0000 0000"?)
# ------------------------------------------------------------------
# NAME: RegWin::constructor
# DESCRIPTION: Create a new register window
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::constructor {args} {
eval itk_initialize $args
gdbtk_busy
window_name "Registers" "Regs"
_build_win
_layout_table
# Clear gdb's changed list
catch {gdb_reginfo changed}
gdbtk_idle
}
# ------------------------------------------------------------------
# NAME: RegWin::destructor
# DESCRIPTION: Destroys the register window
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::destructor {} {
debug
}
#
# Table layout/display methods
#
# ------------------------------------------------------------------
# NAME: private method RegWin::_build_win
# DESCRIPTION: Builds the register window from widgets
#
# ARGUMENTS: None
# RETURNS: Nothing
#
# NOTES: This method should only be called once for
# each RegWin. To change the layout of the table
# in the window, use RegWin::_layout_table.
# ------------------------------------------------------------------
body RegWin::_build_win {} {
# Create scrollbars and table
itk_component add vscroll {
scrollbar $itk_interior.vs -orient vertical
} {}
itk_component add hscroll {
scrollbar $itk_interior.hs -orient horizontal
} {}
itk_component add table {
::table $itk_interior.tbl -variable [scope _data] \
-bg [pref get gdb/font/normal_bg] -fg [pref get gdb/font/normal_fg] \
-browsecmd [code $this _select_cell %S] -font src-font \
-colstretch unset -rowstretch unset -selectmode single \
-resizeborders none -multiline false -colwidth 18 \
-autoclear 0 -bg [pref get gdb/font/normal_bg] \
-padx 5 -xscrollcommand [code $itk_component(hscroll) set] \
-yscrollcommand [code $itk_component(vscroll) set]
} {}
bind $itk_component(table) <Up> \
[format "%s; break" [code $this _move up]]
bind $itk_component(table) <Down> \
[format "%s; break" [code $this _move down]]
bind $itk_component(table) <Left> \
[format "%s; break" [code $this _move left]]
bind $itk_component(table) <Right> \
[format "%s; break" [code $this _move right]]
bind $itk_component(table) <3> \
[code $this _but3 %x %y %X %Y]
bind $itk_component(table) <Double-1> \
[code $this _edit %x %y]
bind $itk_component(table) <Return> \
[format "%s; break" [code $this _accept_edit]]
bind $itk_component(table) <KP_Enter> \
[format "%s; break" [code $this _accept_edit]]
bind $itk_component(table) <Escape> \
[code $this _unedit]
$itk_component(hscroll) configure -command [code $itk_component(table) xview]
$itk_component(vscroll) configure -command [code $itk_component(table) yview]
grid $itk_component(table) -row 0 -col 0 -sticky news
grid $itk_component(vscroll) -row 0 -col 1 -sticky ns
grid $itk_component(hscroll) -row 1 -col 0 -sticky ew
grid columnconfigure $itk_interior 0 -weight 1
grid rowconfigure $itk_interior 0 -weight 1
# Add sizebox for windows
if {[string compare $::tcl_platform(platform) "windows"] == 0} {
ide_sizebox $itk_interior.sbox
place $itk_interior.sbox -relx 1.0 -rely 1.0 -anchor se
}
# Create/configure tags for various display styles
# normal - the "normal" display style
# highlight - changed registers are highlighted
# sel - the selection fg/bg should conform to standard
# header - used on the register name cells and empty cells
# edit - used on a cell being edited
$itk_component(table) tag configure normal \
-foreground [pref get gdb/font/normal_fg] \
-background [pref get gdb/font/normal_bg] \
-state disabled
$itk_component(table) tag configure highlight \
-foreground [pref get gdb/font/highlight_fg] \
-background [pref get gdb/font/highlight_bg]
$itk_component(table) tag raise highlight
$itk_component(table) tag configure sel \
-foreground [pref get gdb/font/select_fg]
$itk_component(table) tag configure header \
-foreground [pref get gdb/font/header_fg] \
-background [pref get gdb/font/header_bg] \
-anchor w -state disabled -relief raised
$itk_component(table) tag configure disabled \
-state disabled
$itk_component(table) tag raise active
$itk_component(table) tag configure edit \
-state normal
$itk_component(table) tag raise edit
$itk_component(table) tag raise sel
# Register to receive notifications on preference changes
# (Note that these are not supported by the preference dialogs, but...)
foreach opt [list highlight select header] {
pref add_hook gdb/font/${opt}_fg [code $this _prefs_changed]
pref add_hook gdb/font/${opt}_bg [code $this _prefs_changed]
}
# Create toplevel menubar
itk_component add menubar {
menu $itk_interior.m -tearoff false
} {
ignore -tearoff
}
$_top configure -menu $itk_component(menubar)
# Create register menu
itk_component add reg_menu {
menu $itk_component(menubar).reg -tearoff false \
-postcommand [code $this _post_menu]
} {
ignore -tearoff
}
$itk_component(menubar) add cascade -menu $itk_component(reg_menu) \
-label "Register" -underline 0
if {![pref get gdb/mode]} {
$itk_component(reg_menu) add command -label "Edit" \
-underline 0 -state disabled
set _menuitems(edit) [$itk_component(reg_menu) index last]
}
# Create register->format cascade menu
itk_component add reg_format {
menu $itk_component(reg_menu).format -tearoff false
} {
ignore -tearoff
}
$itk_component(reg_menu) add cascade -menu $itk_component(reg_format) \
-label "Format" -underline 0
$itk_component(reg_format) add radio -label "Hex" -value x \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Decimal" -value d \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Unsigned" -value u \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Natural" -value {} \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Binary" -value t \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Octal" -value o \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Raw" -value r \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_format) add radio -label "Floating Point" -value f \
-underline 0 -state disabled -command [code $this update dummy]
$itk_component(reg_menu) add command -label "Add to Watch" \
-underline 7 -state disabled
set _menuitems(add_to_watch) [$itk_component(reg_menu) index last]
$itk_component(reg_menu) add separator
$itk_component(reg_menu) add command -label "Remove from Display" \
-underline 0 -state disabled
set _menuitems(remove_from_display) [$itk_component(reg_menu) index last]
$itk_component(reg_menu) add command -label "Display all Registers" \
-underline 0 -state disabled -command [code $this _display_all]
set _menuitems(display_all_registers) [$itk_component(reg_menu) index last]
$itk_component(reg_menu) add separator
$itk_component(reg_menu) add command -label "Close" \
-underline 0 -command [code delete object $this]
# Add popup menu - we populate it in the event handler
itk_component add popup {
menu $itk_interior.pop -tearoff 0
} {}
$itk_component(popup) configure \
-disabledforeground [$itk_component(menubar) cget -fg]
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_dimensions
# DESCRIPTION: Determine dimensions for the table
#
# ARGUMENTS: None
# RETURNS: A list of {cols,rows} which may be used to
# configure the table
#
# NOTES: I don't like this. (KRS 20010718)
# ------------------------------------------------------------------
body RegWin::_dimensions {} {
# Always layout the table based on the TOTAL number
# of registers (not just the shown ones).
set num [llength [gdb_reginfo name]]
set rows [pref get gdb/reg/rows]
set cols [expr {$num / $rows}]
if {[expr {$num % $rows}] != 0} {
incr cols
}
return [list [expr {2 * $cols}] $rows]
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_layout_table
# DESCRIPTION: Configures and lays out the table
#
# ARGUMENTS: None
# RETURNS: Nothing
#
# NOTES: Uses preferences to determine if/how a register
# is displayed
# ------------------------------------------------------------------
body RegWin::_layout_table {} {
# Set table dimensions
lassign [_dimensions] cols rows
$itk_component(table) configure -cols $cols -rows $rows
if {[info exists _cell]} {
unset _cell
unset _register
}
set _register(hidden) {}
# Find out largest register name length and register size length.
set width 0; # for reg values
set max_width 0; # for reg labels
foreach r [gdb_reginfo name -numbers] {
set nm [lindex $r 0]
set rn [lindex $r 1]
set size [string length $nm]
if {$size > $max_width} {
set max_width $size
}
set size [gdb_reginfo size $rn]
if {$size > $width} {
set width $size
}
}
incr max_width 2; # padding
# Minwidth = size * 2 (hex) + 2 ("0x") + 2 (padding, one space each side)
set minwidth [expr {$size * 2 + 2 + 2}]
# Clear any column spans
foreach span [$itk_component(table) spans] {
$itk_component(table) spans $span 0,0
}
# Fill data array with register names.
#
# The table is indexed by (row,col). All odd columns will contain
# register values and all even columns will contain the labels.
#
# This loop will also initialize _typed and _editable arrays.
set x 0
set y 0
set _reg_display_list {}
foreach r [gdb_reginfo name -numbers] {
set name [lindex $r 0]
set rn [lindex $r 1]
# All registers shall be considered editable
# and non-typed until proved otherwise
set _typed($rn) 0
set _editable($rn) 0
# If user has no preference, show register in hex (if we can)
set format [pref getd gdb/reg/${name}-format]
if {$format == ""} { set format x }
set _format($rn) $format
# Check if the user prefers not to show this register
if {[pref getd gdb/reg/$name] == "no"} {
set _cell($rn) hidden
lappend _register(hidden) $rn
} else {
lappend _reg_display_list $rn
set _cell($rn) "$y,[expr {$x+1}]"
set _register($_cell($rn)) $rn
set _data($y,$x) $name
_update_register $rn
$itk_component(table) width $x $max_width
$itk_component(table) width [expr {$x+1}] $width
$itk_component(table) tag col header $x
$itk_component(table) tag col normal [expr {$x+1}]
# Go to next row/column
incr y
if {$y == $rows} {
set _col_size([expr {$x+1}]) 0
# Size the column
if {$::gdb_running} {
_size_column [expr {$x+1}] 1
}
set y 0
incr x 2
}
}
}
# Mark empty cells
while {$y != $rows && $x != $cols} {
set _data($y,$x) ""
set _data($y,[expr {$x+1}]) ""
$itk_component(table) spans $y,$x 0,1
$itk_component(table) tag cell header $y,$x
set _col_size([expr {$x+1}]) 0
incr y
if {$y == $rows} {
# Size the column
if {$::gdb_running} {
_size_column [expr {$x+1}] 1
}
set y 0
incr x 2
}
}
# Update register menu
if {[llength $_register(hidden)] != 0} {
$itk_component(reg_menu) entryconfigure $_menuitems(display_all_registers) \
-state normal
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_size_cell_column
# DESCRIPTION: Resize the column for a given cell.
#
# ARGUMENTS:
# cell - the cell whose column is to be resized
# down - whether the resizing should size the column
# down or just up.
# RETURNS: Nothing
#
# NOTES: See _size_column for the reasoning for the "down"
# option.
# ------------------------------------------------------------------
body RegWin::_size_cell_column {cell down} {
set col [string trim [lindex [split $cell ,] 1] ()]
_size_column $col $down
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_size_column
# DESCRIPTION: Resize the given column
#
# ARGUMENTS:
# col - the column to be resized
# down - whether the resizing should size the column
# RETURNS: down or just up.
#
# NOTES: The down option allows column sizes to change down
# as well as up. For most cases, this is what is
# wanted. However, when the user is stepping, it is
# really annoying to see the column sizes changing.
# It's bad enough we must size up, but going down
# is just too much. Consequently, when updating the
# contents of the table, we specify that the columns
# should not downsize. This helps mitigate the
# annoyance.
# ------------------------------------------------------------------
body RegWin::_size_column {col down} {
set max 0
foreach cell [array names _data *,$col] {
set len [string length $_data($cell)]
if {$len > $max} { set max $len }
}
if {($down && $max != $_col_size($col))
|| (!$down && $max > $_col_size($col))} {
set _col_size($col) $max
$itk_component(table) width $col [expr {$max + 2}]
# Force the table to update itself
after idle event generate $itk_component(table) <Configure> \
-width [winfo width $itk_component(table)]
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_prefs_changed
# DESCRIPTION: Reconfigures register window when a preference
# changes.
#
# ARGUMENTS:
# pref - the preference which changed
# value - preference's new value
# RETURNS: Nothing
#
# NOTES: Callback from pref system
# ------------------------------------------------------------------
body RegWin::_prefs_changed {pref value} {
switch $pref {
gdb/font/highlight_fg {
$itk_component(table) tag configure highlight -fg $value
}
gdb/font/highlight_bg {
$itk_component(table) tag configure highlight -bg $value
}
gdb/font/select_fg {
$itk_component(table) tag configure sel -bg $value
}
gdb/font/select_bg {
$itk_component(table) tag configure sel -bg $value
}
gdb/font/header_fg {
$itk_component(table) tag configure header -bg $value
}
gdb/font/header_bg {
$itk_component(table) tag configure header -bg $value
}
}
}
#
# Table event handlers and related methods
#
# ------------------------------------------------------------------
# NAME: private method RegWin::_accept_edit
# DESCRIPTION: Change a register's value
#
# ARGUMENTS: None
# RETURNS: Nothing
#
# NOTES: Event handler for <Enter> and <KP_Enter>
# in table
# ------------------------------------------------------------------
body RegWin::_accept_edit {} {
set cell [$itk_component(table) tag cell edit]
if {[llength $cell] == 1 && [info exists _register($cell)]} {
# Select the same cell again. This forces the table
# to keep this value. Otherwise, we'll never see it...
_select_cell $cell
set n [gdb_reginfo name $_register($cell)]
set v [string trim [$itk_component(table) curvalue] \ \r\n]
if {$v != ""} {
if {[catch {gdb_cmd "set \$${n}=$v"} result]} {
tk_messageBox -icon error -type ok -message $result \
-title "Error in Expression" -parent $_top
}
}
# Always update the register, even for error conditions. This
# will ensure that the cell's old value is restored to the table.
_update_register $_register($cell)
_size_cell_column $cell 1
}
# Reset the table bindings (see RegWin::_edit comments)
bind $itk_component(table) <1> {}
bind $itk_component(table) <ButtonRelease-1> {}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_add_to_watch
# DESCRIPTION: Add a register to the watch window
#
# ARGUMENTS: rn - the register number to add to the WatchWin
# RETURNS: Nothing
#
# NOTES: Only works with one WatchWin...
# ------------------------------------------------------------------
body RegWin::_add_to_watch {rn} {
[ManagedWin::open WatchWin] add "\$[gdb_reginfo name $rn]"
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_but3
# DESCRIPTION: Configure the popup menu before posting it
#
# ARGUMENTS: x - x-coordinate of buttonpress
# y - y-coordinate
# X - x-root coordinate
# Y - y-root coordinate
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_but3 {x y X Y} {
# Only post the menu when we're not executing the inferior,
# the inferior is in a runnable state, and we're not in a disabled
# cell.
if {!$_running && $::gdb_running} {
# Select the register
set cell [_select_cell [$itk_component(table) index @$x,$y]]
if {[info exists _register($cell)]} {
set rn $_register($cell)
set name [gdb_reginfo name $rn]
$itk_component(popup) delete 0 end
$itk_component(popup) add command -label $name -state disabled
$itk_component(popup) add separator
if {!$_typed($rn)} {
$itk_component(popup) add radio -label "Hex" \
-variable [scope _format($rn)] -value x \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Decimal" \
-variable [scope _format($rn)] -value d \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Unsigned" \
-variable [scope _format($rn)] -value u \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Natural" \
-variable [scope _format($rn)] -value {} \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Binary" \
-variable [scope _format($rn)] -value t \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Octal" \
-variable [scope _format($rn)] -value o \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Raw" \
-variable [scope _format($rn)] -value r \
-command [code $this _change_format $rn]
$itk_component(popup) add radio -label "Floating Point" \
-variable [scope _format($rn)] -value f \
-command [code $this _change_format $rn]
$itk_component(popup) add separator
}
if {$_editable($rn)} {
set state normal
} else {
set state disabled
}
# I'm disabling this, since it doesn't work very well.
# All kinds of goofy interactions with the insertion cursor
# and focus when editing is invoked from a menu. (KRS 20010717)
if {1} {
$itk_component(popup) add command \
-label "Edit" -command "after idle [code $this _edit $x $y]" -state $state
}
$itk_component(popup) add command \
-label "Add to Watch" -command [code $this _add_to_watch $rn]
$itk_component(popup) add separator
$itk_component(popup) add command \
-label "Remove from Display" \
-command [code $this _delete_from_display $rn]
if {[llength $_register(hidden)] != 0} {
$itk_component(popup) add command -label "Display all Registers" \
-command [code $this _display_all]
}
tk_popup $itk_component(popup) $X $Y
}
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_delete_from_display
# DESCRIPTION: Remove a register from the display
#
# ARGUMENTS: rn - the register number to remove
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_delete_from_display {rn} {
# Mark the cell as hidden
set index [lsearch $_reg_display_list $rn]
if {$index != -1} {
pref setd gdb/reg/[gdb_reginfo name $rn] no
set _reg_display_list [lreplace $_reg_display_list $index $index]
# Relayout table
_layout_table
$itk_component(reg_menu) entryconfigure $_menuitems(display_all_registers) \
-state normal
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_display_all
# DESCRIPTION: Display all registers in the window
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_display_all {} {
$itk_component(reg_menu) entryconfigure $_menuitems(display_all_registers) \
-state disabled
# Unhide all hidden registers
foreach r $_register(hidden) {
pref setd gdb/reg/[gdb_reginfo name $r] {}
}
set _register(hidden) {}
# Note which register is active and restore it
if {[catch {$itk_component(table) index active} cell]} {
set active {}
} else {
set active $_register($cell)
}
_layout_table
if {$active != ""} {
$itk_component(table) activate $_cell($active)
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_edit
# DESCRIPTION: Enables a cell for editing
#
# ARGUMENTS:
# x - the x coordinate of the button press
# y - the y coordinate of the button press
# RETURNS: Nothing
#
# NOTES: Event handler for <Double-1> in table.
# Sets special bindings for <1> and <ButtonRelease-1>.
# ------------------------------------------------------------------
body RegWin::_edit {x y} {
global gdb_running
focus $itk_component(table)
# Get and select the cell and set the edit tag on it
set cell [_select_cell [$itk_component(table) index @$x,$y]]
# Ugh. In order to click on the label and keep the value
# focused, we need to disrupt the ButtonRelease-1 event.
bind $itk_component(table) <ButtonRelease-1> break
# Disable the <1> binding while editing
bind $itk_component(table) <1> break
# Now mark the cell as being edited.
if {$gdb_running && [info exists _register($cell)]} {
$itk_component(table) tag cell edit $cell
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_edit_menu
# DESCRIPTION: Enables a cell for editing when invoked from
# a menu
#
# ARGUMENTS:
# rn - the register to edit
# RETURNS: Nothing
#
# NOTES:
# ------------------------------------------------------------------
body RegWin::_edit_menu {rn} {
set bbox [$itk_component(table) bbox $_cell($rn)]
_edit [lindex $bbox 0] [lindex $bbox 1]
event generate $_top <Enter>
}
# ------------------------------------------------------------------
# NAME: private method _move
# DESCRIPTION: Handle arrow key events in table
#
# ARGUMENTS: direction - "up", "down", "left", "right"
# RETURNS: Nothing
#
# NOTES: Event handler for <Up>, <Down>, <Left>, <Right>
# in table. This is needed because the table
# has some rather strange bindings for moving
# the insertion cursor when editing a cell.
# This method will move to the next cell when
# we're not editing, or it will move the icursor
# if we are editing.
# ------------------------------------------------------------------
body RegWin::_move {direction} {
# If there is no active cell, the table will call error
if {[catch {$itk_component(table) index active row} row]} {
return
}
if {[$itk_component(table) tag cell edit] != ""} {
# Editing
switch $direction {
up {
# Go to beginning
$itk_component(table) icursor 0
}
down {
# Go to end
$itk_component(table) icursor end
}
left {
# Go left one character
set ic [$itk_component(table) icursor]
if {$ic > 0} {
$itk_component(table) icursor [expr {$ic - 1}]
}
}
right {
# Go right one character
set ic [$itk_component(table) icursor]
if {$ic < [$itk_component(table) icursor end] } {
$itk_component(table) icursor [expr {$ic + 1}]
}
}
}
} else {
# Not editing
set col [$itk_component(table) index active col]
lassign [_dimensions] cols rows
switch $direction {
up {
incr row -1
if {$row < 0} {
# go to bottom
set row $rows
}
}
down {
incr row 1
if {$row == $rows} {
# go to top
set row 0
}
}
left {
incr col -2
if {$col < 0} {
# go to right
set col [expr {$cols -1}]
}
}
right {
incr col 2
if {$col > $cols} {
# go to left
set col 0
}
}
}
# clear the selection
# FIXME: multiple selections?
$itk_component(table) selection clear all
_select_cell $row,$col
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_post_menu
# DESCRIPTION: Configures the Register menu before it is posted
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_post_menu {} {
global gdb_running
# Configure the menu for the active cell
if {![catch {$itk_component(table) index active} cell]
&& [info exists _register($cell)] && $gdb_running} {
$itk_component(reg_menu) entryconfigure $_menuitems(remove_from_display) \
-state normal -command [code $this _delete_from_display $_register($cell)]
if {$_typed($_register($cell))} {
set state disabled
} else {
set state normal
}
for {set i 0} {$i <= [$itk_component(reg_format) index end]} {incr i} {
$itk_component(reg_format) entryconfigure $i \
-state $state \
-variable [scope _format($_register($cell))] \
-command [code $this _change_format $_register($cell)]
}
$itk_component(reg_menu) entryconfigure $_menuitems(add_to_watch) \
-state normal -command [code $this _add_to_watch $_register($cell)]
# This doesn't seem to work on my linux box. It works fine on
# Cygwin, though... (KRS 010806)
if {$_editable($_register($cell))} {
$itk_component(reg_menu) entryconfigure $_menuitems(edit) \
-state normal -command [code $this _edit_menu $_register($cell)]
}
} else {
# Disable everything
$itk_component(reg_menu) entryconfigure $_menuitems(remove_from_display) \
-state disabled -command {}
for {set i 0} {$i <= [$itk_component(reg_format) index end]} {incr i} {
$itk_component(reg_format) entryconfigure $i -state disabled \
-variable {}
}
$itk_component(reg_menu) entryconfigure $_menuitems(add_to_watch) \
-state disabled -command {}
if {0} {
$itk_component(reg_menu) entryconfigure $_menuitems(edit) \
-state disabled -command {}
}
}
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_select
# DESCRIPTION: Selects the cell with the given coordinates
#
# ARGUMENTS:
# x - the x-coordinate of the cell to select
# y - the y-coordinate of the cell to select
# RETURNS: The actual cell selected
# ------------------------------------------------------------------
body RegWin::_select {x y} {
return [_select_cell [$itk_component(table) index @$x,$y]]
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_select_cell
# DESCRIPTION: Selects a given cell in the table
#
# ARGUMENTS:
# cell - the table index to select
# RETURNS: The actual cell selected
#
# NOTES: Adjusts the cell index so that it always
# selects the value cell for a register
# ------------------------------------------------------------------
body RegWin::_select_cell {cell} {
# Abort an edit
_unedit
# check if going to label. If so, highlight next
set row [lindex [split $cell ,] 0]
set col [lindex [split $cell ,] 1]
if {[expr {$col % 2}] == 0} {
# going onto a label
incr col 1
}
# Make the selected cell the active one
$itk_component(table) activate $row,$col
$itk_component(table) see active
# Select this cell and its label
# FIXME: multiple selections?
$itk_component(table) selection clear all
$itk_component(table) selection set $row,$col $row,[expr {$col-1}]
return $row,$col
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_unedit
# DESCRIPTION: Cancels an edit
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_unedit {} {
# clear the tag
set cell [$itk_component(table) tag cell edit]
$itk_component(table) tag cell normal $cell
# Reset the table binding (see RegWin::_edit comments)
bind $itk_component(table) <ButtonRelease-1> {}
bind $itk_component(table) <1> {}
}
#
# Register operations
#
# ------------------------------------------------------------------
# NAME: private method RegWin::_get_value
# DESCRIPTION: Get the value of a register
#
# ARGUMENTS: rn - the register number whose value should be
# fetched
# RETURNS: The register's value or ""
#
# NOTES: This function uses RegWin::_format to determine
# how the value is returned
# It also does some other weird stuff...
# ------------------------------------------------------------------
body RegWin::_get_value {rn} {
# Typed registers natural values start with a brace (escaped by a slash)
if {[catch {gdb_reginfo value {} $rn} valtest]} {
set value ""
} else {
if {[string index $valtest 1] == "\{"} {
# If it is a typed register, we print it raw
set format r
set _format($rn) r
set _typed($rn) 1
set _editable($rn) 0
} else {
set format $_format($rn)
set _editable($rn) 1
}
if {[catch {gdb_reginfo value $format $rn} value]} {
set value ""
} else {
set value [string trim $value \ ]
}
}
return $value
}
# ------------------------------------------------------------------
# NAME: private method RegWin::_change_format
# DESCRIPTION: Change the display format of the register
#
# ARGUMENTS: rn - the register number to change
# RETURNS: Nothing
#
# NOTES: Assumes that hex, "x", is the default
# ------------------------------------------------------------------
body RegWin::_change_format {rn} {
# Set the new format. Hex (x) is the default.
set name [gdb_reginfo name $rn]
if {$_format($rn) == "x"} {
set fmt ""
} else {
set fmt $_format($rn)
}
pref setd gdb/reg/${name}-format $fmt
_update_register $rn
_size_cell_column $_cell($rn) 1
# Show the active cell in case it's moved as a result
# of resizing the columns.
$itk_component(table) see active
}
# ------------------------------------------------------------------
# NAME: private_method RegWin::_update_register
# DESCRIPTION: Updates the value of a register and refreshes
# the table
#
# ARGUMENTS:
# rn - the register number to update
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::_update_register {rn} {
set _data($_cell($rn)) [_get_value $rn]
}
#
# Gdb Events
#
# ------------------------------------------------------------------
# NAME: public method RegWin::arch_changed
# DESCRIPTION: ArchChangedEvent handler
#
# ARGUMENTS: event - the ArchChangedEvent (not used)
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::arch_changed {event} {
# When the arch changes, gdb will callback into gdbtk-register.c
# to swap out the old register set, so we need only redraw the
# window, updating the register names and numbers.
_layout_table
# Clear gdb's change list
catch {gdb_reginfo changed}
}
# ------------------------------------------------------------------
# NAME: public method RegWin::busy
# DESCRIPTION: BusyEvent handler
#
# ARGUMENTS: event - the BusyEvent (not used)
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::busy {event} {
# Abort any edit. Need to check if the table is constructed,
# since we call gdbtk_busy when we're created...
if {[info exists itk_component(table)]} {
_unedit
}
# Set fencepost
set _running 1
# Set cursor
$_top configure -cursor watch
}
# ------------------------------------------------------------------
# NAME: public method RegWin::idle
# DESCRIPTION: IdleEvent handler
#
# ARGUMENTS: event - the IdleEvent (not used)
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::idle {event} {
# Clear fencepost
set _running 0
# Reset cursor
$_top configure -cursor {}
}
# ------------------------------------------------------------------
# NAME: public method RegWin::set_variable
# DESCRIPTION: SetVariableEvent handler
#
# ARGUMENTS: None
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::set_variable {event} {
switch [$event get variable] {
disassembly-flavor {
_layout_table
}
}
}
# ------------------------------------------------------------------
# NAME: public method RegWin::update
# DESCRIPTION: UpdateEvent handler
#
# ARGUMENTS: event - the UpdateEvent (not used)
# RETURNS: Nothing
# ------------------------------------------------------------------
body RegWin::update {event} {
dbug I "START REGISTER UPDATE CALLBACK"
# Change anything on the old change list back to normal
foreach r $_change_list {
if {$_cell($r) != "hidden"} {
$itk_component(table) tag cell normal $_cell($r)
}
}
# Now update and highlight the newly changed values
set _change_list {}
if {![catch {eval gdb_reginfo changed $_reg_display_list} changed]} {
set _change_list $changed
}
# Problem: if the register was invalid (i.e, we were not running),
# its old value will probably be "0x0". Now if we run and its real
# value is "0x0", then it will appear as a blank in the register
# window. Safegaurd against that here by adding any such register
# which is not already in the change list.
foreach r $_reg_display_list {
if {$_data($_cell($r)) == "" && [lsearch $_change_list $r] == -1} {
lappend _change_list $r
}
}
# Tag the changed cells and resize the columns
set cols {}
foreach r $_change_list {
_update_register $r
$itk_component(table) tag cell highlight $_cell($r)
set col [lindex [split $_cell($r) ,] 1]
if {[lsearch $cols $col] == -1} {
lappend cols $col
}
}
foreach col $cols {
set col [string trim $col ()]
_size_column $col 0
}
dbug I "END REGISTER UPDATE CALLBACK"
}