share/insight1.0/regwin.itb

# Register display window for Insight.
# Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, 2007 Red Hat, Inc.
#
# Written by Keith Seitz (keiths@redhat.com)
#        and 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 Multiple displays
# o Better resizing
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body RegWin::destructor {} {
  debug
}

# ------------------------------------------------------------------
#  NAME:         RegWin::_load_prefs
#  DESCRIPTION:  Load register preferences
#
#  ARGUMENTS:    None
#  RETURNS:      Nothing
# ------------------------------------------------------------------
itcl::body RegWin::_load_prefs {} {
  debug

  # Find out largest register name length.
  set _max_label_width 0;	# for reg labels
  set _reg_display_list {}
  set _register(hidden) {}

  set regs [gdb_reginfo group $_group]
  foreach r [gdb_reginfo name -numbers $regs] {
    set nm [lindex $r 0]
    set rn [lindex $r 1]
    set size [string length $nm]
    if {$size > $_max_label_width} {
      set _max_label_width $size
    }

    # Set type from prefs or default to first in list of types
    set _types($rn) [gdb_reginfo type $rn]
    set tp [pref getd gdb/reg/${nm}-type]
    set _type($rn,name) ""
    if {$tp != ""} {
      foreach t $_types($rn) {
	if {[lindex $t 0] == $tp} {
	  set _type($rn,name) $tp
	  set _type($rn,addr) [lindex $t 1]
	  set _type($rn,code) [lindex $t 2]
	  break
	}
      }
    }
    if {$_type($rn,name) == ""} {
      # either not set or couldn't find it in list of types
      set _type($rn,name) [lindex [lindex $_types($rn) 0] 0]
      set _type($rn,addr) [lindex [lindex $_types($rn) 0] 1]
      set _type($rn,code) [lindex [lindex $_types($rn) 0] 2]
    }

    # Check preferences for format
    set _format($rn) [pref getd gdb/reg/${nm}-format]
    if {$_format($rn) == ""} {
      # no preference set.  Set it to hex or float
      if {$_type($rn,code) == "int"} {
	set _format($rn) "x"
      } else {
	set _format($rn) "f"
      }
      pref setd gdb/reg/${nm}-format $_format($rn)
    }
    
    gdb_reginfo format $rn $_type($rn,addr) $_format($rn)

    # Check if the user prefers not to show this register
    if {[pref getd gdb/reg/$nm] == "no"} {
      set _cell($rn) hidden
      lappend _register(hidden) $rn
    } else {
      lappend _reg_display_list $rn
    }

    # assume editable, for now
    set _editable($rn) 1
  }

  incr _max_label_width 2;	# padding
}


#
# 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.
# ------------------------------------------------------------------
itcl::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] \
      -browsecmd [code $this _select_cell %S] -font global/fixed \
      -colstretch unset -rowstretch unset -selectmode single \
      -resizeborders none -multiline false -colwidth 18 \
      -autoclear 0 -bg $::Colors(bg) \
      -padx 5 -xscrollcommand [code $itk_component(hscroll) set] \
      -yscrollcommand [code $itk_component(vscroll) set]
  } {
    keep -foreground
    keep -insertbackground
    keep -highlightcolor
    keep -highlightbackground
  }
  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> break 
  bind $itk_component(table) <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]


  # 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  \
    -state disabled -bg $::Colors(textbg) -fg $::Colors(textfg)
  $itk_component(table) tag configure sel -bg $::Colors(sbg) -fg $::Colors(sfg)
  $itk_component(table) tag configure highlight -bg $::Colors(change) -fg black
  $itk_component(table) tag raise highlight
  $itk_component(table) tag configure header \
    -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

  itk_component add frame {
    frame $itk_interior.m
  }
  iwidgets::optionmenu $itk_component(frame).opt -labeltext "Group:" \
    -labelpos w -command [code $this _select_group]
  eval $itk_component(frame).opt insert end [gdb_reginfo grouplist]
  $itk_component(frame).opt select "all"
  
  pack $itk_component(frame).opt -anchor nw
  grid $itk_component(frame) -row 0 -columnspan 2 -sticky news
  grid $itk_component(table) -row 1 -column 0 -sticky news
  grid $itk_component(vscroll) -row 1 -column 1 -sticky ns
  grid $itk_component(hscroll) -row 2 -column 0 -sticky ew
  grid columnconfigure $itk_interior 0 -weight 1
  grid rowconfigure $itk_interior 0 -weight 0
  grid rowconfigure $itk_interior 1 -weight 1

  # Add popup menu - we populate it in the event handler
  itk_component add popup {
    menu $itk_interior.pop -tearoff 0
  } {}
}

