From 112dd94e02e34d5e6ff53d5a43b98332ae245d20 Mon Sep 17 00:00:00 2001 From: Martin Hunt Date: Wed, 6 Nov 2002 20:45:54 +0000 Subject: [PATCH] 2002-11-06 Martin M. Hunt * library/globalpref.itb (_build_win): Add radiobox to select KDE/GNOME/default for pref gdb/compat. Remove browser option. * library/regwin.itb (build_win): Colors(hbg) has been removed so use Colors(bg) instead. * library/prefs.tcl (pref_set_defaults): Add a new preference "gdb/compat" which can be set to KDE, GNOME, Windows or default. This allows us to change Insight's behavior based on windowing system. (pref_set_colors): Attempt to read in .gtkrc files. Do different things for KDE vs GNOME. (pref_load_default): New function. Load default colors. (pref_load_gnome): New function. Find and open GNOME file. (load_gnome_file): New function. Loads GNOME file. (pref_set_option_db): New function. Set option database. --- gdb/gdbtk/ChangeLog | 19 +++ gdb/gdbtk/library/globalpref.itb | 69 ++++---- gdb/gdbtk/library/prefs.tcl | 352 ++++++++++++++++++++++++++++++--------- gdb/gdbtk/library/regwin.itb | 2 +- 4 files changed, 327 insertions(+), 115 deletions(-) diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog index f7462b9fec..d64cd89cd6 100644 --- a/gdb/gdbtk/ChangeLog +++ b/gdb/gdbtk/ChangeLog @@ -1,5 +1,24 @@ 2002-11-06 Martin M. Hunt + * library/globalpref.itb (_build_win): Add radiobox + to select KDE/GNOME/default for pref gdb/compat. Remove + browser option. + + * library/regwin.itb (build_win): Colors(hbg) has been + removed so use Colors(bg) instead. + + * library/prefs.tcl (pref_set_defaults): Add a new + preference "gdb/compat" which can be set to KDE, GNOME, + Windows or default. This allows us to change Insight's + behavior based on windowing system. + (pref_set_colors): Attempt to read in .gtkrc files. + Do different things for KDE vs GNOME. + (pref_load_default): New function. Load default colors. + (pref_load_gnome): New function. Find and open GNOME file. + (load_gnome_file): New function. Loads GNOME file. + (pref_set_option_db): New function. Set option database. + +2002-11-06 Martin M. Hunt * generic/gdbtk-varobj.c: Remove FREEIF and replace with xfree. Make format_string static. diff --git a/gdb/gdbtk/library/globalpref.itb b/gdb/gdbtk/library/globalpref.itb index 7b29ff15de..8c79bde99c 100644 --- a/gdb/gdbtk/library/globalpref.itb +++ b/gdb/gdbtk/library/globalpref.itb @@ -44,8 +44,7 @@ itcl::body GlobalPref::_init {} { # 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] @@ -187,6 +186,10 @@ itcl::body GlobalPref::_build_win {} { _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)]} { @@ -194,47 +197,50 @@ itcl::body GlobalPref::_build_win {} { 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] @@ -242,10 +248,9 @@ itcl::body GlobalPref::_build_win {} { 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 \ "$itk_interior.x.ok flash; $itk_interior.x.ok invoke" diff --git a/gdb/gdbtk/library/prefs.tcl b/gdb/gdbtk/library/prefs.tcl index 8d24cc378b..ec61d49557 100644 --- a/gdb/gdbtk/library/prefs.tcl +++ b/gdb/gdbtk/library/prefs.tcl @@ -135,14 +135,14 @@ proc pref_read {} { } 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 } # ------------------------------------------------------------------ @@ -158,9 +158,9 @@ proc pref_save {{win {}}} { 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 @@ -276,6 +276,7 @@ proc unescape_value {val version} { # ------------------------------------------------------------------ proc pref_set_defaults {} { global GDBTK_LIBRARY tcl_platform gdb_ImageDir + debug # Gdb global defaults pref define gdb/ImageDir images2 @@ -284,9 +285,19 @@ proc pref_set_defaults {} { 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 @@ -351,7 +362,7 @@ proc pref_set_defaults {} { # Stack Window pref define gdb/stack/font global/fixed - + # Register Window pref define gdb/reg/rows 16 @@ -394,50 +405,25 @@ proc pref_set_defaults {} { 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 @@ -446,64 +432,266 @@ proc pref_set_colors {} { # 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 } diff --git a/gdb/gdbtk/library/regwin.itb b/gdb/gdbtk/library/regwin.itb index 4c94112563..a27a7b1ccc 100644 --- a/gdb/gdbtk/library/regwin.itb +++ b/gdb/gdbtk/library/regwin.itb @@ -223,7 +223,7 @@ itcl::body RegWin::_build_win {} { $itk_component(table) tag configure normal \ -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 configure highlight -bg $::Colors(bg) $itk_component(table) tag raise highlight $itk_component(table) tag configure header \ -anchor w -state disabled -relief raised -- 2.11.0