# ------------------------------------------------------------------
body BpWin::build_win {} {
global _bp_en _bp_disp tcl_platform
- set bg1 [pref get gdb/font/normal_bg]
+ set bg1 $::Colors(bg)
if {$tcl_platform(platform) == "windows"} {
# Add a sizebox and set scroll modes to static
# FIXME: The iwidgets scrolled frame is pretty useless.
# When we get BLT, use its hiertable to do this.
itk_component add sframe {
- iwidgets::scrolledframe $itk_interior.sf -background $bg1 \
+ iwidgets::scrolledframe $itk_interior.sf \
-hscrollmode $hsmode -vscrollmode $vsmode
- } {}
+ }
set twin [$itk_component(sframe) childsite]
if {$thread != "-1"} {set color [pref get gdb/src/thread_fg]}
if {$tcl_platform(platform) == "windows"} {
- checkbutton $twin.en$i -relief flat -variable _bp_en($i) -bg $bg1 \
+ checkbutton $twin.en$i -relief flat -variable _bp_en($i) \
-activebackground $bg1 -command "$this bp_able $i" -fg $color
} else {
- checkbutton $twin.en$i -relief flat -variable _bp_en($i) -selectcolor $color \
- -command "$this bp_able $i" -bg $bg1 -activebackground $bg1
+ checkbutton $twin.en$i -relief flat -variable _bp_en($i) \
+ -command "$this bp_able $i" -activebackground $bg1 \
+ -selectcolor $color -highlightbackground $bg1
}
if {$tracepoints} {
- label $twin.num$i -text "$number " -relief flat -anchor w -font global/fixed -bg $bg1
+ label $twin.num$i -text "$number " -relief flat -anchor w -font global/fixed
}
label $twin.addr$i -text "[$bp_event get address] " -relief flat -anchor w -font global/fixed -bg $bg1
if {[info exists _files(short,$file)]} {
}
if {$show_threads} {
if {$thread == "-1"} {set thread "ALL"}
- label $twin.thread$i -text "$thread " -relief flat -anchor w -font global/fixed -bg $bg1
+ label $twin.thread$i -text "$thread " -relief flat -anchor w -font global/fixed
}
- label $twin.file$i -text "$file " -relief flat -anchor w -font global/fixed -bg $bg1
- label $twin.line$i -text "[$bp_event get line] " -relief flat -anchor w -font global/fixed -bg $bg1
- label $twin.func$i -text "[$bp_event get function] " -relief flat -anchor w -font global/fixed -bg $bg1
+ label $twin.file$i -text "$file " -relief flat -anchor w -font global/fixed
+ label $twin.line$i -text "[$bp_event get line] " -relief flat -anchor w -font global/fixed
+ label $twin.func$i -text "[$bp_event get function] " -relief flat -anchor w -font global/fixed
if {$tracepoints} {
- label $twin.pass$i -text "[$bp_event get pass_count] " -relief flat -anchor w -font global/fixed -bg $bg1
+ label $twin.pass$i -text "[$bp_event get pass_count] " -relief flat -anchor w -font global/fixed
}
if {$mbar} {
set i $selected
foreach thing $zz {
- $twin.${thing}${i} configure -fg [pref get gdb/font/select_fg] -bg $bg1
+ $twin.${thing}${i} configure -fg $::Colors(fg) -bg $bg1
}
}
}
foreach thing $zz {
- $twin.${thing}${r} configure -fg [pref get gdb/font/select_fg] \
- -bg [pref get gdb/font/select_bg]
+ $twin.${thing}${r} configure -fg $::Colors(sfg) -bg $::Colors(sbg)
}
if {$tracepoints == 0} {
itk_component add filt_entry {
entry [$itk_component(filter) childsite].ent -font global/fixed \
- -textvariable [pref varname gdb/search/last_symbol] -background white
- } {
- usual Entry
- rename -background -textbackground textBackground Background
- }
+ -textvariable [pref varname gdb/search/last_symbol]
+ } {}
+
# Watch keystrokes into the entry box and filter on them...
iwidgets::scrolledlistbox $itk_component(browser).files \
-selectmode extended -exportselection false \
-labeltext "Files" -labelpos nw -labelrelief groove \
- -labelborderwidth 2 -ipadx 8 -ipady 6 \
- -childsitepos s -hscrollmode none -textbackground white
- }
+ -labelborderwidth 2 -ipadx 8 -ipady 6 -foreground $::Colors(textfg) \
+ -childsitepos s -hscrollmode none -textbackground $::Colors(textbg)
+ } {}
append labelUpdateCode [$itk_component(file_box) clientHandlesConfigure 1] \
"\n"
-selectmode extended \
-exportselection false \
-labeltext "Functions" -labelpos nw -labelrelief groove \
- -labelborderwidth 2 -ipadx 8 -ipady 6 \
- -childsitepos s -hscrollmode none -textbackground white
- }
+ -labelborderwidth 2 -ipadx 8 -ipady 6 -foreground $::Colors(textfg) \
+ -childsitepos s -hscrollmode none -textbackground $::Colors(textbg)
+ } {}
append labelUpdateCode [$itk_component(func_box) clientHandlesConfigure 1] \
"\n"
itk_component add view_search {
entry $itk_component(view_bottom).search -borderwidth 2 \
- -font global/fixed -width 10 -background white
- } {
- rename -background -textbackground textBackground Background
- }
+ -font global/fixed -width 10 -background $::Colors(textbg)
+ } {}
# Pack all the components of view_hidden into the frame:
$_twin tag configure err_tag -foreground [pref get gdb/console/error_fg]
$_twin tag configure log_tag -foreground [pref get gdb/console/log_fg]
$_twin tag configure target_tag -foreground [pref get gdb/console/target_fg]
- $_twin configure -font [pref get gdb/console/font]
-
+ $_twin configure -font [pref get gdb/console/font] \
+ -bg $::Colors(textbg) -fg $::Colors(textfg)
+
#
# bind editing keys for console window
#
iwidgets::spinint $f.${name}s -labeltext "Size:" -range {6 18} -step 1 \
-fixed 2 -width 2 -textvariable [scope _size($name)] -wrap 0 \
-increment [code $this _change_size up $name] \
- -decrement [code $this _change_size down $name]
+ -decrement [code $this _change_size down $name] \
+ -textbackground $::Colors(textbg)
} {}
label $f.${name}l -text ABCDEFabcdef0123456789 -font test-$name-font
set _size($name) $_original($name,size)
# GDBtk (Insight) entry point
-# Copyright 1997, 1998, 1999 Cygnus Solutions
+# Copyright 1997, 1998, 1999, 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
}
}
-if {$tcl_platform(platform) == "unix"} {
-# tix resetoptions TK TK
-# tk_setPalette tan
- tix resetoptions TixGray [tix cget -fontset]
-}
-
# For testing
set _test(interactive) 0
gdbtk_busy
set _mem($this,enabled) 1
- set bg white
if {![info exists type(1)]} {
set type(1) char
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 <Up> "$this memMoveCell %W -1 0; break"
- bind $itk_interior.t <Down> "$this memMoveCell %W 1 0; break"
- bind $itk_interior.t <Left> "$this memMoveCell %W 0 -1; break"
- bind $itk_interior.t <Right> "$this memMoveCell %W 0 1; break"
- bind $itk_interior.t <Return> "$this memMoveCell %W 0 1; break"
- bind $itk_interior.t <KP_Enter> "$this memMoveCell %W 0 1; break"
+ 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_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 <ButtonRelease-2> [format {after idle %s paste %s %s} $this %x %y]
- bind $itk_
interior.t <<Paste>> [format {after idle %s paste %s %s} $this %x %y]
+ 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_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
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
"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]]
} 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
# 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]
}
# ------------------------------------------------------------------
# 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\
# ------------------------------------------------------------------
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]
}
# ------------------------------------------------------------------
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
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
}
# ------------------------------------------------------------------
# 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
}
}
}
# set table background
- $itk_interior.t config -bg white -state normal
+ $itk_component(table) config -bg $::Colors(textbg) -state normal
catch {update_addr}
}
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
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
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]
}
}
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
# ------------------------------------------------------------------
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
}
# ------------------------------------------------------------------
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
}
tk_messageBox -icon error -title Error -type $type \
-modal $modality -message $msg -parent $parent
}
+
# now set global options
set gdb_ImageDir [file join $GDBTK_LIBRARY [pref get gdb/ImageDir]]
+
+ # finally set colors, from system if possible
+ pref_set_colors
}
}
pref define gdb/B1_behavior 1; # 0 means set/clear breakpoints,
# 1 means set/clear tracepoints.
pref define gdb/use_icons 1; # For Unix, use gdbtk_icon.gif as an icon
- # some window managers can't deal with it.
-
- #
- # Font attributes
- #
-
- # "Normal" font attributes
- pref define gdb/font/normal_fg black
- pref define gdb/font/normal_bg gray92
-
- # Selection foreground/background
- pref define gdb/font/select_fg black
- pref define gdb/font/select_bg lightgray
-
- # Highlight used when something changes (variable value changes, etc)
- pref define gdb/font/highlight_fg blue
- pref define gdb/font/highlight_bg gray92
-
- # "Header" foreground and background. Used by table headers and such.
- pref define gdb/font/header_fg gray92
- pref define gdb/font/header_bg darkgray
-
+ # some window managers can't deal with it.
# set download and execution options
pref define gdb/load/verbose 0
pref define gdb/load/main 1
pref define gdb/editor ""
}
+proc pref_set_colors {} {
+ # set color palette
+
+ # In a normal tk app, most of this is not necessary. Unfortunately
+ # Insight is a mixture of widgets from all over and was coded first
+ # in tcl and later in itcl. So lots of color inheritance is broken or wrong.
+ # To enable us to fix that without hardcoding colors, we create a color
+ # array here and use it as needed to force widgets to the correct colors.
+
+ global Colors tcl_platform
+
+ debug
+
+ if {$tcl_platform(platform) == "windows"} {
+ option add *foreground SystemButtonText
+ set Colors(fg) SystemButtonText
+
+ option add *background SystemButtonFace
+ set Colors(bg) SystemButtonFace
+
+ option add *Entry*foreground SystemWindowText
+ option add *Text*foreground SystemWindowText
+ set Colors(textfg) SystemWindowText
+
+ option add *Entry*background SystemWindow
+ option add *Text*background SystemWindow
+ set Colors(textbg) SystemWindow
+
+ option add *selectForeground SystemHighlightText
+ set Colors(sfg) SystemHighlightText
+
+ option add *selectBackground SystemHighlight
+ set Colors(sbg) SystemHighlight
+
+ option add *highlightBackground SystemButtonFace
+ set Colors(hbg) SystemButtonFace
+ return
+ }
+
+ # UNIX colors
+
+ # For KDE3 (and probably earlier versions) when the user sets
+ # a color scheme from the KDE control center, the appropriate color
+ # information is set in the X resource database. Well, most of it
+ # is there but it is missing some settings, so we will carefully
+ # adjust things.
+ #
+ # For GNOME, you can use a program called grdb update the X resource database
+ # with your current color scheme.
+ #
+ # If there is no information in the X rdb, we provide reasonable defaults.
+
+ # create an empty entry widget so we can query its colors
+ entry .e
+
+ # text background
+ set Colors(textbg) [option get .e background {}]
+ if {$Colors(textbg) == ""} {set Colors(textbg) white}
+
+ # text foreground
+ set Colors(textfg) [option get .e foreground {}]
+ if {$Colors(textfg) == ""} {set Colors(textfg) black}
+
+ # background
+ set Colors(bg) [option get . background {}]
+ if {$Colors(bg) == ""} {set Colors(bg) lightgray}
+
+ # foreground
+ set Colors(fg) [option get . foreground {}]
+ if {$Colors(fg) == ""} {set Colors(fg) black}
+
+ # now reset resource database so all widgets are consistent
+ option add *background $Colors(bg)
+ option add *Text*background $Colors(textbg)
+ option add *Entry*background $Colors(textbg)
+ option add *foreground $Colors(fg)
+ option add *Text*foreground $Colors(textfg)
+ option add *Entry*foreground $Colors(textfg)
+
+
+ # highlightBackground. Set to background for now.
+ set Colors(hbg) $Colors(bg)
+ option add *highlightBackground $Colors(hbg)
+
+ # selectBackground
+ set Colors(sbg) [option get .e selectBackground {}]
+ if {$Colors(sbg) == ""} {set Colors(sbg) blue}
+ option add *selectBackground $Colors(sbg)
+
+ # selectForeground
+ set Colors(sfg) [option get .e selectForeground {}]
+ if {$Colors(sfg) == ""} {set Colors(sfg) white}
+ option add *selectForeground $Colors(sfg)
+
+ # compute a slightly darker background color
+ # and use for activeBackground and troughColor
+ set bg2 [winfo rgb . $Colors(bg)]
+ set dbg [format #%02x%02x%02x [expr {(9*[lindex $bg2 0])/2560}] \
+ [expr {(9*[lindex $bg2 1])/2560}] [expr {(9*[lindex $bg2 2])/2560}]]
+ option add *activeBackground $dbg
+ option add *troughColor $dbg
+
+ # Change the default select color for checkbuttons, etc to match
+ # selectBackground.
+ option add *selectColor $Colors(sbg)
+
+ destroy .e
+}
itk_component add slbox {
iwidgets::scrolledlistbox $itk_interior.slbox \
- -background [pref get gdb/font/normal_bg] \
- -selectbackground green \
- -selectforeground black \
+ -background $::Colors(bg) \
+ -selectbackground $::Colors(sbg) -selectforeground $::Colors(sfg) \
-textfont global/fixed \
-exportselection false \
-selectioncommand [code $this change_context]
} {}
[$itk_component(slbox) component listbox] configure \
- -bg [pref get gdb/font/normal_bg]
+ -bg $::Colors(textbg) -fg $::Colors(textfg)
update dummy
pack $itk_component(slbox) -side left -expand yes -fill both
# 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 global/fixed \
-colstretch unset -rowstretch unset -selectmode single \
-resizeborders none -multiline false -colwidth 18 \
- -autoclear 0 -bg [pref get gdb/font/normal_bg] \
+ -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> \
# 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]
+ -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(hbg)
$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] \
+ $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
+ -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]
- }
+ #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 {
# 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
- }
- }
+ debug "$pref $value"
+ # do nothing for now. With proper iwidgets this would not
+ # be required anyway.
}
itk_component add size {
iwidgets::spinint $f.x.size -labeltext "Tab Size" -range {1 16} \
-step 1 -fixed 2 -width 2 -textvariable [scope _new(gdb/src/tab_size)] \
- -wrap 0
+ -wrap 0 -textbackground $::Colors(textbg)
}
$f.x.size delete 0 end
$f.x.size insert end $_saved(gdb/src/tab_size)
# METHOD: build_win - build the main source paned window
# ------------------------------------------------------------------
body SrcTextWin::build_win {} {
- cyg::panedwindow $itk_interior.p -background white
+ cyg::panedwindow $itk_interior.p
set _tpane pane$filenum
incr filenum
set Stwc(gdbtk_scratch_widget:pane) $_tpane
set Stwc(gdbtk_scratch_widget:dirty) 0
- set twinp [iwidgets::scrolledtext $pane1.st -textbackground white \
+ set twinp [iwidgets::scrolledtext $pane1.st \
-hscrollmode dynamic -vscrollmode dynamic]
set twin [$twinp component text]
pack $twinp -fill both -expand yes
body SrcTextWin::config_win {win {asm S}} {
# debug "$win $asm Tracing=$Tracing Browsing=$Browsing"
- $win config -borderwidth 2 -insertwidth 0 -wrap none -bg white
+ $win config -borderwidth 2 -insertwidth 0 -wrap none
# font
set font [pref get gdb/src/font]
- $win configure -font $font
+ $win configure -font $font -bg $::Colors(textbg) -fg $::Colors(textfg)
setTabs $win $asm
# set up some tags. should probably be done differently
# !! change bg?
- $win tag configure break_rgn_tag -foreground [pref get gdb/src/break_fg]
+ $win tag configure break_rgn_tag
foreach type $bp_types {
- $win tag configure ${type}_tag -foreground [pref get gdb/src/break_fg]
+ $win tag configure ${type}_tag
}
- $win tag configure tp_tag -foreground [pref get gdb/src/break_fg]
+ $win tag configure tp_tag
$win tag configure source_tag2 -foreground [pref get gdb/src/source2_fg]
$win tag configure PC_TAG -background [pref get gdb/src/PC_TAG]
$win tag configure STACK_TAG -background [pref get gdb/src/STACK_TAG]
itk_component add slb {
iwidgets::scrolledlistbox $itk_interior.s \
-vscrollmode dynamic -hscrollmode dynamic \
- -selectmode single -selectforeground black \
- -selectbackground [pref get gdb/src/STACK_TAG] -exportselection false \
- -textbackground [pref get gdb/font/normal_bg] \
- -foreground [pref get gdb/font/normal_fg] \
- -visibleitems 30x15 \
+ -selectmode single -exportselection false -visibleitems 30x15 \
-textfont global/fixed -selectioncommand [code $this change_frame]
- } {}
+ }
+
+ [$itk_component(slb) component listbox] configure \
+ -bg $::Colors(textbg) -fg $::Colors(textfg)
# Add sizebox for windows
if {[string compare $tcl_platform(platform) "windows"] == 0} {
itk_component add stext {
iwidgets::scrolledtext $itk_interior.stext -hscrollmode $mode \
-vscrollmode $mode -textfont global/fixed \
- -background [pref get gdb/font/normal_bg]
+ -background $::Colors(bg)
} {}
[$itk_component(stext) component text] configure \
- -background [pref get gdb/font/normal_bg]
+ -background $::Colors(bg)
pack $itk_component(stext) -side left -expand yes -fill both
update dummy
}
-vscrollmode dynamic -selectmode multiple -exportselection 0 \
-dblclickcommand [code $this edit] \
-selectioncommand [code $this set_delete_action_state $ActionLB $new_frame.del_but] \
- -background [pref get gdb/font/normal_bg]
- [$ActionLB component listbox] configure -background [pref get gdb/font/normal_bg]
+ -background $::Colors(bg)
+ [$ActionLB component listbox] configure -background $::Colors(bg)
label $act_frame.lbl -text {Actions}
pack $act_frame.lbl -side top
pack $act_frame.lb -side bottom -fill both -expand 1 -padx 5 -pady 5
# METHOD: build_win - build the watch window
# ------------------------------------------------------------------
method build_win {f} {
- global tixOption tcl_platform Display
+ global tcl_platform Display
# debug
set width [font measure global/fixed "W"]
# Choose the default width to be...
}
set Hlist [$Tree subwidget hlist]
- # FIXME: probably should use columns instead.
- $Hlist configure -header 1
+ # FIXME: probably should use columns instead.
+ $Hlist configure -header 1
set l [expr {$EntryLength - $Length - [string length "Name"]}]
# Ok, this is as hack as it gets
set blank " "
- $Hlist header create 0 -itemtype text \
+ $Hlist header create 0 -itemtype text -headerbackground $::Colors(bg) \
-text "Name[string range $blank 0 $l]Value"
# Configure the look of the tree
- set sbg [$Hlist cget -bg]
- set fg [$Hlist cget -fg]
- set bg $tixOption(input1_bg)
set width [font measure global/fixed $LengthString]
- $Hlist configure -indent $width -bg $bg \
- -selectforeground $fg -selectbackground $sbg \
- -selectborderwidth 0 -separator . -font global/fixed
+ $Hlist configure -indent $width \
+ -bg $::Colors(textbg) -fg $::Colors(textfg) \
+ -selectforeground $::Colors(textfg) -selectbackground $::Colors(textbg) \
+ -selectborderwidth 0 -separator . -font global/fixed
# Get display styles
set normal_fg [$Hlist cget -fg]
- set highlight_fg [pref get gdb/font/highlight_fg]
- set disabled_fg [pref get gdb/variable/disabled_fg]
+ set highlight_fg $::Colors(sfg)
+ set disabled_fg red
set NormalTextStyle [tixDisplayStyle text -refwindow $Hlist \
- -bg $bg -fg $normal_fg -font global/fixed]
- set HighlightTextStyle [tixDisplayStyle text -refwindow $Hlist \
- -bg $bg -fg $highlight_fg -font global/fixed]
+ -bg $::Colors(textbg) -font global/fixed]
+ set HighlightTextStyle [tixDisplayStyle text -refwindow $Hlist \
+ -bg $::Colors(hbg) -font global/fixed]
set DisabledTextStyle [tixDisplayStyle text -refwindow $Hlist \
- -bg $bg -fg $disabled_fg -font global/fixed]
+ -bg green -fg red -font global/fixed]
if {[catch {gdb_cmd "show output-radix"} msg]} {
set Radix 10
# Do not use the tixPopup widget...
set Popup [menu $f.menu -tearoff 0]
- set disabled_foreground [$Popup cget -foreground]
+ set disabled_foreground red
$Popup configure -disabledforeground $disabled_foreground
set ViewMenu [menu $Popup.view]
# METHOD edit -- edit a variable
# ------------------------------------------------------------------
method edit {variable} {
- global Update tixOption
+ global Update
# disable menus
selectionChanged ""
# Must create the frame
set Editing [frame $Hlist.frame -bg $bg -bd 0 -relief flat]
set lbl [::label $Editing.lbl -fg $fg -bg $bg -font global/fixed]
- set ent [entry $Editing.ent -bg $tixOption(bg) -font global/fixed]
+ set ent [entry $Editing.ent -bg $::Colors(bg) -fg $::Colors(fg) -font global/fixed]
pack $lbl $ent -side left
}
method toggleUpdate {variable} {
global Update
-
+ debug $variable
if {$Update($this,$variable)} {
+ debug NORMAL
# Must update value
$Hlist entryconfigure $variable \
-style $NormalTextStyle \
-text [label $variable]
} else {
+ debug DISABLED
$Hlist entryconfigure $variable \
-style $DisabledTextStyle
}
global Update
debug
- # First, reset color on label to black
+ # First, reset color on label to normal
foreach w $ChangeList {
catch {
$Hlist entryconfigure $w -style $NormalTextStyle
}
foreach var $ChangeList {
+ debug "$var HIGHLIGHT"
$Hlist entryconfigure $var \
-style $HighlightTextStyle \
-text [label $var]
OSDN Git Service
