# METHOD: init_var - initialize preference variables
# ------------------------------------------------------------------
itcl::body GlobalPref::_init_var {} {
- set vlist {gdb/ImageDir gdb/console/wrap gdb/mode
- gdb/help/browser gdb/use_icons}
+ set vlist {gdb/ImageDir gdb/console/wrap gdb/mode gdb/use_icons gdb/compat}
foreach var $vlist {
set _saved($var) [pref get $var]
_make_font_item $f default "Default Font:" $fam
_make_font_item $f status "Status Bar Font:" $fam
+
+ iwidgets::Labeledframe $frame.misc -labelpos nw -labeltext "Misc"
+ set f [$frame.misc childsite]
+
# This is the tracing preference
set tracing_cb [pref get gdb/mode]
if { ![info exists tracing_labels($tracing_cb)]} {
set tracing_labels($tracing_cb) "Unknown gdb mode..."
}
- frame $frame.tracing
- checkbutton $frame.tracing.cb -variable [scope _new(gdb/mode)] \
+ checkbutton $f.tracing -variable [scope _new(gdb/mode)] \
-text $tracing_labels($tracing_cb) \
- -command [code $this _toggle_tracing $frame.tracing.cb] \
+ -command [code $this _toggle_tracing $f.tracing] \
-width $tracing_labels(max_len) -anchor w
- pack $frame.tracing.cb -pady 10 -side left -fill none
-
- # help browser preferences
- if {$tcl_platform(platform) == "windows"} {
- set help_text "Use Internet Browser to View Help Files"
- } else {
- set help_text "Use Netscape to View Help Files"
- }
- frame $frame.browser
- checkbutton $frame.browser.cb \
- -text $help_text -variable [scope _new(gdb/help/browser)]
- pack $frame.browser.cb -pady 10 -side left -fill none
# use_icons
if {$tcl_platform(platform) == "unix"} {
- frame $frame.use_icons
- checkbutton $frame.use_icons.cb \
+ checkbutton $f.use_icons \
-text "Use builtin image as icon." -variable [scope _new(gdb/use_icons)]
- pack $frame.use_icons.cb -pady 10 -side left -fill none
}
# console wrap
- frame $frame.consolewrap
- checkbutton $frame.consolewrap.cw -text "wrap text in console window" \
+ checkbutton $f.consolewrap -text "wrap text in console window" \
-variable [scope _new(gdb/console/wrap)]
- pack $frame.consolewrap.cw -pady 10 -side left -fill none
+ grid $f.tracing -sticky w -padx 5 -pady 5
+
+ if {$tcl_platform(platform) == "unix"} {
+ grid $f.use_icons -sticky w -padx 5 -pady 5
+ }
+ grid $f.consolewrap -sticky w -padx 5 -pady 5
+
+ if {$tcl_platform(platform) == "unix"} {
+ # Compatibility frame
+ iwidgets::Labeledframe $frame.compat -labelpos nw -labeltext "OS Compatibility"
+ set fc [$frame.compat childsite]
+ radiobutton $fc.0 -text "GNOME" -value "GNOME" -variable [scope _new(gdb/compat)]
+ radiobutton $fc.1 -text "KDE" -value "KDE" -variable [scope _new(gdb/compat)]
+ radiobutton $fc.2 -text "default" -value "default" -variable [scope _new(gdb/compat)]
+ grid $fc.0 -sticky w -padx 5 -pady 5
+ grid $fc.1 -sticky w -padx 5 -pady 5
+ grid $fc.2 -sticky w -padx 5 -pady 5
+ grid [label $fc.warn -text "Restart required for all\nchanges to take effect"] -sticky w
+ }
+
+ # pack it all
pack $frame.icons.lab $frame.icons.cb -side left
- pack $frame.icons -side top -padx 10 -pady 10
- pack $frame.tracing -side top -fill x -expand 0 -side bottom
- pack $frame.browser -side top -fill x -expand 0 -side bottom
+ grid $frame.icons x -sticky w -pady 10
+ grid $frame.d -columnspan 2 -sticky w
if {$tcl_platform(platform) == "unix"} {
- pack $frame.use_icons -side top -fill x -expand 0 -side bottom
+ grid $frame.compat $frame.misc -sticky we
+ } else {
+ grid $frame.misc x -sticky we
}
- pack $frame.consolewrap -side top -fill x -expand 0 -side bottom
- pack $frame.d -side top -fill both -expand yes
# make buttons
button $itk_interior.x.ok -text OK -underline 0 -width 7 -command [code $this _ok]
button $itk_interior.x.cancel -text Cancel -width 7 -underline 0 -command [code $this _cancel]
pack $itk_interior.x.ok $itk_interior.x.apply $itk_interior.x.cancel -side left
standard_button_box $itk_interior.x
- pack $itk_interior.x -fill x -padx 5 -pady 5 -side bottom
-
- pack $itk_interior.f -fill both -expand yes -padx 10 -pady 5
+ pack $itk_interior.x -fill x -padx 5 -pady 5 -side bottom
+ pack $itk_interior.f -fill both -expand yes -padx 5 -pady 5
bind $itk_interior.x.ok <Return> \
"$itk_interior.x.ok flash; $itk_interior.x.ok invoke"
} elseif {$home != ""} {
set prefs_init_filename [file join $home $prefs_init_filename]
}
-
+
# 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_set_colors $home
}
# ------------------------------------------------------------------
debug "ERROR: $fd"
return
}
-
+
puts $fd "\# GDBtk Init file"
- puts $fd {# GDBtkInitVersion: 1}
+ puts $fd "{# GDBtkInitVersion: 1}"
set plist [pref list]
# write out global options
# ------------------------------------------------------------------
proc pref_set_defaults {} {
global GDBTK_LIBRARY tcl_platform gdb_ImageDir
+ debug
# Gdb global defaults
pref define gdb/ImageDir images2
pref define gdb/mode 0; # 0 no tracing, 1 tracing enabled
pref define gdb/control_target 1; # 0 can't control target (EMC), 1 can
pref define gdb/B1_behavior 1; # 0 means set/clear breakpoints,
- # 1 means set/clear tracepoints.
+ # 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.
+ # some window managers can't deal with it.
+
+ # OS compatibility. Valid values are "Windows", "GNOME", "KDE", and "default"
+ if {$tcl_platform(platform) == "windows"} {
+ pref define gdb/compat "Windows"
+ } elseif {$tcl_platform(platform) == "unix"} {
+ pref define gdb/compat "GNOME"
+ } else {
+ pref define gdb/compat "default"
+ }
+
# set download and execution options
pref define gdb/load/verbose 0
pref define gdb/load/main 1
# Stack Window
pref define gdb/stack/font global/fixed
-
+
# Register Window
pref define gdb/reg/rows 16
pref define gdb/mem/ascii_char .
pref define gdb/mem/bytes_per_row 16
pref define gdb/mem/color green
-
+
# External editor.
pref define gdb/editor ""
}
-proc pref_set_colors {} {
+proc pref_set_colors {home} {
# 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.
+ # In the past, tk widgets got their color information from Windows or
+ # the X resource database. 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. And Insight has some special color
+ # requirements. We also have to deal with new Unix desktops that don't use the Xrdb.
# 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
# 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
+ # For GNOME, we read .gtkrc or .gtkrc-1.2-gnome2 and parse it
+ # for the color information. We cannot really get this right,
+ # but with luck we can read enough to get the colors to mostly match.
+
+ # If there is no information, we provide reasonable defaults.
- # text background
- set Colors(textbg) [option get .e background {}]
- if {$Colors(textbg) == ""} {set Colors(textbg) white}
+ # If some theme sets the text foreground and background to something unusual
+ # then Insight won't be able to display sources and highlight things properly.
+ # Therefore we will not change the textfg and textbg.
+
+ switch [pref get gdb/compat] {
+
+ "Windows" {
+ debug "loading OS colors for Windows"
+ set Colors(fg) SystemButtonText
+ set Colors(bg) SystemButtonFace
+ #set Colors(textfg) SystemWindowText
+ #set Colors(textbg) SystemWindow
+ set Colors(textfg) black
+ set Colors(textbg) white
+ set Colors(sfg) SystemHighlightText
+ set Colors(sbg) SystemHighlight
+ pref_set_option_db 0
+ }
+
+ "KDE" {
+ debug "loading OS colors for KDE"
+
+ pref_load_default
+ # try loading "~/.gtkrc-kde"
+ if {[pref_load_gnome $home [list .gtkrc-kde]]} {
+ debug "loaded gnome file"
+ pref_set_option_db 0
+ debug "loaded option file"
+ } else {
+ # no .gtkrc-kde so assume X defaults have been set
+
+ # create an empty entry widget so we can query its colors
+ entry .e
+
+ # text background
+ # set Colors(textbg) [option get .e background {}]
+ set Colors(textbg) white
+
+ # text foreground
+ #set Colors(textfg) [option get .e foreground {}]
+ 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}
+
+ # selectBackground
+ set Colors(sbg) [option get .e selectBackground {}]
+ if {$Colors(sbg) == ""} {set Colors(sbg) blue}
+
+ # selectForeground
+ set Colors(sfg) [option get .e selectForeground {}]
+ if {$Colors(sfg) == ""} {set Colors(sfg) white}
+
+ destroy .e
+ pref_set_option_db 1
+ }
+ }
+
+ "GNOME" {
+ pref_load_default
+ pref_load_gnome $home
+ pref_set_option_db 0
+ }
+
+ "default" {
+ pref_load_default
+ pref_set_option_db 1
+ }
+ }
+}
+
+proc pref_load_default {} {
+ global Colors
+ debug "loading default colors"
- # text foreground
- set Colors(textfg) [option get .e foreground {}]
- if {$Colors(textfg) == ""} {set Colors(textfg) black}
+ set Colors(textbg) white
+ set Colors(textfg) black
+ set Colors(bg) lightgray
+ set Colors(fg) black
- # background
- set Colors(bg) [option get . background {}]
- if {$Colors(bg) == ""} {set Colors(bg) lightgray}
+ # selectBackground
+ set Colors(sbg) blue
- # foreground
- set Colors(fg) [option get . foreground {}]
- if {$Colors(fg) == ""} {set Colors(fg) black}
+ # selectForeground
+ set Colors(sfg) white
+}
+
+
+# load GNOME colors and fonts, if possible.
+proc pref_load_gnome {home {possible_names {}}} {
+ debug "loading OS colors for GNOME"
+
+ if {$possible_names == ""} {
+ set possible_names {.gtkrc .gtkrc-1.2-gnome2}
+ }
+
+ set found 0
+ foreach name $possible_names {
+ debug "home=$home name=$name"
+ set fname [file join $home $name]
+ debug "fname=$fname"
+ if {[file exists $fname]} {
+ if {[catch {open $fname r} fd]} {
+ dbug W "cannot open $fname: $fd"
+ return 0
+ }
+ set found 1
+ break
+ }
+ }
+ if {$found} {
+ set found [load_gnome_file $fd]
+ close $fd
+ }
+ return $found
+}
+
+proc load_gnome_file {fd} {
+ global Colors
+ set found 0
- # now reset resource database so all widgets are consistent
+ while {[gets $fd line] >= 0} {
+ if {[regexp {include \"([^\"]*)} $line foo incname]} {
+ debug "include $incname $found"
+ if {$found == 0 && [file exists $incname]} {
+ if {[catch {open $incname r} fd2]} {
+ dbug W "cannot open $incname: $fd2"
+ } else {
+ set found [load_gnome_file $fd2]
+ close $fd2
+ if {$found} {
+ return $found
+ }
+ }
+ }
+ continue
+ } elseif {[regexp "\[ \t\n\]*\(.+\) = \(.+\)" $line a name val] == 0} {
+ continue
+ }
+ set res [scan $val "\{ %f, %f, %f \}" r g b]
+ if {$res != 3} {continue}
+ set r [expr int($r*255)]
+ set g [expr int($g*255)]
+ set b [expr int($b*255)]
+ set val [format "\#%02x%02x%02x" $r $g $b]
+ debug "name=\"$name\" val=\"$val\""
+
+ # This is a bit of a hack and probably only
+ # works for trivial cases. Scan for colors and
+ # use the first one found.
+ switch [string trimright $name] {
+ {bg[NORMAL]} {
+ set found 1
+ if {![info exists new(bg)]} {
+ debug "setting bg to $val"
+ set new(bg) $val
+ }
+ }
+ {base[NORMAL]} {
+ #if {![info exists new(textbg)]} {
+ # set new(textbg) $val
+ #}
+ }
+ {text[NORMAL]} {
+ #if {![info exists new(textfg)]} {
+ # set new(textfg) $val
+ #}
+ }
+ {fg[NORMAL]} {
+ if {![info exists new(fg)]} {
+ set new(fg) $val
+ }
+ }
+ {fg[ACTIVE]} {
+ if {![info exists new(afg)]} {
+ set new(afg) $val
+ }
+ }
+ {bg[SELECTED]} {
+ if {![info exists new(sbg)]} {
+ set new(sbg) $val
+ }
+ }
+ {base[SELECTED]} {
+ if {![info exists new(sbg)]} {
+ set new(sbg) $val
+ }
+ }
+ {fg[SELECTED]} {
+ if {![info exists new(sfg)]} {
+ set new(sfg) $val
+ }
+ }
+ {fg[INSENSITIVE]} {
+ if {![info exists new(dfg)]} {
+ set new(dfg) $val
+ }
+ }
+ {bg[PRELIGHT]} {
+ set Colors(prelight) $val
+ }
+ {base[PRELIGHT]} {
+ set Colors(prelight) $val
+ }
+ }
+ }
+
+ foreach c {fg bg sfg sbg dfg} {
+ if {[info exists new($c)]} {
+ set Colors($c) $new($c)
+ }
+ }
+ return 1
+}
+
+
+# load the colors into the tcl option database
+proc pref_set_option_db {makebg} {
+ global Colors
+
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 *highlightBackground $Colors(bg)
option add *selectBackground $Colors(sbg)
-
- # selectForeground
- set Colors(sfg) [option get .e selectForeground {}]
- if {$Colors(sfg) == ""} {set Colors(sfg) white}
+ option add *activeBackground $Colors(sbg)
option add *selectForeground $Colors(sfg)
+ if {[info exists Colors(prelight)]} {
+ option add *Button*activeBackground $Colors(prelight)
+ }
+ if {[info exists Colors(dfg)]} {
+ option add *disabledForeground $Colors(dfg)
+ }
- # 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
-
+ if {$makebg} {
+ # 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
}
OSDN Git Service