# ------------------------------------------------------------------
#  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
# ------------------------------------------------------------------
itcl::body RegWin::_layout_table {} {
  debug

  if {[info exists _cell]} {
    unset _cell
    unset _register
  }
  # Clear any column spans
  foreach span [$itk_component(table) spans] {
    $itk_component(table) spans $span 0,0
  }

  _load_prefs

  # 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.
  #
  set x 0
  set y 0

  # get register list
  set regs [gdb_reginfo name -numbers $_reg_display_list]

  # Set table dimensions
  set num [llength $regs]
  set _rows [pref get gdb/reg/rows]
  set _cols [expr $num / $_rows]
  if {[expr $num % $_rows] != 0} { incr _cols }
  set _cols [expr 2 * $_cols]
  $itk_component(table) configure -cols $_cols -rows $_rows

  # get values
  if {[catch {gdb_reginfo value $_reg_display_list} values]} {
    dbug W "values=$values"
    set values ""
  }
  set i 0

  # now build table
  foreach r $regs {
    set name [lindex $r 0]
    set rn [lindex $r 1]

    set _cell($rn) "$y,[expr {$x+1}]"
    set _register($_cell($rn)) $rn
    set _data($y,$x) $name
    set _data($_cell($rn)) [lindex $values $i]
    incr i

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

      $itk_component(table) width $x $_max_label_width
      $itk_component(table) tag col header $x
      $itk_component(table) tag col normal [expr {$x+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
      }
      $itk_component(table) width $x $_max_label_width
      $itk_component(table) tag col header $x
      $itk_component(table) tag col normal [expr {$x+1}]

      set y 0
      incr x 2
    }
  }
}

# ------------------------------------------------------------------
#  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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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::reconfig
#  DESCRIPTION:  Reconfigures register window when a preference
#                changes.
#
#  ARGUMENTS:	 None
#  RETURNS:      Nothing
#
# ------------------------------------------------------------------
itcl::body RegWin::reconfig {} {
  $itk_component(table) tag configure normal  \
    -state disabled -bg $::Colors(textbg) -fg $::Colors(textfg)
}


#
# 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
# ------------------------------------------------------------------
itcl::body RegWin::_accept_edit {} {
  debug
  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 rn $_register($cell)
    set n [gdb_reginfo name $rn]
    if {[llength $_types($rn)] > 1} {
      append n ".$_type($rn,name)"
    }
    set v [string trim [$itk_component(table) curvalue] \ \r\n]
    debug "n=$n v=$v"
    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
  }

  _unedit
}

# ------------------------------------------------------------------
#  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...
# ------------------------------------------------------------------
itcl::body RegWin::_add_to_watch {rn} {
  [ManagedWin::open WatchWin] add "\$[gdb_reginfo name $rn]"
}

# ------------------------------------------------------------------
#  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...
# ------------------------------------------------------------------
itcl::body RegWin::_open_memory {rn} {
  ManagedWin::open MemWin -force -addr_exp $_data($_cell($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
# ------------------------------------------------------------------
itcl::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 {[llength $_types($rn)] > 1} {
	foreach t $_types($rn) {
	  $itk_component(popup) add radio -label [lindex $t 0] \
	    -variable [scope _type($rn,addr)] \
	    -value [lindex $t 1] \
	    -command [code $this _change_format $rn [lindex $t 0]]
	}
	$itk_component(popup) add separator
      }

      $itk_component(popup) add radio -label "Hex"            \
	-variable [scope _format($rn)] -value x               \
	-command [code $this _change_format $rn]

      if {$_type($rn,code) == "int"} {
	$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]
      } elseif {$_type($rn,code) == "float"} {
	$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
      }
      
      if {$_type($rn,code) == "int"} {
	$itk_component(popup) add command    \
	  -label "Open Memory Window" -command [code $this _open_memory $rn]
      }
      $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]
      }

      # Help
      $itk_component(popup) add separator
      $itk_component(popup) add command    \
	-label "Help" -command {open_help register.html}

      # Close
      $itk_component(popup) add separator
      $itk_component(popup) add command -label "Close" \
	-underline 0 -command [code delete object $this]

      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
# ------------------------------------------------------------------
itcl::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
  }
}

