summaryrefslogtreecommitdiff
path: root/gdb/gdbtk/library/memwin.itb
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/gdbtk/library/memwin.itb')
-rw-r--r--gdb/gdbtk/library/memwin.itb774
1 files changed, 0 insertions, 774 deletions
diff --git a/gdb/gdbtk/library/memwin.itb b/gdb/gdbtk/library/memwin.itb
deleted file mode 100644
index 4c71ed00ef6..00000000000
--- a/gdb/gdbtk/library/memwin.itb
+++ /dev/null
@@ -1,774 +0,0 @@
-# Memory display window class definition for Insight.
-# Copyright 1998, 1999, 2001, 2002 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.
-
-# ------------------------------------------------------------------
-# METHOD: constructor - build the dialog
-# ------------------------------------------------------------------
-itcl::body MemWin::constructor {args} {
- global _mem
- debug $args
- eval itk_initialize $args
-
- set top [winfo toplevel $itk_interior]
- gdbtk_busy
-
- set _mem($this,enabled) 1
-
- if {![info exists type(1)]} {
- set type(1) char
- set type(2) short
- set type(4) int
- set type(8) "long long"
- }
-
- if {[pref getd gdb/mem/menu] != ""} {
- set mbar 0
- }
-
- # Load defaults from preferences.
- set size [pref getd gdb/mem/size]
- set numbytes [pref getd gdb/mem/numbytes]
- set format [pref getd gdb/mem/format]
- set ascii [pref getd gdb/mem/ascii]
- set ascii_char [pref getd gdb/mem/ascii_char]
- set bytes_per_row [pref getd gdb/mem/bytes_per_row]
- set color [pref getd gdb/mem/color]
-
- init_addr_exp
- build_win
- gdbtk_idle
-}
-
-# ------------------------------------------------------------------
-# METHOD: destructor - destroy the dialog
-# ------------------------------------------------------------------
-itcl::body MemWin::destructor {} {
- if {[winfo exists $prefs_win]} {
- $prefs_win cancel
- }
-}
-
-
-# ------------------------------------------------------------------
-# METHOD: build_win - build the main memory window
-# ------------------------------------------------------------------
-itcl::body MemWin::build_win {} {
- global tcl_platform gdb_ImageDir _mem ${this}_memval
-
- set maxlen 0
- set maxalen 0
- set saved_value ""
-
- if { $mbar } {
- menu $itk_interior.m -tearoff 0
- $top configure -menu $itk_interior.m
- $itk_interior.m add cascade -menu $itk_interior.m.addr \
- -label "Addresses" -underline 0
- set m [menu $itk_interior.m.addr]
- $m add check -label " Auto Update" -variable _mem($this,enabled) \
- -underline 1 -command "after idle $this toggle_enabled"
- $m add command -label " Update Now" -underline 1 \
- -command [code $this _update_address 1] -accelerator {Ctrl+U}
- $m add separator
- $m add command -label " Preferences..." -underline 1 \
- -command "$this create_prefs"
- }
-
- # Numcols = number of columns of data
- # numcols = number of columns in table (data plus headings plus ASCII)
- # if numbytes are 0, then use window size to determine how many to read
- if {$numbytes == 0} {
- set Numrows 8
- } else {
- set Numrows [expr {$numbytes / $bytes_per_row}]
- }
- set numrows [expr {$Numrows + 1}]
-
- set Numcols [expr {$bytes_per_row / $size}]
- if {$ascii} {
- set numcols [expr {$Numcols + 2}]
- } else {
- set numcols [expr {$Numcols + 1}]
- }
-
- itk_component add table {
- ::table $itk_interior.t -titlerows 1 -titlecols 1 -variable ${this}_memval \
- -roworigin -1 -colorigin -1 -bg $::Colors(textbg) -fg $::Colors(textfg) \
- -browsecmd "$this changed_cell %s %S" -font global/fixed\
- -colstretch unset -rowstretch unset -selectmode single \
- -xscrollcommand "$itk_interior.sx set" -resizeborders none \
- -cols $numcols -rows $numrows -autoclear 1
- } {
- keep -foreground
- keep -insertbackground
- keep -highlightcolor
- keep -highlightbackground
- }
-
- if {$numbytes} {
- $itk_component(table) configure -yscrollcommand "$itk_interior.sy set"
- scrollbar $itk_interior.sy -command [list $itk_component(table) yview]
- } else {
- $itk_component(table) configure -rowstretchmode none
- }
- scrollbar $itk_interior.sx -command [list $itk_component(table) xview] -orient horizontal
- $itk_component(table) tag config sel -bg [$itk_component(table) cget -bg] -relief sunken
- $itk_component(table) tag config active -relief sunken -wrap 0 \
- -bg $::Colors(sbg) -fg $::Colors(sfg)
- $itk_component(table) tag config title -bg $::Colors(bg) -fg $::Colors(fg)
-
- # rebind all events that use tkTableMoveCell to our local version
- # because we don't want to move into the ASCII column if it exists
- bind $itk_component(table) <Up> "$this memMoveCell %W -1 0; break"
- bind $itk_component(table) <Down> "$this memMoveCell %W 1 0; break"
- bind $itk_component(table) <Left> "$this memMoveCell %W 0 -1; break"
- bind $itk_component(table) <Right> "$this memMoveCell %W 0 1; break"
- bind $itk_component(table) <Return> "$this memMoveCell %W 0 1; break"
- bind $itk_component(table) <KP_Enter> "$this memMoveCell %W 0 1; break"
-
- # bind button 3 to popup
- bind $itk_component(table) <3> "$this do_popup %X %Y"
-
- # bind Paste and button2 to the paste function
- # this is necessary because we want to not just paste the
- # data into the cell, but we also have to write it
- # out to real memory
- bind $itk_component(table) <ButtonRelease-2> [format {after idle %s paste %s %s} $this %x %y]
- bind $itk_component(table) <<Paste>> [format {after idle %s paste %s %s} $this %x %y]
-
- menu $itk_component(table).menu -tearoff 0
- bind_plain_key $top Control-u [code $this _update_address 1]
-
- # bind resize events
- bind $itk_interior <Configure> "$this newsize %h"
-
- frame $itk_interior.f
- iwidgets::spinint $itk_interior.f.cntl -labeltext " Address " -width 20 \
- -command "after idle $this update_address_cb" \
- -increment "after idle $this incr_addr -1" \
- -decrement "after idle $this incr_addr 1" -foreground $::Colors(textfg) \
- -validate {} -textbackground $::Colors(textbg)
- $itk_interior.f.cntl delete 0 end
- $itk_interior.f.cntl insert end $addr_exp
-
- label $itk_interior.f.endian -text "Target is [gdbtk_endian] endian"
-
- balloon register [$itk_interior.f.cntl childsite].uparrow \
- "Scroll Up (Decrement Address)"
- balloon register [$itk_interior.f.cntl childsite].downarrow \
- "Scroll Down (Increment Address)"
- if {!$mbar} {
- button $itk_interior.f.upd -command [code $this _update_address 1] \
- -image [image create photo -file [::file join $gdb_ImageDir check.gif]]
- balloon register $itk_interior.f.upd "Update Now"
- checkbutton $itk_interior.cb -variable _mem($this,enabled) -command "$this toggle_enabled"
- balloon register $itk_interior.cb "Toggles Automatic Display Updates"
- grid $itk_interior.f.upd $itk_interior.f.cntl $itk_interior.f.endian -sticky ew -padx 5
- } else {
- grid $itk_interior.f.cntl x $itk_interior.f.endian -sticky e
- grid columnconfigure $itk_interior.f 1 -weight 1
- }
-
- # draw top border
- set col 0
- for {set i 0} {$i < $bytes_per_row} { incr i $size} {
- set ${this}_memval(-1,$col) [format " %X" $i]
- incr col
- }
-
- if {$ascii} {
- set ${this}_memval(-1,$col) ASCII
- }
-
- # fill initial display
- if {$nb} {
- _update_address 0
- }
-
- if {!$mbar} {
- grid $itk_interior.f x -row 0 -column 0 -sticky nws
- grid $itk_interior.cb -row 0 -column 1 -sticky news
- } else {
- grid $itk_interior.f -row 0 -column 0 -sticky news
- }
- grid $itk_component(table) -row 1 -column 0 -sticky news
- if {$numbytes} { grid $itk_interior.sy -row 1 -column 1 -sticky ns }
- grid $itk_interior.sx -sticky ew
- grid columnconfig $itk_interior 0 -weight 1
- grid rowconfig $itk_interior 1 -weight 1
- focus $itk_interior.f.cntl
-
- window_name "Memory"
-}
-
-# ------------------------------------------------------------------
-# METHOD: paste - paste callback. Update cell contents after paste
-# ------------------------------------------------------------------
-itcl::body MemWin::paste {x y} {
- edit [$itk_component(table) index @$x,$y]
-}
-
-# ------------------------------------------------------------------
-# METHOD: validate - because the control widget wants this
-# ------------------------------------------------------------------
-itcl::body MemWin::validate {val} {
- return $val
-}
-
-# ------------------------------------------------------------------
-# METHOD: create_prefs - create memory preferences dialog
-# ------------------------------------------------------------------
-itcl::body MemWin::create_prefs {} {
- if {$Running} { return }
-
- # make sure row height is set
- if {$rheight == ""} {
- set rheight [lindex [$itk_component(table) bbox 0,0] 3]
- }
-
- set prefs_win [ManagedWin::open MemPref -force -over $this\
- -transient -win $this \
- -size $size -format $format -numbytes $numbytes \
- -bpr $bytes_per_row -ascii $ascii \
- -ascii_char $ascii_char -color $color]
-}
-
-# ------------------------------------------------------------------
-# METHOD: changed_cell - called when moving from one cell to another
-# ------------------------------------------------------------------
-itcl::body MemWin::changed_cell {from to} {
- #debug "moved from $from to $to"
- #debug "value = [$itk_component(table) get $from]"
- if {$saved_value != ""} {
- if {$saved_value != [$itk_component(table) get $from]} {
- edit $from
- }
- }
- set saved_value [$itk_component(table) get $to]
-}
-
-# ------------------------------------------------------------------
-# METHOD: edit - edit a cell
-# ------------------------------------------------------------------
-itcl::body MemWin::edit { cell } {
- global _mem ${this}_memval
-
- #debug "edit $cell"
-
- if {$Running || $cell == ""} { return }
- set rc [split $cell ,]
- set row [lindex $rc 0]
- set col [lindex $rc 1]
- set val [$itk_component(table) get $cell]
-
- if {$col == $Numcols} {
- # editing the ASCII field
- set addr [gdb_incr_addr $current_addr [expr {$bytes_per_row * $row}]]
- set start_addr $addr
-
- # calculate number of rows to modify
- set len [string length $val]
- set rows 0
- while {$len > 0} {
- incr rows
- set len [expr {$len - $bytes_per_row}]
- }
- set nb [expr {$rows * $bytes_per_row}]
-
- # now process each char, one at a time
- foreach c [split $val ""] {
- if {$c != $ascii_char} {
- scan $c %c char
- if {[catch {gdb_set_mem $addr [format %02x $char] 1} res]} {
- error_dialog $res
-
- # reset value
- set ${this}_memval($row,$col) $saved_value
- return
- }
- }
- set addr [gdb_incr_addr $addr]
- }
- set addr $start_addr
- set nextval 0
- # now read back the data and update the widget
- catch {gdb_update_mem ${this}_memval $addr $format $size $nb $bytes_per_row $ascii_char} vals
- return
- }
-
- # calculate address based on row and column
- set addr [gdb_incr_addr $current_addr [expr {$bytes_per_row * $row + $size * $col}]]
- #debug " edit $row,$col $addr = $val"
-
- # Pad the value with zeros, if necessary
- set s [expr {$size * 2}]
- set val [format "0x%0${s}x" $val]
-
- # set memory
- #debug "set_mem $addr $val $size"
- if {[catch {gdb_set_mem $addr $val $size} res]} {
- error_dialog $res
-
- # reset value
- set ${this}_memval($row,$col) $saved_value
- return
- }
-
- # read it back
- # FIXME - HACK ALERT - This call causes trouble with remotes on Windows.
- # This routine is in fact called from within an idle handler triggered by
- # memMoveCell. Something evil happens in that handler that causes gdb to
- # start writing this changed value into all the visible cells...
- # I have not figured out the cause of this, so for now I commented this
- # line out. It will only matter if the write did not succeed, and this was
- # not a very good way to tell the user about that anyway...
- #
- # catch {gdb_update_mem $addr $format $size $size $size ""} val
- # delete whitespace in response
- set val [string trimright $val]
- set val [string trimleft $val]
- set ${this}_memval($row,$col) $val
-}
-
-
-# ------------------------------------------------------------------
-# METHOD: toggle_enabled - called when enable is toggled
-# ------------------------------------------------------------------
-itcl::body MemWin::toggle_enabled {} {
- global _mem
-
- if {$Running} { return }
- if {$_mem($this,enabled)} {
- _update_address 1
- set state normal
- set bg $::Colors(textbg)
- } else {
- set bg $::Colors(bg)
- set state disabled
- }
- $itk_component(table) config -background $bg -state $state
-}
-
-# ------------------------------------------------------------------
-# METHOD: update - update widget after every PC change
-# ------------------------------------------------------------------
-itcl::body MemWin::update {event} {
- global _mem
- if {$_mem($this,enabled)} {
- _update_address 0
- }
-}
-
-# ------------------------------------------------------------------
-# METHOD: idle - memory window is idle, so enable menus
-# ------------------------------------------------------------------
-itcl::body MemWin::idle {event} {
- # Fencepost
- set Running 0
-
- # Cursor
- cursor {}
-
- if {[winfo exists $itk_interior.m.addr]} {
- # Enable menus
- if {$mbar} {
- for {set i 0} {$i <= [$itk_interior.m.addr index last]} {incr i} {
- if {[$itk_interior.m.addr type $i] != "separator"} {
- $itk_interior.m.addr entryconfigure $i -state normal
- }
- }
- }
-
- # Enable control
- $itk_interior.f.cntl configure -state normal
- }
-}
-
-
-# ------------------------------------------------------------------
-# METHOD: busy - BusyEvent handler
-# Disable menus 'cause we're busy updating things.
-# ------------------------------------------------------------------
-itcl::body MemWin::busy {event} {
- # Fencepost
- set Running 1
-
- # cursor
- cursor watch
-
- # go away if window is not finished drawing
- if {![winfo exists $itk_interior.f.cntl]} { return }
-
- # Disable menus
- if {$mbar} {
- for {set i 0} {$i <= [$itk_interior.m.addr index last]} {incr i} {
- if {[$itk_interior.m.addr type $i] != "separator"} {
- $itk_interior.m.addr entryconfigure $i -state disabled
- }
- }
- }
-
- # Disable control
- $itk_interior.f.cntl configure -state disabled
-}
-
-# ------------------------------------------------------------------
-# METHOD: newsize - calculate how many rows to display when the
-# window is resized.
-# ------------------------------------------------------------------
-itcl::body MemWin::newsize {height} {
-
- if {$dont_size || $Running} {
- return
- }
-
- # only add rows if numbytes is zero
- if {$numbytes == 0} {
- ::update idletasks
-
- # make sure row height is set
- if {$rheight == ""} {
- set rheight [lindex [$itk_component(table) bbox 0,0] 3]
- }
-
- set theight [winfo height $itk_component(table)]
- set Numrows [expr {$theight / $rheight}]
- $itk_component(table) configure -rows $Numrows
- _update_address 1
- }
-}
-
-itcl::body MemWin::_update_address {make_busy} {
- if {$make_busy} {
- gdbtk_busy
- }
- update_address [string trimleft [$itk_interior.f.cntl get]]
- if {$make_busy} {
- gdbtk_idle
- }
-}
-
-# ------------------------------------------------------------------
-# METHOD: update_address_cb - address entry widget callback
-# ------------------------------------------------------------------
-itcl::body MemWin::update_address_cb {} {
- set new_entry 1
- _update_address 1
-}
-
-# ------------------------------------------------------------------
-# METHOD: update_address - update address and data displayed
-# ------------------------------------------------------------------
-itcl::body MemWin::update_address {addr_exp} {
-
- set bad_expr 0
- set saved_addr $current_addr
- if {[string match {[a-zA-Z_&0-9\*]*} $addr_exp]} {
- # Looks like an expression
- set retVal [catch {gdb_eval "$addr_exp" x} current_addr]
- #debug "retVal=$retVal current_addr=$current_addr"
- if {$retVal || [string match "No symbol*" $current_addr] || \
- [string match "Invalid *" $current_addr]} {
- BadExpr $current_addr
- return
- }
- if {[string match {\{*} $current_addr]} {
- set current_addr [lindex $current_addr 1]
- if {$current_addr == ""} {
- return
- }
- }
- } elseif {[regexp {\$[a-zA-Z_]} $addr_exp]} {
- # Looks like a local variable
- set retVal [catch {gdb_eval "$addr_exp" x} current_addr]
- #debug "retVal=$retVal current_addr=$current_addr"
- if {$retVal} {
- BadExpr $current_addr
- return
- }
- if {$current_addr == "void"} {
- BadExpr "No Local Variable Named \"$addr_exp\""
- return
- }
- } else {
- # something really strange, like "0.1" or ""
- BadExpr "Can't Evaluate \"$addr_exp\""
- return
- }
-
- # Check for spaces - this can happen with gdb_eval and $pc, for example.
- set index [string first \ $current_addr]
- if {$index != -1} {
- incr index -1
- set current_addr [string range $current_addr 0 $index]
- }
-
- # set table background
- $itk_component(table) config -bg $::Colors(textbg) -state normal
- catch {update_addr}
-}
-
-# ------------------------------------------------------------------
-# METHOD: BadExpr - handle a bad expression
-# ------------------------------------------------------------------
-itcl::body MemWin::BadExpr {errTxt} {
- if {$new_entry} {
- tk_messageBox -type ok -icon error -message $errTxt
- set new_entry 0
- }
- # set table background to gray
- $itk_component(table) config -bg $::Colors(bg) -state disabled
- set current_addr $saved_addr
- set saved_addr ""
- set bad_expr 1
-}
-
-# ------------------------------------------------------------------
-# METHOD: incr_addr - callback from control widget to increment
-# the current address.
-# ------------------------------------------------------------------
-itcl::body MemWin::incr_addr {num} {
- if {$current_addr == ""} {
- return
- }
- set old_addr $current_addr
- set current_addr [gdb_incr_addr $current_addr [expr {$bytes_per_row * $num}]]
-
- # A memory address less than zero is probably not a good thing...
- #
-
- if {($num < 0 && [gdb_eval "$current_addr > $old_addr"]) \
- ||($num > 0 && [gdb_eval "$current_addr < $old_addr"]) } {
- bell
- set current_addr $old_addr
- return
- }
- $itk_component(table) config -bg $::Colors(textbg) -state normal
- $itk_interior.f.cntl clear
- $itk_interior.f.cntl insert 0 $current_addr
- _update_address 1
-}
-
-
-# ------------------------------------------------------------------
-# METHOD: update_addr - read in data starting at $current_addr
-# This is just a helper function for update_address.
-# ------------------------------------------------------------------
-itcl::body MemWin::update_addr {} {
- global _mem ${this}_memval
-
- set row 0
-
- if {$numbytes == 0} {
- set nb [expr {$Numrows * $bytes_per_row}]
- } else {
- set nb $numbytes
- }
- if {$ascii} {
- set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row $ascii_char} vals]
-
- } else {
- set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row} vals]
- }
-
-
- if {$retVal || [llength $vals] != 3} {
- BadExpr "Couldn't get memory at address: \"$addr\""
- debug "gdb_update_mem returned return code: $retVal and value: \"$vals\""
- return
- }
- # set default column width to the max in the data columns
- $itk_component(table) configure -colwidth [lindex $vals 1]
-
- # set border column width
- $itk_component(table) width -1 [lindex $vals 0]
-
- # set ascii column width
- if {$ascii} {
- $itk_component(table) width $Numcols [lindex $vals 2]
- }
-}
-
-# ------------------------------------------------------------------
-# METHOD: hidemb - hide the menubar. NOT CURRENTLY USED
-# ------------------------------------------------------------------
-itcl::body MemWin::hidemb {} {
- set mbar 0
- reconfig
-}
-
-# ------------------------------------------------------------------
-# METHOD: reconfig - used when preferences change
-# ------------------------------------------------------------------
-itcl::body MemWin::reconfig {} {
- debug
- set addr_exp [string trimright [string trimleft $addr_exp]]
- set wh [winfo height $top]
-
- if [winfo exists $itk_interior.m] { destroy $itk_interior.m }
- if [winfo exists $itk_interior.cb] { destroy $itk_interior.cb }
- if [winfo exists $itk_interior.f.upd] { destroy $itk_interior.f.upd }
- if [winfo exists $itk_interior.sy] { destroy $itk_interior.sy }
- destroy $itk_interior.f.cntl $itk_interior.f $itk_component(table) \
- $itk_interior.sx
-
- set dont_size 1
-
- # If the fonts change, then you will need to recompute the
- # row height. Ditto for switch from fixed number of rows to
- # depends on size.
-
- set rheight ""
-
- # Update preferences to reflect new reality
- pref setd gdb/mem/size $size
- pref setd gdb/mem/numbytes $numbytes
- pref setd gdb/mem/format $format
- pref setd gdb/mem/ascii $ascii
- pref setd gdb/mem/ascii_char $ascii_char
- pref setd gdb/mem/bytes_per_row $bytes_per_row
- pref setd gdb/mem/color $color
-
- build_win
- set dont_size 0
- ::update
-
- if {$numbytes == 0} {
- newsize $wh
- }
-}
-
-# ------------------------------------------------------------------
-# METHOD: do_popup - Display popup menu
-# ------------------------------------------------------------------
-itcl::body MemWin::do_popup {X Y} {
- if {$Running} { return }
- $itk_component(table).menu delete 0 end
- $itk_component(table).menu add check -label "Auto Update" -variable _mem($this,enabled) \
- -underline 0 -command "$this toggle_enabled"
- $itk_component(table).menu add command -label "Update Now" -underline 0 \
- -command [code $this _update_address 1]
- $itk_component(table).menu add command -label "Go To [$itk_component(table) curvalue]" -underline 0 \
- -command "$this goto [$itk_component(table) curvalue]"
- $itk_component(table).menu add command -label "Open New Window at [$itk_component(table) curvalue]" -underline 0 \
- -command [list ManagedWin::open MemWin -force -addr_exp [$itk_component(table) curvalue]]
- $itk_component(table).menu add separator
- $itk_component(table).menu add command -label "Preferences..." -underline 0 \
- -command "$this create_prefs"
- tk_popup $itk_component(table).menu $X $Y
-}
-
-# ------------------------------------------------------------------
-# METHOD: goto - change the address of the current memory window
-# ------------------------------------------------------------------
-itcl::body MemWin::goto { addr } {
- set current_addr $addr
- $itk_interior.f.cntl delete 0 end
- $itk_interior.f.cntl insert end $addr
- _update_address 1
-}
-
-# ------------------------------------------------------------------
-# METHOD: init_addr_exp - initialize address expression
-# On startup, if the public variable "addr_exp" was not set,
-# then set it to the start of ".data" if found, otherwise "$pc"
-# ------------------------------------------------------------------
-itcl::body MemWin::init_addr_exp {} {
- if {$addr_exp == ""} {
- set err [catch {gdb_cmd "info file"} result]
- if {!$err} {
- foreach line [split [string trim $result] \n] {
- if {[scan $line {%x - %x is %s} start stop section] == 3} {
- if {$section == ".data"} {
- set addr_exp [format "%#08x" $start]
- break
- }
- }
- }
- }
- if {$addr_exp == ""} {
- set addr_exp \$pc
- }
- }
-}
-
-# ------------------------------------------------------------------
-# METHOD: cursor - set the cursor
-# ------------------------------------------------------------------
-itcl::body MemWin::cursor {glyph} {
- # Set cursor for all labels
- # for {set i 0} {$i < $bytes_per_row} {incr i $size} {
- # $itk_component(table).h.$i configure -cursor $glyph
- # }
- $top configure -cursor $glyph
-}
-
-# memMoveCell --
-#
-# Moves the location cursor (active element) by the specified number
-# of cells and changes the selection if we're in browse or extended
-# selection mode.
-#
-# Don't allow movement into the ASCII column.
-#
-# Arguments:
-# w - The table widget.
-# x - +1 to move down one cell, -1 to move up one cell.
-# y - +1 to move right one cell, -1 to move left one cell.
-
-itcl::body MemWin::memMoveCell {w x y} {
- if {[catch {$w index active row} r]} return
- set c [$w index active col]
- if {$ascii && ($c == $Numcols)} {
- # we're in the ASCII column so behave differently
- if {$y == 1} {set x 1}
- if {$y == -1} {set x -1}
- incr r $x
- } else {
- incr r $x
- incr c $y
- if { $c < 0 } {
- if {$r == 0} {
- set c 0
- } else {
- set c [expr {$Numcols - 1}]
- incr r -1
- }
- } elseif { $c >= $Numcols } {
- if {$r >= [expr {$Numrows - 1}]} {
- set c [expr {$Numcols - 1}]
- } else {
- set c 0
- incr r
- }
- }
- }
- if { $r < 0 } { set r 0 }
- $w activate $r,$c
- $w see active
-}
-
-# ------------------------------------------------------------
-# PUBLIC METHOD: error_dialog - Open and error dialog.
-# Arguments:
-# msg - The message to display in the dialog
-# modality - The dialog modailty. Default: task
-# type - The dialog type (tk_messageBox).
-# Default: ok
-# ------------------------------------------------------------
-itcl::body MemWin::error_dialog {msg {modality task} {type ok}} {
- set parent [winfo toplevel [namespace tail $this]]
- tk_messageBox -icon error -title Error -type $type \
- -message $msg -parent $parent
-}
-