# Memory display preferences window for Insight.
# Copyright 1998, 1999, 2002, 2003 Red Hat
#
# 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 MemPref::constructor {args} {
window_name "Memory Preferences"
eval itk_initialize $args
if {$float_size == ""} {
set float_size [gdb_eval sizeof(float)]
set double_size [gdb_eval sizeof(double)]
}
if {[string compare $format f] == 0} {
set gformat x
set format_disabled 1
if {$size == $float_size} {
set gsize 3
} elseif {$size == $double_size} {
set gsize 5
}
} else {
set gsize $size
set gformat $format
}
set gnumbytes $numbytes
set gbpr $bpr
set gascii $ascii
set gascii_char $ascii_char
build_win
if {$format_disabled} {
set format_disabled 0
disable_format
}
wm resizable [winfo toplevel $itk_interior] 0 0
}
# ------------------------------------------------------------------
# METHOD: destructor - destroy the dialog
# ------------------------------------------------------------------
itcl::body MemPref::destructor {} {
trace vdelete [scope gnumbytes] w [code $this check_numbytes]
}
# ------------------------------------------------------------------
# METHOD: build_win - build the dialog
# ------------------------------------------------------------------
itcl::body MemPref::build_win {} {
frame $itk_interior.f
set f [frame $itk_interior.f.a]
frame $itk_interior.f.b
# SIZE
Labelledframe $f.f1 -anchor nw -text Size
set fr [$f.f1 get_frame]
set Widgets(rb-Byte) [radiobutton $fr.1 -variable [scope gsize] -text Byte \
-value 1 -command [code $this enable_format]]
set Widgets(rb-half_word) [radiobutton $fr.2 -variable [scope gsize] -text "Half Word" \
-value 2 -command [code $this enable_format]]
set Widgets(rb-word) [radiobutton $fr.4 -variable [scope gsize] -text Word \
-value 4 -command [code $this enable_format]]
set Widgets(rb-d_word) [radiobutton $fr.8 -variable [scope gsize] -text "Double Word" \
-value 8 -command [code $this enable_format]]
set Widgets(rb-float) [radiobutton $fr.f -variable [scope gsize] -text Float \
-value 3 -command [code $this disable_format]]
set Widgets(rb-d_float) [radiobutton $fr.d -variable [scope gsize] -text "Double Float" \
-value 5 -command [code $this disable_format]]
grid $fr.1 $fr.4 $fr.f -sticky w -padx 4
grid $fr.2 $fr.8 $fr.d -sticky w -padx 4
# FORMAT
Labelledframe $f.f2 -anchor nw -text Format
set fr [$f.f2 get_frame]
set Widgets(rb-binary) [radiobutton $fr.1 -variable [scope gformat] \
-text Binary -value t]
set Widgets(rb-octal) [radiobutton $fr.2 -variable [scope gformat] \
-text Octal -value o]
set Widgets(rb-hex) [radiobutton $fr.3 -variable [scope gformat] \
-text Hex -value x]
set Widgets(rb-signed_dec) [radiobutton $fr.4 -variable [scope gformat] \
-text "Signed Decimal" -value d]
set Widgets(rb-unsign_dec) [radiobutton $fr.5 -variable [scope gformat] \
-text "Unsigned Decimal" -value u]
grid $fr.1 $fr.2 $fr.3 -sticky w -padx 4
grid $fr.4 $fr.5 x -sticky w -padx 4
# TOTAL BYTES
Labelledframe $f.fx -anchor nw -text "Number of Bytes"
if {$gnumbytes == 0} {
set gnumbytes $default_numbytes
set gvar 0
} else {
set gvar 1
}
set fr [$f.fx get_frame]
set Widgets(rb-win_size) [radiobutton $fr.1 -variable [scope gvar] -text "Depends on window size" \
-value 0 -command [code $this toggle_size_control]]
frame $fr.2
set Widgets(rb-fixed) [radiobutton $fr.2.b -variable [scope gvar] -text Fixed \
-value 1 -command [code $this toggle_size_control]]
set old_numbytes $default_numbytes
set Widgets(e-numbytes) [entry $fr.2.e -textvariable [scope gnumbytes] -width 3]
set normal_background [$Widgets(e-numbytes) cget -background]
#
# Trace gnumbytes so it will always be a +'ve integer... Have to set this
# trace AFTER the widget's textvariable is set so this trace will fire
# BEFORE the widget's trace.
#
trace variable [scope gnumbytes] w [code $this check_numbytes]
label $fr.2.l -text bytes
grid $fr.2.b $fr.2.e $fr.2.l -sticky we
grid $fr.1 x -sticky w -padx 4
grid $fr.2 x -sticky w -padx 4
grid columnconfigure $fr 1 -weight 1
# MISC
Labelledframe $f.1 -anchor nw -text "Miscellaneous"
set fr [$f.1 get_frame]
frame $fr.1
label $fr.1.plabel -height 1 -width 1 -bg $color -relief raised
set Widgets(b-color) [button $fr.1.pc -text "Change color..." \
-command [code $this pick $fr.1.plabel]]
grid $fr.1.plabel $fr.1.pc
frame $fr.2
label $fr.2.l -text "Bytes Per Row "
set Widgets(b-bytes_per_row) [::combobox::combobox $fr.2.c \
-command [code $this set_bytes_per_row] \
-width 4 -editable 0 -font global/fixed \
-bg $::Colors(textbg)]
$fr.2.c list insert end 4
$fr.2.c list insert end 8
$fr.2.c list insert end 16
$fr.2.c list insert end 32
$fr.2.c list insert end 64
$fr.2.c list insert end 128
$fr.2.c configure -value $gbpr
pack $fr.2.l -side left -anchor e
pack $fr.2.c -side right
set Widgets(cb-display_ascii) [checkbutton $fr.3 -variable [scope gascii] -text "Display ASCII"]
frame $fr.4
set Widgets(e-ascii_char) [entry $fr.4.e -textvariable [scope gascii_char] -width 1]
label $fr.4.l -text "Control Char"
grid $fr.4.e $fr.4.l -sticky we
grid $fr.2 x $fr.3 -sticky w -padx 4
grid $fr.4 -sticky w -padx 4
grid columnconfigure $fr 1 -weight 1
grid $f.f1 -padx 5 -pady 6 -sticky news
grid $f.f2 -padx 5 -pady 6 -sticky news
grid $f.fx -padx 5 -pady 6 -sticky news
grid $f.1 -padx 5 -pady 6 -sticky we
set Widgets(b-ok) [button $itk_interior.f.b.ok -text OK -command [code $this ok] -width 7 -default active]
focus $Widgets(b-ok)
# If there is an OK button, set Return in the entry field to invoke it...
bind $Widgets(e-numbytes) <KeyPress-Return> "$Widgets(b-ok) flash ; $Widgets(b-ok) invoke"
set Widgets(b-cancel) [button $itk_interior.f.b.quit -text Cancel -command [code $this cancel] -width 7]
set Widgets(b-apply) [button $itk_interior.f.b.apply -text Apply -command [code $this apply] -width 7]
standard_button_box $itk_interior.f.b
grid $itk_interior.f.a
grid $itk_interior.f.b -sticky news
grid $itk_interior.f
#
# Set the state of the window size entry here...
#
toggle_size_control
}
# ------------------------------------------------------------------
# METHOD: busy - make the widget unusable
# ------------------------------------------------------------------
itcl::body MemPref::busy {} {
set top [winfo toplevel $itk_interior]
$top configure -cursor watch
# Disable all the radiobuttons and what not
foreach w [array names Widgets] {
set WidgetState($w) [$Widgets($w) cget -state]
}
foreach w [array names Widgets] {
$Widgets($w) configure -state disabled
}
}
# ------------------------------------------------------------------
# METHOD: idle - make the widget useable
# ------------------------------------------------------------------
itcl::body MemPref::idle {} {
set top [winfo toplevel $itk_interior]
$top configure -cursor {}
# Re-enable all widgets
foreach w [array names Widgets] {
$Widgets($w) configure -state $WidgetState($w)
}
}
# ------------------------------------------------------------------
# METHOD: ok - apply and quit
# ------------------------------------------------------------------
itcl::body MemPref::ok {} {
apply
unpost
}
# ------------------------------------------------------------------
# METHOD: cancel - just close the dialog w/o saving changes
# ------------------------------------------------------------------
itcl::body MemPref::cancel {} {
unpost
}
# ------------------------------------------------------------------
# METHOD: check_numbytes - a trace to make sure gnumbytes is an int > 0
# ------------------------------------------------------------------
itcl::body MemPref::check_numbytes {var index mode} {
upvar \#0 $var true
if {($true != "") && ([catch {expr {(int($true) != double($true)) || $true <= 0}} val]
|| $val)} {
bell
set true $old_numbytes
} else {
set old_numbytes $true
}
}
# ------------------------------------------------------------------
# METHOD: set_bytes_per_row - combobox callback to set the bytes per row
# ------------------------------------------------------------------
itcl::body MemPref::set_bytes_per_row {w value} {
set gbpr $value
}
# ------------------------------------------------------------------
# METHOD: toggle_size_control - toggle the state of the entry box as the
# control method changes
# ------------------------------------------------------------------
itcl::body MemPref::toggle_size_control {} {
if {$gvar} {
$Widgets(e-numbytes) configure -state normal \
-background $normal_background
} else {
$Widgets(e-numbytes) configure -state disabled -background lightgray
if {[info exists Widgets(b-ok)]} {
focus $Widgets(b-ok)
}
}
}
# ------------------------------------------------------------------
# METHOD: apply - apply changes to the parent window
# ------------------------------------------------------------------
itcl::body MemPref::apply {} {
busy
gdbtk_busy
if {$gvar == 0} {
set numbytes 0
} elseif {$gnumbytes == "" || $gnumbytes == 0} {
# Protect against the case where someone sets the
# entry field to an empty string, or pastes in a 0...
bell
set gnumbytes $default_numbytes
set numbytes $gnumbytes
} else {
set numbytes $gnumbytes
}
switch $gsize {
3 {
set size $float_size
set format f
}
5 {
set size $double_size
set format f
}
default {
set size $gsize
set format $gformat
}
}
# pass all the changed values back to parent
debug "$win configChange -size $size -numbytes $numbytes \
-format $format -ascii $gascii \
-ascii_char $gascii_char -bytes_per_row $gbpr \
-color $color"
eval $win configure -size $size -numbytes $numbytes \
-format $format -ascii $gascii \
-ascii_char $gascii_char -bytes_per_row $gbpr \
-color $color
$win reconfig
gdbtk_idle
idle
}
# ------------------------------------------------------------------
# METHOD: enable_format - turn on the format radio buttons
# ------------------------------------------------------------------
itcl::body MemPref::enable_format {} {
if {!$format_disabled} {
return
}
foreach widget {rb-binary rb-octal rb-hex rb-signed_dec rb-unsign_dec} {
$Widgets($widget) configure -state normal
}
set format_disabled 0
}
# ------------------------------------------------------------------
# METHOD: disable_format - turn off the format radio buttons
# ------------------------------------------------------------------
itcl::body MemPref::disable_format {} {
if {$format_disabled} {
return
}
foreach widget {rb-binary rb-octal rb-hex rb-signed_dec rb-unsign_dec} {
$Widgets($widget) configure -state disabled
}
set format_disabled 1
}
# ------------------------------------------------------------------
# METHOD: pick - pick colors
# ------------------------------------------------------------------
itcl::body MemPref::pick {lab} {
set new_color [tk_chooseColor -initialcolor $color -title "Choose color"]
if {$new_color != $color && $new_color != ""} {
set color $new_color
$lab configure -bg $color
}
}
# ------------------------------------------------------------------
# METHOD: reconfig - used when preferences change
# ------------------------------------------------------------------
itcl::body MemPref::reconfig {} {
# for now, just delete and recreate
destroy $itk_interior.f
build_win
}