# ------------------------------------------------------------------
#  NAME:         private method RegWin::_display_all
#  DESCRIPTION:  Display all registers in the window
#
#  ARGUMENTS:    None
#  RETURNS:      Nothing
# ------------------------------------------------------------------
itcl::body RegWin::_display_all {} {

  # Unhide all hidden registers
  foreach r $_register(hidden) {
    pref setd gdb/reg/[gdb_reginfo name $r] {}
  }

  # 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 <1> in table.
#                
# ------------------------------------------------------------------
itcl::body RegWin::_edit {x y} {
  _select_cell [$itk_component(table) index @$x,$y]
}


# ------------------------------------------------------------------
#  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.
# ------------------------------------------------------------------
itcl::body RegWin::_move {direction} {

  debug $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]

    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::_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
# ------------------------------------------------------------------
itcl::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
  }
  set cell "$row,$col"

  # 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 $cell $row,[expr {$col-1}]

  # Now mark the cell as being edited.
  if {$::gdb_running && [info exists _register($cell)]} {
    $itk_component(table) tag cell edit $cell
  }

  focus $itk_component(table)

  return $cell
}

# ------------------------------------------------------------------
#  NAME:         private method RegWin::_unedit
#  DESCRIPTION:  Cancels an edit
#
#  ARGUMENTS:    None
#  RETURNS:      Nothing
# ------------------------------------------------------------------
itcl::body RegWin::_unedit {} {

  # clear the tag
  set cell [$itk_component(table) tag cell edit]

  if {$cell != ""} {
    $itk_component(table) selection clear all
    $itk_component(table) tag cell normal $cell 
    focus $itk_component(table)
  }
}

#
# 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:        
# ------------------------------------------------------------------
itcl::body RegWin::_get_value {rn} {
  if {[catch {gdb_reginfo value $rn} value]} {
    dbug W "\"gdb_reginfo value $rn\" returned $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
#		 newtype - type name (optional if just format changed)
#
#  RETURNS:      Nothing
#
#  NOTES:        
# ------------------------------------------------------------------
itcl::body RegWin::_change_format {rn {newtype {}}} {

  set name [gdb_reginfo name $rn]

  if {$newtype != ""} {
    set _type($rn,name) $newtype
    pref setd gdb/reg/${name}-type $newtype
  }
  
  gdb_reginfo format $rn $_type($rn,addr) $_format($rn)

  # Set the new format in prefs. 
  pref setd gdb/reg/${name}-format $_format($rn)

  _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
# ------------------------------------------------------------------
itcl::body RegWin::_update_register {rn} {
  set _data($_cell($rn)) [_get_value $rn]
}

# ------------------------------------------------------------------
#  NAME:         private_method RegWin::_select_group
#  DESCRIPTION:  Changes the register group. Callback
#
#  ARGUMENTS:
#                
#  RETURNS:      Nothing
# ------------------------------------------------------------------
itcl::body RegWin::_select_group {} {
  set gr [$itk_component(frame).opt get]
  debug $gr
  if {$gr == ""} {
    return
  }

  # Change anything on the old change list back to normal
  foreach r $_change_list {
    if {[info exists _cell($r)] && $_cell($r) != "hidden"} {
      $itk_component(table) tag cell normal $_cell($r)
    }
  }

  set _group $gr
  _layout_table

  # highlight changed registers if they still exist in the new group
  foreach r $_change_list {
    if {[info exists _cell($r)] && $_cell($r) != "hidden" && $_data($_cell($r)) != ""} {
      $itk_component(table) tag cell highlight $_cell($r)
    }
  }

  # Clear gdb's change list
  catch {gdb_reginfo changed}
}


#
# Gdb Events
#

# ------------------------------------------------------------------
#  NAME:         public method RegWin::arch_changed
#  DESCRIPTION:  ArchChangedEvent handler
#
#  ARGUMENTS:    event  - the ArchChangedEvent (not used)
#  RETURNS:      Nothing
# ------------------------------------------------------------------
itcl::body RegWin::arch_changed {event} {

  # Update internal register caches
  gdb_reg_arch_changed

  # Relayout the table
  _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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body RegWin::update {event} {
  debug

  # Change anything on the old change list back to normal
  foreach r $_change_list {
    if {[info exists _cell($r)] && $_cell($r) != "hidden"} {
      $itk_component(table) tag cell normal $_cell($r)
    }
  }

  # Now update and highlight the newly changed values
  set _change_list {}
  if {![catch {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

    if {$_data($_cell($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
  }

  debug "END REGISTER UPDATE CALLBACK" 
}