From 7fa8936029f4f27a703ae96a994b7c88e14656b4 Mon Sep 17 00:00:00 2001
From: Martin Hunt <hunt@redhat.com>
Date: Mon, 5 Apr 2004 20:36:55 +0000
Subject: 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.
---
 gdb/gdbtk/ChangeLog               |  49 ++++++++++++
 gdb/gdbtk/library/cspref.itb      | 152 ++++++++++++++++++++++++++++++++++++++
 gdb/gdbtk/library/cspref.ith      |  36 +++++++++
 gdb/gdbtk/library/debugwin.itb    |  15 ++++
 gdb/gdbtk/library/debugwin.ith    |   1 +
 gdb/gdbtk/library/gdbmenubar.itcl |  13 +++-
 gdb/gdbtk/library/globalpref.itb  |  11 ++-
 gdb/gdbtk/library/interface.tcl   |  10 +--
 gdb/gdbtk/library/managedwin.itb  |  32 +++++++-
 gdb/gdbtk/library/managedwin.ith  |   5 ++
 gdb/gdbtk/library/prefs.tcl       |  52 +++++++++++--
 gdb/gdbtk/library/regwin.itb      |  16 ++--
 gdb/gdbtk/library/regwin.ith      |   2 +-
 gdb/gdbtk/library/session.tcl     |  36 ++++++---
 gdb/gdbtk/library/srcbar.itcl     |  33 ++++++++-
 gdb/gdbtk/library/tclIndex        |  16 +++-
 gdb/gdbtk/library/util.tcl        |  60 ++++++++++++++-
 17 files changed, 496 insertions(+), 43 deletions(-)
 create mode 100644 gdb/gdbtk/library/cspref.itb
 create mode 100644 gdb/gdbtk/library/cspref.ith

(limited to 'gdb/gdbtk')

diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog
index ef760be167f..17b9d782c78 100644
--- a/gdb/gdbtk/ChangeLog
+++ b/gdb/gdbtk/ChangeLog
@@ -1,3 +1,52 @@
+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
diff --git a/gdb/gdbtk/library/cspref.itb b/gdb/gdbtk/library/cspref.itb
new file mode 100644
index 00000000000..900f721ab41
--- /dev/null
+++ b/gdb/gdbtk/library/cspref.itb
@@ -0,0 +1,152 @@
+# 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
+  }
+}
diff --git a/gdb/gdbtk/library/cspref.ith b/gdb/gdbtk/library/cspref.ith
new file mode 100644
index 00000000000..a65f11b436f
--- /dev/null
+++ b/gdb/gdbtk/library/cspref.ith
@@ -0,0 +1,36 @@
+# 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 {}
+  }
+}
+
diff --git a/gdb/gdbtk/library/debugwin.itb b/gdb/gdbtk/library/debugwin.itb
index baeadab300e..636ede4aeca 100644
--- a/gdb/gdbtk/library/debugwin.itb
+++ b/gdb/gdbtk/library/debugwin.itb
@@ -42,6 +42,21 @@ itcl::body DebugWin::destructor {} {
   ::debug::debugwin ""
 }
 
+# -----------------------------------------------------------------------------
+# 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
 #
diff --git a/gdb/gdbtk/library/debugwin.ith b/gdb/gdbtk/library/debugwin.ith
index df173745f01..e7118015deb 100644
--- a/gdb/gdbtk/library/debugwin.ith
+++ b/gdb/gdbtk/library/debugwin.ith
@@ -42,6 +42,7 @@ itcl::class DebugWin {
     method _clear {}
     method _mark_old {}
     method _save_contents {}
+    method reconfig {}
   }
 
   protected {
diff --git a/gdb/gdbtk/library/gdbmenubar.itcl b/gdb/gdbtk/library/gdbmenubar.itcl
index 0820cdc4853..e227cfdb179 100644
--- a/gdb/gdbtk/library/gdbmenubar.itcl
+++ b/gdb/gdbtk/library/gdbmenubar.itcl
@@ -1,5 +1,5 @@
 # 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
@@ -138,10 +138,19 @@ itcl::class GDBMenuBar {
   #                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
   }
 
diff --git a/gdb/gdbtk/library/globalpref.itb b/gdb/gdbtk/library/globalpref.itb
index af727e33c23..486bc5025d6 100644
--- a/gdb/gdbtk/library/globalpref.itb
+++ b/gdb/gdbtk/library/globalpref.itb
@@ -1,5 +1,5 @@
 # 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
@@ -44,7 +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/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]
@@ -209,15 +209,20 @@ itcl::body GlobalPref::_build_win {} {
   }
 
   # 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
