* [patch] color fixes
@ 2002-06-07 2:33 Martin M. Hunt
0 siblings, 0 replies; only message in thread
From: Martin M. Hunt @ 2002-06-07 2:33 UTC (permalink / raw)
To: insight
[-- Attachment #1: Type: text/plain, Size: 1354 bytes --]
Insight was originally coded in tcl, then two different versions of itcl. It
uses widgets from a bunch of sources. Because of this, it has become
inconsistent about handling colors. Sometimes you can see things highlighted
in several different ways in different widgets. It ignores your system
colors on Unix, and partly ignores them on Windows. This patch is an attempt
to fix that mess. I probably made a few things worse, and if so, please let
me know and I will fix them ASAP.
This should also fix Insight PRs 142 and 143.
--
Martin Hunt
GDB Engineer
Red Hat, Inc.
2002-06-07 Martin M. Hunt <hunt@redhat.com>
* 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.
[-- Attachment #2: p --]
[-- Type: text/x-diff, Size: 40518 bytes --]
Index: bpwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/bpwin.itb,v
retrieving revision 1.13
diff -u -u -r1.13 bpwin.itb
--- bpwin.itb 14 Mar 2002 17:12:10 -0000 1.13
+++ bpwin.itb 7 Jun 2002 09:21:11 -0000
@@ -45,7 +45,7 @@
# ------------------------------------------------------------------
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
@@ -61,9 +61,9 @@
# 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]
@@ -236,15 +236,16 @@
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)]} {
@@ -255,13 +256,13 @@
}
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} {
@@ -374,7 +375,7 @@
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
}
}
@@ -396,8 +397,7 @@
}
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} {
Index: browserwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/browserwin.itb,v
retrieving revision 1.4
diff -u -u -r1.4 browserwin.itb
--- browserwin.itb 5 Mar 2002 22:22:19 -0000 1.4
+++ browserwin.itb 7 Jun 2002 09:21:11 -0000
@@ -113,11 +113,9 @@
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...
@@ -134,9 +132,9 @@
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"
@@ -181,9 +179,9 @@
-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"
@@ -301,10 +299,8 @@
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:
Index: console.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/console.itb,v
retrieving revision 1.20
diff -u -u -r1.20 console.itb
--- console.itb 5 Mar 2002 22:22:19 -0000 1.20
+++ console.itb 7 Jun 2002 09:21:11 -0000
@@ -54,8 +54,9 @@
$_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
#
Index: globalpref.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/globalpref.itb,v
retrieving revision 1.7
diff -u -u -r1.7 globalpref.itb
--- globalpref.itb 5 Mar 2002 22:22:19 -0000 1.7
+++ globalpref.itb 7 Jun 2002 09:21:11 -0000
@@ -284,7 +284,8 @@
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)
Index: main.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/main.tcl,v
retrieving revision 1.8
diff -u -u -r1.8 main.tcl
--- main.tcl 18 Feb 2002 17:19:44 -0000 1.8
+++ main.tcl 7 Jun 2002 09:21:11 -0000
@@ -1,5 +1,5 @@
# 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
@@ -107,12 +107,6 @@
} else {
::debug::logfile "insight.log"
}
-}
-
-if {$tcl_platform(platform) == "unix"} {
-# tix resetoptions TK TK
-# tk_setPalette tan
- tix resetoptions TixGray [tix cget -fontset]
}
# For testing
Index: memwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/memwin.itb,v
retrieving revision 1.17
diff -u -u -r1.17 memwin.itb
--- memwin.itb 6 Mar 2002 23:56:03 -0000 1.17
+++ memwin.itb 7 Jun 2002 09:21:11 -0000
@@ -23,7 +23,6 @@
gdbtk_busy
set _mem($this,enabled) 1
- set bg white
if {![info exists type(1)]} {
set type(1) char
@@ -102,45 +101,52 @@
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
@@ -150,9 +156,8 @@
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 @@
"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 @@
} 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 @@
# 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 @@
# 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::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 @@
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 @@
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 @@
# 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 @@
}
# 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 @@
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 @@
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 @@
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 @@
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::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::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 @@
tk_messageBox -icon error -title Error -type $type \
-modal $modality -message $msg -parent $parent
}
+
Index: prefs.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/prefs.tcl,v
retrieving revision 1.16
diff -u -u -r1.16 prefs.tcl
--- prefs.tcl 1 Jun 2002 06:37:10 -0000 1.16
+++ prefs.tcl 7 Jun 2002 09:21:12 -0000
@@ -138,6 +138,9 @@
# 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
}
}
@@ -282,28 +285,7 @@
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
@@ -416,3 +398,111 @@
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
+}
Index: process.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/process.itb,v
retrieving revision 1.8
diff -u -u -r1.8 process.itb
--- process.itb 5 Mar 2002 22:22:19 -0000 1.8
+++ process.itb 7 Jun 2002 09:21:12 -0000
@@ -48,15 +48,14 @@
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
Index: regwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/regwin.itb,v
retrieving revision 1.16
diff -u -u -r1.16 regwin.itb
--- regwin.itb 16 May 2002 01:09:37 -0000 1.16
+++ regwin.itb 7 Jun 2002 09:21:12 -0000
@@ -160,21 +160,25 @@
# 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> \
@@ -217,33 +221,26 @@
# 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 {
@@ -485,32 +482,9 @@
# 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.
}
Index: srcpref.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/srcpref.itb,v
retrieving revision 1.5
diff -u -u -r1.5 srcpref.itb
--- srcpref.itb 5 Mar 2002 22:22:20 -0000 1.5
+++ srcpref.itb 7 Jun 2002 09:21:12 -0000
@@ -137,7 +137,7 @@
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)
Index: srctextwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/srctextwin.itb,v
retrieving revision 1.34
diff -u -u -r1.34 srctextwin.itb
--- srctextwin.itb 7 Mar 2002 21:53:39 -0000 1.34
+++ srctextwin.itb 7 Jun 2002 09:21:13 -0000
@@ -304,7 +304,7 @@
# 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
@@ -314,7 +314,7 @@
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
@@ -493,22 +493,22 @@
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]
Index: stackwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/stackwin.itb,v
retrieving revision 1.7
diff -u -u -r1.7 stackwin.itb
--- stackwin.itb 5 Mar 2002 22:22:20 -0000 1.7
+++ stackwin.itb 7 Jun 2002 09:21:13 -0000
@@ -39,13 +39,12 @@
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} {
Index: tdump.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/tdump.tcl,v
retrieving revision 1.5
diff -u -u -r1.5 tdump.tcl
--- tdump.tcl 5 Mar 2002 22:22:20 -0000 1.5
+++ tdump.tcl 7 Jun 2002 09:21:15 -0000
@@ -58,10 +58,10 @@
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
}
Index: tracedlg.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/tracedlg.tcl,v
retrieving revision 1.5
diff -u -u -r1.5 tracedlg.tcl
--- tracedlg.tcl 5 Mar 2002 22:22:20 -0000 1.5
+++ tracedlg.tcl 7 Jun 2002 09:21:15 -0000
@@ -306,8 +306,8 @@
-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
Index: variables.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/variables.tcl,v
retrieving revision 1.15
diff -u -u -r1.15 variables.tcl
--- variables.tcl 5 Mar 2002 22:22:20 -0000 1.15
+++ variables.tcl 7 Jun 2002 09:21:15 -0000
@@ -46,7 +46,7 @@
# 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...
@@ -71,34 +71,32 @@
}
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
@@ -117,7 +115,7 @@
# 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]
@@ -391,7 +389,7 @@
# METHOD edit -- edit a variable
# ------------------------------------------------------------------
method edit {variable} {
- global Update tixOption
+ global Update
# disable menus
selectionChanged ""
@@ -404,7 +402,7 @@
# 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
}
@@ -587,13 +585,15 @@
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
}
@@ -818,7 +818,7 @@
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
@@ -855,6 +855,7 @@
}
foreach var $ChangeList {
+ debug "$var HIGHLIGHT"
$Hlist entryconfigure $var \
-style $HighlightTextStyle \
-text [label $var]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2002-06-07 9:33 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2002-06-07 2:33 [patch] color fixes Martin M. Hunt
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).