+2004-04-05 Martin Hunt <hunt@redhat.com>
+
+ * library/session.tcl: Make hostname and portname
+ session-dependent. Add gdb_bg_num (the color
+ scheme number) as a per-session variable.
+
+ * library/prefs.tcl (pref_read): If color schemes are in use,
+ set colors based on the current scheme.
+ (pref_save): Add "bg" section.
+ (pref_set_defaults): Define new variable gdb/use_color_schemes
+ and define 16 default background colors.
+
+ * library/managedwin.itb (ManagedWin::window_name): Append
+ window "instance" string to window name.
+ (ManagedWin::window_instance): Set window instance string.
+
+ * library/debugwin.itb: Add a reconfig method to restore
+ unique black textbackground, overriding color scheme.
+
+ * library/csprefs.itb:
+ * library/csprefs.ith: New files. Implement color scheme
+ preferences.
+
+ * library/util.tcl (set_bg_colors): New function.
+ (r_setcolors): New function.
+
+ * library/regwin.itb (_prefs_changed): Deleted.
+ (reconfig): New function. Updates tkTable color tags
+ if color scheme changes.
+ * library/regwin.ith: Update to reflect above changes.
+
+ * library/srcbar.itcl (create_pref_menu): Add pulldown
+ menus for "Edit Color Schemes..." and "Use Color Schemes".
+ (reconfig): Fix up menu items for color schemes.
+
+ * library/globalpref.itb (_init_var): Add
+ gdb/use_color_schemes to variable list.
+ (_build_win): Add a checkbutton to enable/disable
+ color schemes.
+
+ * library/gdbmenubar.itcl (menubar_add_cascade): Add a class
+ argument so cascade menus can be managed by class too.
+
+ * library/interface.tcl (gdbtk_tcl_fputs): Check for
+ existence of gdbtk_state(console). Stops annoying error
+ messages.
+ (gdbtk_tcl_fputs_error): Ditto.
+ (gdbtk_tcl_fputs_log): Ditto.
+
2004-03-29 Martin Hunt <hunt@redhat.com>
* generic/gdbtk-register.c (map_arg_registers): If a specific
--- /dev/null
+# Color Scheme preferences dialog for Insight.
+# Copyright 2004 Red Hat
+#
+# 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
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR - create new source preferences window
+# ------------------------------------------------------------------
+itcl::body CSPref::constructor {args} {
+ window_name "Color Scheme Preferences"
+ _init_var
+ _build_win
+}
+
+# ------------------------------------------------------------------
+# METHOD: init_var - initialize preference variables
+# ------------------------------------------------------------------
+itcl::body CSPref::_init_var {} {
+ for {set i 0} {$i < 16} {incr i} {
+ lappend vlist gdb/bg/$i
+ }
+
+ foreach var $vlist {
+ set _saved($var) [pref get $var]
+ set _new($var) $_saved($var)
+ }
+}
+
+
+# ------------------------------------------------------------------
+# METHOD: build_win - build the dialog
+# ------------------------------------------------------------------
+itcl::body CSPref::_build_win {} {
+ frame $itk_interior.f
+ frame $itk_interior.f.a
+ frame $itk_interior.f.b
+ set f $itk_interior.f.a
+
+ # Description frame
+ set d [labelframe $f.desc -text "Description"]
+ label $d.txt -justify left -wraplength 6i -background $::Colors(textbg) \
+ -text "There are many situations where multiple instances\
+of Insight may be running. Some examples are when debugging itself, when debugging\
+client and server programs, or multiprocessor systems. In these situations, it is easy\
+to get confused by the many different windows. Insight provides a simple way to have\
+all the windows belonging to a particular Insight instance use the same background color.\
+\n\nClick on a color below to edit it. This is a text background color. Other colors are\
+computed based on it."
+ pack $d.txt -side top
+ pack $f.desc -expand yes -fill both
+
+ set w [labelframe $f.colors -text "Text Backgrounds"]
+ for {set i 0} {$i < 16} {incr i} {
+ set color $_new(gdb/bg/$i)
+ button $w.$i -text [format "%X" $i] -activebackground $color -bg $color \
+ -command [code $this _pick $color $w.$i $i]
+ }
+
+ grid $w.0 $w.1 $w.2 $w.3 $w.4 $w.5 $w.6 $w.7 -padx 10 -pady 10 -sticky we
+ grid $w.8 $w.9 $w.10 $w.11 $w.12 $w.13 $w.14 $w.15 -padx 10 -pady 10 -sticky we
+
+ pack $w -fill both -expand yes
+ pack $f.colors -fill both -expand yes
+
+ button $itk_interior.f.b.ok -text OK -width 7 -underline 0 -command [code $this _save]
+ button $itk_interior.f.b.apply -text Apply -width 7 -underline 0 -command [code $this _apply]
+ button $itk_interior.f.b.quit -text Cancel -width 7 -underline 0 -command [code $this _cancel]
+ standard_button_box $itk_interior.f.b
+ pack $itk_interior.f.a $itk_interior.f.b $itk_interior.f -expand yes -fill both -padx 5 -pady 5
+}
+
+# ------------------------------------------------------------------
+# METHOD: apply - apply changes
+# ------------------------------------------------------------------
+itcl::body CSPref::_apply {} {
+ foreach var [array names _new] {
+ if {$_new($var) != [pref get $var]} {
+ pref set $var $_new($var)
+ }
+ }
+ set_bg_colors
+}
+
+# ------------------------------------------------------------------
+# METHOD: _cancel
+# ------------------------------------------------------------------
+itcl::body CSPref::_cancel {} {
+ set bg_changed 0
+
+ if {[string compare [pref get gdb/bg/$::gdb_bg_num] $_saved(gdb/bg/$::gdb_bg_num)] != 0} {
+ set bg_changed 1
+ }
+
+ foreach elem [array names _saved] {
+ set cur_val [pref get $elem]
+ if {[string compare $cur_val $_saved($elem)] != 0} {
+ pref set $elem $_saved($elem)
+ }
+ }
+
+ if {$bg_changed} {
+ set_bg_colors
+ } else {
+ ManagedWin::restart
+ }
+ unpost
+}
+
+# ------------------------------------------------------------------
+# METHOD: save - apply changes and quit
+# ------------------------------------------------------------------
+itcl::body CSPref::_save {} {
+ _apply
+ unpost
+}
+
+# ------------------------------------------------------------------
+# METHOD: reconfig - called when windows are reconfigured
+# ------------------------------------------------------------------
+
+itcl::body CSPref::reconfig {} {
+ # Unfortunately, r_setcolors recolors buttons if we do an Apply,
+ # so fix them up here.
+
+ for {set i 0} {$i < 10} {incr i} {
+ set color $_new(gdb/bg/$i)
+ $w.$i configure -activebackground $color -bg $color
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: pick - pick colors
+# ------------------------------------------------------------------
+itcl::body CSPref::_pick {color win num} {
+ #debug "$color $win $num"
+ set new_color [tk_chooseColor -initialcolor $color -title "Choose color"]
+ if {$new_color != $color && $new_color != {}} {
+ $win configure -activebackground $new_color -bg $new_color \
+ -command [code $this _pick $new_color $w.${num}b $num]
+ set _new(gdb/bg/$num) $new_color
+ pref set gdb/bg/$num $new_color
+ }
+}
--- /dev/null
+# Color Scheme preferences dialog class definition for GDBtk.
+# Copyright 2004, 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
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+
+itcl::class CSPref {
+ inherit ManagedWin ModalDialog
+
+ private {
+ variable _saved ;# These are the saved values...
+ variable _new ;# These are the changed values
+ variable w
+ method _apply {}
+ method _build_win {}
+ method _cancel {}
+ method _init_var {}
+ method _pick {color win num}
+ method _save {}
+ method _setcolors {}
+ }
+
+ public {
+ method constructor {args}
+ method reconfig {}
+ }
+}
+
}
# -----------------------------------------------------------------------------
+# NAME: DebugWin::reconfig
+#
+# SYNOPSIS: Reconfigure callback
+#
+# DESC: Fixes up window colors
+#
+# ARGS: None
+# -----------------------------------------------------------------------------
+itcl::body DebugWin::reconfig {} {
+ # This keeps the Debug window using its unique black background.
+ # Otherwise, a reconfigure event will color it to match the other windows
+ $itk_interior.s configure -textbackground black
+}
+
+# -----------------------------------------------------------------------------
# NAME: DebugWin::build_win
#
# SYNOPSIS: build_win
method _clear {}
method _mark_old {}
method _save_contents {}
+ method reconfig {}
}
protected {
# GDBMenuBar
-# Copyright 2000 Red Hat, Inc.
+# Copyright 2000, 2004 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
# underline - which element to underline for shortcuts
# RETURNS: Nothing
# ------------------------------------------------------------------
- private method menubar_add_cascade {menu_name label underline} {
+ private method menubar_add_cascade {menu_name class label underline} {
set m [menu $current_menu.$menu_name -tearoff false]
$current_menu add cascade -menu $m -label $label \
-underline $underline
+ incr item_number
+ switch $class {
+ None {}
+ default {
+ foreach elem $class {
+ lappend menu_classes($elem) [list $current_menu $item_number]
+ }
+ }
+ }
set current_menu $m
}
# Global preference class implementation for Insight.
-# Copyright 1997, 1998, 1999, 2002, 2003 Red Hat
+# Copyright 1997, 1998, 1999, 2002, 2003, 2004 Red Hat
#
# 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
# METHOD: init_var - initialize preference variables
# ------------------------------------------------------------------
itcl::body GlobalPref::_init_var {} {
- set vlist {gdb/ImageDir gdb/console/wrap gdb/mode gdb/use_icons gdb/compat}
+ set vlist {gdb/ImageDir gdb/console/wrap gdb/mode gdb/use_icons gdb/compat gdb/use_color_schemes}
foreach var $vlist {
set _saved($var) [pref get $var]
}
# console wrap
- checkbutton $f.consolewrap -text "wrap text in console window" \
+ checkbutton $f.consolewrap -text "Wrap text in console window" \
-variable [scope _new(gdb/console/wrap)]
+ # colored backgrounds
+ checkbutton $f.use_cs -text "Enable Color Schemes" \
+ -variable [scope _new(gdb/use_color_schemes)]
+
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
+ grid $f.use_cs -sticky w -padx 5 -pady 5
if {$tcl_platform(platform) == "unix"} {
# Compatibility frame
# Interface between GDB and Insight.
-# Copyright 1997, 1998, 1999, 2001, 2002 Red Hat, Inc.
+# Copyright 1997, 1998, 1999, 2001, 2002, 2004 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
# Restore the fputs hook, in case anyone forgot to put it back...
gdb_restore_fputs
- if {$gdbtk_state(console) != ""} {
+ if {[info exists gdbtk_state(console)] && $gdbtk_state(console) != ""} {
$gdbtk_state(console) insert $message
}
}
# PROC: gdbtk_tcl_fputs_error - write an error message
# ------------------------------------------------------------------
proc gdbtk_tcl_fputs_error {message} {
- if {$::gdbtk_state(console) != ""} {
+ if {[info exists gdbtk_state(console)] && $::gdbtk_state(console) != ""} {
$::gdbtk_state(console) insert $message err_tag
update
}
# PROC: gdbtk_tcl_fputs_log - write a log message
# ------------------------------------------------------------------
proc gdbtk_tcl_fputs_log {message} {
- if {$::gdbtk_state(console) != ""} {
+ if {[info exists gdbtk_state(console)] && $::gdbtk_state(console) != ""} {
$::gdbtk_state(console) insert $message log_tag
update
}
if {$_gdbtk_stop(timer) == ""} {
add_hook gdb_idle_hook gdbtk_stop_idle_callback
- set _gdbtk_stop(timer) [after 3000 gdbtk_detach]
+ set _gdbtk_stop(timer) [after 15000 gdbtk_detach]
catch {gdb_stop}
}
}
# Managed window for Insight.
-# Copyright 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
+# Copyright 1998, 1999, 2000, 2001, 2002, 2004 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
# (and optionally its icon's name).
# ------------------------------------------------------------
itcl::body ManagedWin::window_name {wname {iname ""}} {
+
+ if {$wname != ""} {
+ set _wname $wname
+ } else {
+ set wname $_wname
+ }
+ if {$iname != ""} {
+ set _iname $iname
+ } else {
+ set iname $_iname
+ }
+
+ if {$win_instance != ""} {
+ append wname " \[$win_instance\]"
+ if {$iname != ""} {
+ append iname " \[$win_instance\]"
+ }
+ }
wm title $_top $wname
if {$iname != ""} {
wm iconname $_top $iname
}
# ------------------------------------------------------------
+# PUBLIC METHOD: window_instance - Set the string to be
+# appended to each window title for this instance of Insight
+# ------------------------------------------------------------
+itcl::body ManagedWin::window_instance {ins} {
+ set win_instance $ins
+ foreach obj [itcl_info objects -isa ManagedWin] {
+ debug "$obj ManagedWin::_wname"
+ $obj window_name ""
+ }
+}
+
+# ------------------------------------------------------------
# PUBLIC METHOD: pickle - This is the base class pickle
# method. It returns a command that can be used to recreate
# this particular window.
method pickle {}
method reveal {}
method window_name {wname {iname ""}}
+ proc window_instance {ins}
proc find {win}
proc open {class args}
proc restart {}
proc startup {}
proc shutdown {}
+
+ common win_instance ""
}
protected {
proc _create {class args}
proc _open {class args}
proc _make_icon_window {name {file "gdbtk_icon"}}
+ variable _wname {}
+ variable _iname {}
}
}
# Local preferences functions for Insight.
-# Copyright 1997, 1998, 1999, 2002, 2003 Red Hat
+# Copyright 1997, 1998, 1999, 2002, 2003, 2004 Red Hat
#
# 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
}
# finally set colors, from system if possible
- pref_set_colors $home
+ if {[pref get gdb/use_color_schemes] != "1"} {
+ pref_set_colors $home
+ } else {
+ global Colors
+ # These colors are the same for all schemes
+ set Colors(textfg) black
+ set Colors(fg) black
+ set Colors(sbg) \#4c59a5
+ set Colors(sfg) white
+ set_bg_colors
+ }
}
# ------------------------------------------------------------------
# FIXME: this is broken. We should discover the list
# dynamically.
lappend secs load console src reg stack locals watch bp search \
- process geometry help browser kod window session mem
+ process geometry help browser kod window session mem bg
foreach section $secs {
puts $fd "\[$section\]"
# External editor.
pref define gdb/editor ""
+
+ # background colors
+ set ::gdb_bg_num 0
+ pref define gdb/use_color_schemes 0
+ pref define gdb/bg/0 \#ffffff
+ pref define gdb/bg/1 \#ffffd0
+ pref define gdb/bg/2 \#ffd0ff
+ pref define gdb/bg/3 \#ffd0d0
+ pref define gdb/bg/4 \#d0ffff
+ pref define gdb/bg/5 \#d0ffd0
+ pref define gdb/bg/6 \#d0d0ff
+ pref define gdb/bg/7 \#d0d0d0
+ pref define gdb/bg/8 \#ffffb0
+ pref define gdb/bg/9 \#ffb0ff
+ pref define gdb/bg/10 \#ffb0b0
+ pref define gdb/bg/11 \#b0ffff
+ pref define gdb/bg/12 \#b0ffb0
+ pref define gdb/bg/13 \#b0b0ff
+ pref define gdb/bg/14 \#b0b0b0
+ pref define gdb/bg/15 \#d0b0d0
}
+
+##########################################################################
+#
+# Everything below this point is code to try to determine the current OS
+# color scheme and use that. It mostly works, but is not very compatible
+# with the use of multiple color schemes for different instances of Insight.
+#
+##########################################################################
proc pref_set_colors {home} {
# set color palette
set Colors(change) "green"
option add *background $Colors(bg)
+ option add *buttonBackground $Colors(bg)
option add *Text*background $Colors(textbg)
option add *Entry*background $Colors(textbg)
option add *foreground $Colors(fg)
}
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}]]
+ # calculate trough and activebackground as 90% of background
+ set dbg [recolor $::Colors(bg) 90]
option add *activeBackground $dbg
option add *troughColor $dbg
}
# Register display window for Insight.
-# Copyright 1998, 1999, 2001, 2002, 2003 Red Hat, Inc.
+# Copyright 1998, 1999, 2001, 2002, 2003, 2004 Red Hat, Inc.
#
# Written by Keith Seitz (keiths@redhat.com)
# and Martin Hunt (hunt@redhat.com)
}
# ------------------------------------------------------------------
-# NAME: private method RegWin::_prefs_changed
+# NAME: private method RegWin::reconfig
# DESCRIPTION: Reconfigures register window when a preference
# changes.
#
-# ARGUMENTS:
-# pref - the preference which changed
-# value - preference's new value
+# ARGUMENTS: None
# RETURNS: Nothing
#
-# NOTES: Callback from pref system
# ------------------------------------------------------------------
-itcl::body RegWin::_prefs_changed {pref value} {
- debug "$pref $value"
- # do nothing for now. With proper iwidgets this would not
- # be required anyway.
+itcl::body RegWin::reconfig {} {
+ $itk_component(table) tag configure normal \
+ -state disabled -bg $::Colors(textbg) -fg $::Colors(textfg)
}
method _build_win {}
method _layout_table {}
method _load_prefs {}
- method _prefs_changed {pref value}
method _size_cell_column {cell down}
method _size_column {col down}
method set_variable {event}
method update {event}
method arch_changed {event}
+ method reconfig {}
}
}
-# Local preferences functions for GDBtk.
-# Copyright 2000, 2001, 2002 Red Hat, Inc.
+# Local preferences functions for Insight.
+# Copyright 2000, 2001, 2002, 2004 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
set values(dirs) $gdb_source_path
set values(pwd) $gdb_current_directory
set values(target) $gdb_target_name
+ set values(hostname) [pref getd gdb/load/$gdb_target_name-hostname]
+ set values(port) [pref getd gdb/load/$gdb_target_name-portname]
set values(target_cmd) $::gdb_target_cmd
+ set values(bg) $::gdb_bg_num
# these prefs need to be made session-dependent
set values(run_attach) [pref get gdb/src/run_attach]
# Breakpoints.
set values(breakpoints) [_serialize_bps]
- # Recompute list of recent sessions. Trim to no more than 5 sessions.
+ # Recompute list of recent sessions. Trim to no more than 20 sessions.
set recent [concat [list $name] \
[lremove [pref getd gdb/recent-projects] $name]]
- if {[llength $recent] > 5} then {
- set recent [lreplace $recent 5 end]
+ if {[llength $recent] > 20} {
+ set recent [lreplace $recent 20 end]
}
pref setd gdb/recent-projects $recent
return
}
- debug "reloading session for $gdb_exe_name"
+ debug "reloading session for $name"
if {[info exists values(dirs)]} {
# FIXME: short-circuit confirmation.
}
if {[info exists values(target)]} {
- debug "Restoring Target: $values(target)"
+ #debug "Restoring Target: $values(target)"
set gdb_target_name $values(target)
- debug "Restoring Target_Cmd: $values(target_cmd)"
+
+ if {[info exists values(hostname)]} {
+ pref setd gdb/load/$gdb_target_name-hostname $values(hostname)
+ #debug "Restoring Hostname: $values(hostname)"
+ }
+
+ if {[info exists values(port)]} {
+ pref setd gdb/load/$gdb_target_name-portname $values(port)
+ #debug "Restoring Port: $values(port)"
+ }
+
+ #debug "Restoring Target_Cmd: $values(target_cmd)"
set ::gdb_target_cmd $values(target_cmd)
set_baud
}
pref set gdb/src/run_load $values(run_load)
pref set gdb/src/run_run $values(run_run)
pref set gdb/src/run_cont $values(run_cont)
- }
+ }
+
+ if {[info exists values(bg)] && [pref get gdb/use_color_schemes]} {
+ set_bg_colors $values(bg)
+ }
}
#
# SrcBar
-# Copyright 2001, 2002 Red Hat, Inc.
+# Copyright 2001, 2002, 2004 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
$Menu add command Other "Source..." \
"ManagedWin::open SrcPref -transient" -underline 0
+
+ $Menu add command Color "Edit Color Schemes..." \
+ "ManagedWin::open CSPref -transient" -underline 0
+
+ $Menu add separator
+
+ set color_menu [$Menu add cascade use_cs Color "Use Color Scheme" 0]
+ for {set i 0} {$i < 16} {incr i} {
+ set dbg [recolor [pref get gdb/bg/$i] 80]
+ $color_menu add command -label $i -background [pref get gdb/bg/$i] \
+ -activebackground $dbg -command "set_bg_colors $i" -underline 0
+ }
+
+ if {[pref get gdb/use_color_schemes] == "1"} {
+ set cs_state normal
+ } else {
+ set cs_state disabled
+ }
+ $Menu set_class_state "Color $cs_state"
}
# ------------------------------------------------------------------
debug
_load_src_images 1
_load_images 1
+
+ if {[pref get gdb/use_color_schemes] == "1"} {
+ set cs_state normal
+ } else {
+ set cs_state disabled
+ }
+ $Menu set_class_state "Color $cs_state"
+ for {set i 0} {$i < 16} {incr i} {
+ set dbg [recolor [pref get gdb/bg/$i] 80]
+ $color_menu entryconfigure $i -activebackground $dbg -background [pref get gdb/bg/$i]
+ }
# FIXME: Must Check if we are Tracing and set the buttons accordingly.
}
# The GdbMenuBar component
private variable Menu
+ private variable color_menu
# The GdbToolBar component
private variable Tool
set auto_index(init_disassembly_flavor) [list source [file join $dir util.tcl]]
set auto_index(list_element_strcmp) [list source [file join $dir util.tcl]]
set auto_index(gdbtk_endian) [list source [file join $dir util.tcl]]
+set auto_index(set_bg_colors) [list source [file join $dir util.tcl]]
+set auto_index(r_setcolors) [list source [file join $dir util.tcl]]
+set auto_index(recolor) [list source [file join $dir util.tcl]]
set auto_index(WarningDlg) [list source [file join $dir warning.tcl]]
set auto_index(::WarningDlg::constructor) [list source [file join $dir warning.tcl]]
set auto_index(WatchWin) [list source [file join $dir watch.tcl]]
set auto_index(BpWin) [list source [file join $dir bpwin.ith]]
set auto_index(BrowserWin) [list source [file join $dir browserwin.ith]]
set auto_index(Console) [list source [file join $dir console.ith]]
+set auto_index(CSPref) [list source [file join $dir cspref.ith]]
set auto_index(DebugWin) [list source [file join $dir debugwin.ith]]
set auto_index(DebugWinDOpts) [list source [file join $dir debugwin.ith]]
set auto_index(Download) [list source [file join $dir download.ith]]
set auto_index(::Console::_set_wrap) [list source [file join $dir console.itb]]
set auto_index(::Console::_update_option) [list source [file join $dir console.itb]]
set auto_index(::Console::test) [list source [file join $dir console.itb]]
+set auto_index(::CSPref::constructor) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_init_var) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_build_win) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_apply) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_cancel) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_save) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::reconfig) [list source [file join $dir cspref.itb]]
+set auto_index(::CSPref::_pick) [list source [file join $dir cspref.itb]]
set auto_index(::DebugWin::constructor) [list source [file join $dir debugwin.itb]]
set auto_index(::DebugWin::destructor) [list source [file join $dir debugwin.itb]]
+set auto_index(::DebugWin::reconfig) [list source [file join $dir debugwin.itb]]
set auto_index(::DebugWin::build_win) [list source [file join $dir debugwin.itb]]
set auto_index(::DebugWin::puts) [list source [file join $dir debugwin.itb]]
set auto_index(::DebugWin::put_trace) [list source [file join $dir debugwin.itb]]
set auto_index(::ManagedWin::constructor) [list source [file join $dir managedwin.itb]]
set auto_index(::ManagedWin::destructor) [list source [file join $dir managedwin.itb]]
set auto_index(::ManagedWin::window_name) [list source [file join $dir managedwin.itb]]
+set auto_index(::ManagedWin::window_instance) [list source [file join $dir managedwin.itb]]
set auto_index(::ManagedWin::pickle) [list source [file join $dir managedwin.itb]]
set auto_index(::ManagedWin::reveal) [list source [file join $dir managedwin.itb]]
set auto_index(::ManagedWin::restart) [list source [file join $dir managedwin.itb]]
set auto_index(::RegWin::_layout_table) [list source [file join $dir regwin.itb]]
set auto_index(::RegWin::_size_cell_column) [list source [file join $dir regwin.itb]]
set auto_index(::RegWin::_size_column) [list source [file join $dir regwin.itb]]
-set auto_index(::RegWin::_prefs_changed) [list source [file join $dir regwin.itb]]
+set auto_index(::RegWin::reconfig) [list source [file join $dir regwin.itb]]
set auto_index(::RegWin::_accept_edit) [list source [file join $dir regwin.itb]]
set auto_index(::RegWin::_add_to_watch) [list source [file join $dir regwin.itb]]
set auto_index(::RegWin::_open_memory) [list source [file join $dir regwin.itb]]
-# Utilities for GDBtk.
-# Copyright 1997, 1998, 1999 Cygnus Solutions
+# Utilities for Insight.
+# Copyright 1997, 1998, 1999, 2004 Red Hat
#
# 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
return $result
}
+# ------------------------------------------------------------------
+# PROC: set_bg_colors - set background and text background for
+# all windows.
+# ------------------------------------------------------------------
+proc set_bg_colors {{num ""}} {
+ debug $num
+
+ if {$num != ""} {
+ set ::gdb_bg_num $num
+ }
+ set ::Colors(textbg) [pref get gdb/bg/$::gdb_bg_num]
+
+ # calculate background as 80% of textbg
+ set ::Colors(bg) [recolor $::Colors(textbg) 80]
+
+ # calculate trough and activebackground as 90% of background
+ set dbg [recolor $::Colors(bg) 90]
+
+ r_setcolors . -background $::Colors(bg)
+ r_setcolors . -highlightbackground $::Colors(bg)
+ r_setcolors . -textbackground $::Colors(textbg)
+ r_setcolors . -troughcolor $dbg
+ r_setcolors . -activebackground $dbg
+
+ pref_set_option_db 1
+ ManagedWin::restart
+}
+
+# ------------------------------------------------------------------
+# PROC: r_setcolors - recursively set background and text background for
+# all windows.
+# ------------------------------------------------------------------
+proc r_setcolors {w option color} {
+ debug "$w $option $color"
+
+ # exception(s)
+ if {![catch {$w isa Balloon} result] && $result == "1"} {
+ return
+ }
+ catch {$w config $option $color}
+
+ foreach child [winfo children $w] {
+ r_setcolors $child $option $color
+ }
+}
+
+# ------------------------------------------------------------------
+# PROC: recolor - returns a darker or lighter color
+# ------------------------------------------------------------------
+proc recolor {color percent} {
+ set c [winfo rgb . $color]
+ return [format #%02x%02x%02x [expr {($percent * [lindex $c 0]) / 25600}] \
+ [expr {($percent * [lindex $c 1]) / 25600}] [expr {($percent * [lindex $c 2]) / 25600}]]
+}
+
+
OSDN Git Service