diff --git a/gdb/gdbtk/library/interface.tcl b/gdb/gdbtk/library/interface.tcl
index 10daac377c5..200c0a3b7e5 100644
--- a/gdb/gdbtk/library/interface.tcl
+++ b/gdb/gdbtk/library/interface.tcl
@@ -1,5 +1,5 @@
 # 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
@@ -418,7 +418,7 @@ proc gdbtk_tcl_fputs {message} {
   # 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
   }
 }
@@ -434,7 +434,7 @@ proc echo {args} {
 # 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
   }
@@ -444,7 +444,7 @@ proc gdbtk_tcl_fputs_error {message} {
 # 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
   }
@@ -1512,7 +1512,7 @@ proc gdbtk_stop {} {
 
   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}
   }
 }
diff --git a/gdb/gdbtk/library/managedwin.itb b/gdb/gdbtk/library/managedwin.itb
index dcf4989bfb5..9fc1a05a665 100644
--- a/gdb/gdbtk/library/managedwin.itb
+++ b/gdb/gdbtk/library/managedwin.itb
@@ -1,5 +1,5 @@
 # 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
@@ -40,6 +40,24 @@ itcl::body ManagedWin::destructor {} {
 #   (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
@@ -48,6 +66,18 @@ itcl::body ManagedWin::window_name {wname {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
diff --git a/gdb/gdbtk/library/managedwin.ith b/gdb/gdbtk/library/managedwin.ith
index f4a16c97c30..5bc9ab2f973 100644
--- a/gdb/gdbtk/library/managedwin.ith
+++ b/gdb/gdbtk/library/managedwin.ith
@@ -25,6 +25,7 @@ itcl::class ManagedWin {
     method pickle {}
     method reveal {}
     method window_name {wname {iname ""}}
+    proc window_instance {ins}
 
     proc find {win}
     proc open {class args}
@@ -33,6 +34,8 @@ itcl::class ManagedWin {
     proc restart {}
     proc startup {}
     proc shutdown {}
+
+    common win_instance ""
   }
 
   protected {
@@ -63,5 +66,7 @@ itcl::class ManagedWin {
     proc _create {class args}
     proc _open {class args}
     proc _make_icon_window {name {file "gdbtk_icon"}}
+    variable _wname {}
+    variable _iname {}
   }
 }
diff --git a/gdb/gdbtk/library/prefs.tcl b/gdb/gdbtk/library/prefs.tcl
index 2241d49d0bd..8d645b412bc 100644
--- a/gdb/gdbtk/library/prefs.tcl
+++ b/gdb/gdbtk/library/prefs.tcl
@@ -1,5 +1,5 @@
 # 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
@@ -142,7 +142,17 @@ proc pref_read {} {
   }
 
   # 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
+  }
 }
 
 # ------------------------------------------------------------------
@@ -199,7 +209,7 @@ proc pref_save {{win {}}} {
     # 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\]"
@@ -405,8 +415,36 @@ proc pref_set_defaults {} {
   
   # 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
   
@@ -674,6 +712,7 @@ proc pref_set_option_db {makebg} {
   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)
@@ -698,11 +737,8 @@ proc pref_set_option_db {makebg} {
   }
   
   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
   }
diff --git a/gdb/gdbtk/library/regwin.itb b/gdb/gdbtk/library/regwin.itb
index dd1145543b3..a2b57b5e412 100644
--- a/gdb/gdbtk/library/regwin.itb
+++ b/gdb/gdbtk/library/regwin.itb
@@ -1,5 +1,5 @@
 # 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)
@@ -409,21 +409,17 @@ itcl::body RegWin::_size_column {col down} {
 }
 
 # ------------------------------------------------------------------
-#  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)
 }
 
 
diff --git a/gdb/gdbtk/library/regwin.ith b/gdb/gdbtk/library/regwin.ith
index 47be705f2f9..88b7a99482e 100644
--- a/gdb/gdbtk/library/regwin.ith
+++ b/gdb/gdbtk/library/regwin.ith
@@ -64,7 +64,6 @@ itcl::class RegWin {
     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}
 
@@ -99,5 +98,6 @@ itcl::class RegWin {
     method set_variable {event}
     method update {event}
     method arch_changed {event}
+    method reconfig {}
   }
 }
diff --git a/gdb/gdbtk/library/session.tcl b/gdb/gdbtk/library/session.tcl
index 158ffd245be..01ebefc0f58 100644
--- a/gdb/gdbtk/library/session.tcl
+++ b/gdb/gdbtk/library/session.tcl
@@ -1,5 +1,5 @@
-# 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
@@ -173,7 +173,10 @@ namespace eval Session {
     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]
@@ -184,11 +187,11 @@ namespace eval Session {
     # 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
 
@@ -248,7 +251,7 @@ namespace eval Session {
       return
     }
 
-    debug "reloading session for $gdb_exe_name"
+    debug "reloading session for $name"
 
     if {[info exists values(dirs)]} {
       # FIXME: short-circuit confirmation.
@@ -269,9 +272,20 @@ namespace eval Session {
     }
 
     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
     }
@@ -281,7 +295,11 @@ namespace eval Session {
       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)
+    }
   }
 
   #
