From 1566641659e600cf5033e9a1917c4ec505cb3745 Mon Sep 17 00:00:00 2001 From: Martin Hunt Date: Fri, 7 Jun 2002 09:22:44 +0000 Subject: 2002-06-07 Martin M. Hunt * library/prefs.tcl (pref_set_colors): New function. Set up colors from Windows system colors or X resource database. Save in array. (pref_set_defaults): Remove gdb/font/normal_fg, etc. (pref_read): Call pref_set_colors. * library/main.tcl: Remove call to "tix resetoptions TixGray". * library/bpwin.itb, library/browserwin.itb, library/console.itb, library/globalpref.itb, library/memwin.itb, library/process.itb, library/regwin.itb, library/srcpref.itb, library/srctextwin.itb, library/stackwin.itb, library/tdump.tcl, library/tracedlg.tcl, library/variables.tcl: Replace calls to [pref get gdb/fonts/*] for colors with references to Color array. Remove all tixOptions calls. Fix up colors as necessary. --- gdb/gdbtk/library/memwin.itb | 125 ++++++++++++++++++++++--------------------- 1 file changed, 65 insertions(+), 60 deletions(-) (limited to 'gdb/gdbtk/library/memwin.itb') diff --git a/gdb/gdbtk/library/memwin.itb b/gdb/gdbtk/library/memwin.itb index 53bc7b62d62..86ef9a50b9e 100644 --- a/gdb/gdbtk/library/memwin.itb +++ b/gdb/gdbtk/library/memwin.itb @@ -23,7 +23,6 @@ body MemWin::constructor {args} { gdbtk_busy set _mem($this,enabled) 1 - set bg white if {![info exists type(1)]} { set type(1) char @@ -102,45 +101,52 @@ body MemWin::build_win {} { set numcols [expr {$Numcols + 1}] } - table $itk_interior.t -titlerows 1 -titlecols 1 -variable ${this}_memval \ - -roworigin -1 -colorigin -1 -bg $bg \ - -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 + 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_interior.t configure -yscrollcommand "$itk_interior.sy set" - scrollbar $itk_interior.sy -command [list $itk_interior.t yview] + $itk_component(table) configure -yscrollcommand "$itk_interior.sy set" + scrollbar $itk_interior.sy -command [list $itk_component(table) yview] } else { - $itk_interior.t configure -rowstretchmode none + $itk_component(table) configure -rowstretchmode none } - scrollbar $itk_interior.sx -command [list $itk_interior.t xview] -orient horizontal - $itk_interior.t tag config sel -bg [$itk_interior.t cget -bg] -relief sunken - $itk_interior.t tag config active -bg lightgray -relief sunken -wrap 0 - $itk_interior.t tag config title -bg [pref get gdb/font/header_bg] \ - -fg [pref get gdb/font/header_fg] + 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_interior.t "$this memMoveCell %W -1 0; break" - bind $itk_interior.t "$this memMoveCell %W 1 0; break" - bind $itk_interior.t "$this memMoveCell %W 0 -1; break" - bind $itk_interior.t "$this memMoveCell %W 0 1; break" - bind $itk_interior.t "$this memMoveCell %W 0 1; break" - bind $itk_interior.t "$this memMoveCell %W 0 1; break" + bind $itk_component(table) "$this memMoveCell %W -1 0; break" + bind $itk_component(table) "$this memMoveCell %W 1 0; break" + bind $itk_component(table) "$this memMoveCell %W 0 -1; break" + bind $itk_component(table) "$this memMoveCell %W 0 1; break" + bind $itk_component(table) "$this memMoveCell %W 0 1; break" + bind $itk_component(table) "$this memMoveCell %W 0 1; break" # bind button 3 to popup - bind $itk_interior.t <3> "$this do_popup %X %Y" + 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_interior.t [format {after idle %s paste %s %s} $this %x %y] - bind $itk_interior.t <> [format {after idle %s paste %s %s} $this %x %y] + bind $itk_component(table) [format {after idle %s paste %s %s} $this %x %y] + bind $itk_component(table) <> [format {after idle %s paste %s %s} $this %x %y] - menu $itk_interior.t.menu -tearoff 0 + menu $itk_component(table).menu -tearoff 0 bind_plain_key $top Control-u [code $this _update_address 1] # bind resize events @@ -150,9 +156,8 @@ body MemWin::build_win {} { 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" \ - -validate {} \ - -textbackground white + -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 @@ -162,7 +167,6 @@ body MemWin::build_win {} { "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]] @@ -197,7 +201,7 @@ body MemWin::build_win {} { } else { grid $itk_interior.f -row 0 -column 0 -sticky news } - grid $itk_interior.t -row 1 -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 @@ -211,7 +215,7 @@ body MemWin::build_win {} { # METHOD: paste - paste callback. Update cell contents after paste # ------------------------------------------------------------------ body MemWin::paste {x y} { - edit [$itk_interior.t index @$x,$y] + edit [$itk_component(table) index @$x,$y] } # ------------------------------------------------------------------ @@ -229,7 +233,7 @@ body MemWin::create_prefs {} { # make sure row height is set if {$rheight == ""} { - set rheight [lindex [$itk_interior.t bbox 0,0] 3] + set rheight [lindex [$itk_component(table) bbox 0,0] 3] } set prefs_win [ManagedWin::open MemPref -force -over $this\ @@ -244,13 +248,13 @@ body MemWin::create_prefs {} { # ------------------------------------------------------------------ body MemWin::changed_cell {from to} { #debug "moved from $from to $to" - #debug "value = [$itk_interior.t get $from]" + #debug "value = [$itk_component(table) get $from]" if {$saved_value != ""} { - if {$saved_value != [$itk_interior.t get $from]} { + if {$saved_value != [$itk_component(table) get $from]} { edit $from } } - set saved_value [$itk_interior.t get $to] + set saved_value [$itk_component(table) get $to] } # ------------------------------------------------------------------ @@ -265,7 +269,7 @@ body MemWin::edit { cell } { set rc [split $cell ,] set row [lindex $rc 0] set col [lindex $rc 1] - set val [$itk_interior.t get $cell] + set val [$itk_component(table) get $cell] if {$col == $Numcols} { # editing the ASCII field @@ -346,13 +350,13 @@ body MemWin::toggle_enabled {} { if {$Running} { return } if {$_mem($this,enabled)} { _update_address 1 - set bg white set state normal + set bg $::Colors(textbg) } else { - set bg gray + set bg $::Colors(bg) set state disabled } - $itk_interior.t config -background $bg -state $state + $itk_component(table) config -background $bg -state $state } # ------------------------------------------------------------------ @@ -434,12 +438,12 @@ body MemWin::newsize {height} { # make sure row height is set if {$rheight == ""} { - set rheight [lindex [$itk_interior.t bbox 0,0] 3] + set rheight [lindex [$itk_component(table) bbox 0,0] 3] } - set theight [winfo height $itk_interior.t] + set theight [winfo height $itk_component(table)] set Numrows [expr {$theight / $rheight}] - $itk_interior.t configure -rows $Numrows + $itk_component(table) configure -rows $Numrows _update_address 1 } } @@ -510,7 +514,7 @@ body MemWin::update_address {addr_exp} { } # set table background - $itk_interior.t config -bg white -state normal + $itk_component(table) config -bg $::Colors(textbg) -state normal catch {update_addr} } @@ -523,7 +527,7 @@ body MemWin::BadExpr {errTxt} { set new_entry 0 } # set table background to gray - $itk_interior.t config -bg gray -state disabled + $itk_component(table) config -bg $::Colors(bg) -state disabled set current_addr $saved_addr set saved_addr "" set bad_expr 1 @@ -549,7 +553,7 @@ body MemWin::incr_addr {num} { set current_addr $old_addr return } - $itk_interior.t config -background white -state normal + $itk_component(table) config -bg $::Colors(textbg) -state normal $itk_interior.f.cntl clear $itk_interior.f.cntl insert 0 [format "0x%x" $current_addr] _update_address 1 @@ -584,14 +588,14 @@ body MemWin::update_addr {} { return } # set default column width to the max in the data columns - $itk_interior.t configure -colwidth [lindex $vals 1] + $itk_component(table) configure -colwidth [lindex $vals 1] # set border column width - $itk_interior.t width -1 [lindex $vals 0] + $itk_component(table) width -1 [lindex $vals 0] # set ascii column width if {$ascii} { - $itk_interior.t width $Numcols [lindex $vals 2] + $itk_component(table) width $Numcols [lindex $vals 2] } } @@ -615,7 +619,7 @@ body MemWin::reconfig {} { 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_interior.t \ + destroy $itk_interior.f.cntl $itk_interior.f $itk_component(table) \ $itk_interior.sx set dont_size 1 @@ -649,19 +653,19 @@ body MemWin::reconfig {} { # ------------------------------------------------------------------ body MemWin::do_popup {X Y} { if {$Running} { return } - $itk_interior.t.menu delete 0 end - $itk_interior.t.menu add check -label "Auto Update" -variable _mem($this,enabled) \ + $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_interior.t.menu add command -label "Update Now" -underline 0 \ + $itk_component(table).menu add command -label "Update Now" -underline 0 \ -command [code $this _update_address 1] - $itk_interior.t.menu add command -label "Go To [$itk_interior.t curvalue]" -underline 0 \ - -command "$this goto [$itk_interior.t curvalue]" - $itk_interior.t.menu add command -label "Open New Window at [$itk_interior.t curvalue]" -underline 0 \ - -command [list ManagedWin::open MemWin -force -addr_exp [$itk_interior.t curvalue]] - $itk_interior.t.menu add separator - $itk_interior.t.menu add command -label "Preferences..." -underline 0 \ + $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_interior.t.menu $X $Y + tk_popup $itk_component(table).menu $X $Y } # ------------------------------------------------------------------ @@ -704,7 +708,7 @@ body MemWin::init_addr_exp {} { body MemWin::cursor {glyph} { # Set cursor for all labels # for {set i 0} {$i < $bytes_per_row} {incr i $size} { - # $itk_interior.t.h.$i configure -cursor $glyph + # $itk_component(table).h.$i configure -cursor $glyph # } $top configure -cursor $glyph } @@ -767,3 +771,4 @@ body MemWin::error_dialog {msg {modality task} {type ok}} { tk_messageBox -icon error -title Error -type $type \ -modal $modality -message $msg -parent $parent } + -- cgit v1.2.1