diff --git a/gdb/gdbtk/library/srcbar.itcl b/gdb/gdbtk/library/srcbar.itcl
index 71ae814764f..7744fa18a6a 100644
--- a/gdb/gdbtk/library/srcbar.itcl
+++ b/gdb/gdbtk/library/srcbar.itcl
@@ -1,5 +1,5 @@
 # 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
@@ -456,6 +456,25 @@ itcl::class SrcBar {
     
     $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"
   }
 
   # ------------------------------------------------------------------
@@ -850,6 +869,17 @@ itcl::class SrcBar {
     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.
   }
 
@@ -1144,6 +1174,7 @@ Do you want to continue?" \
 
   # The GdbMenuBar component
   private variable Menu
+  private variable color_menu
 
   # The GdbToolBar component
   private variable Tool
diff --git a/gdb/gdbtk/library/tclIndex b/gdb/gdbtk/library/tclIndex
index 657c54d226e..c6f42821fe9 100644
--- a/gdb/gdbtk/library/tclIndex
+++ b/gdb/gdbtk/library/tclIndex
@@ -129,6 +129,9 @@ set auto_index(list_disassembly_flavors) [list source [file join $dir util.tcl]]
 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]]
@@ -142,6 +145,7 @@ set auto_index(Frame) [list source [file join $dir blockframe.ith]]
 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]]
@@ -271,8 +275,17 @@ set auto_index(::Console::_reset_tab) [list source [file join $dir console.itb]]
 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]]
@@ -340,6 +353,7 @@ set auto_index(::KodWin::_restore_buttons) [list source [file join $dir kod.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]]
@@ -413,7 +427,7 @@ set auto_index(::RegWin::_build_win) [list source [file join $dir regwin.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]]
diff --git a/gdb/gdbtk/library/util.tcl b/gdb/gdbtk/library/util.tcl
index cd6a92714ac..4e9737d112e 100644
--- a/gdb/gdbtk/library/util.tcl
+++ b/gdb/gdbtk/library/util.tcl
@@ -1,5 +1,5 @@
-# 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
@@ -273,3 +273,59 @@ proc gdbtk_endian {} {
   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}]]
+}
+
+
-- 
cgit v1.2.1