This is the mail archive of the insight@sources.redhat.com mailing list for the Insight project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch] Color schemes


I've checked in a jumbo patch to Insight that adds "color schemes",
remembers hostname and port for each session, and fixes some other minor
stuff.

So what are "Color Schemes" used for?  They are for people running
multiple copies of Insight.  If you are using Insight to debug itself,
or debugging a client and server at the same time, or debugging
multiprocessor stuff, you may want to use this feature.

To enable it, go to Global Preferences and check the box "Enable Color
Schemes"  Then select a color scheme from the menu.  All windows
associated with that instance of Insight will have the same color
scheme.  

Color schemes are session-dependent.  This means they will be associated
with a particular executable.  Every time you debug the same executable,
you will get the same scheme.

-- 
Martin M. Hunt <hunt@redhat.com>
Red Hat Inc.

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.

Index: library/cspref.itb
===================================================================
RCS file: library/cspref.itb
diff -N library/cspref.itb
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/cspref.itb	5 Apr 2004 20:21:16 -0000
@@ -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
+  }
+}
Index: library/cspref.ith
===================================================================
RCS file: library/cspref.ith
diff -N library/cspref.ith
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/cspref.ith	5 Apr 2004 20:21:16 -0000
@@ -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 {}
+  }
+}
+
Index: library/debugwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/debugwin.itb,v
retrieving revision 1.11
diff -u -r1.11 debugwin.itb
--- library/debugwin.itb	4 Dec 2002 20:58:05 -0000	1.11
+++ library/debugwin.itb	5 Apr 2004 20:21:16 -0000
@@ -43,6 +43,21 @@
 }
 
 # -----------------------------------------------------------------------------
+# 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
Index: library/debugwin.ith
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/debugwin.ith,v
retrieving revision 1.4
diff -u -r1.4 debugwin.ith
--- library/debugwin.ith	15 Oct 2002 21:19:51 -0000	1.4
+++ library/debugwin.ith	5 Apr 2004 20:21:16 -0000
@@ -42,6 +42,7 @@
     method _clear {}
     method _mark_old {}
     method _save_contents {}
+    method reconfig {}
   }
 
   protected {
Index: library/gdbmenubar.itcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/gdbmenubar.itcl,v
retrieving revision 1.10
diff -u -r1.10 gdbmenubar.itcl
--- library/gdbmenubar.itcl	15 Oct 2002 21:19:51 -0000	1.10
+++ library/gdbmenubar.itcl	5 Apr 2004 20:21:16 -0000
@@ -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 @@
   #                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
   }
 
Index: library/globalpref.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/globalpref.itb,v
retrieving revision 1.12
diff -u -r1.12 globalpref.itb
--- library/globalpref.itb	15 Feb 2003 02:10:41 -0000	1.12
+++ library/globalpref.itb	5 Apr 2004 20:21:16 -0000
@@ -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 @@
 #  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 @@
   }
 
   # 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
Index: library/interface.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
retrieving revision 1.48
diff -u -r1.48 interface.tcl
--- library/interface.tcl	10 Feb 2003 20:10:56 -0000	1.48
+++ library/interface.tcl	5 Apr 2004 20:21:22 -0000
@@ -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 @@
   # 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: 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_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 @@
 
   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}
   }
 }
Index: library/managedwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/managedwin.itb,v
retrieving revision 1.26
diff -u -r1.26 managedwin.itb
--- library/managedwin.itb	15 Oct 2002 21:19:51 -0000	1.26
+++ library/managedwin.itb	5 Apr 2004 20:21:22 -0000
@@ -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,11 +40,41 @@
 #   (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
   } else {
     wm iconname $_top $wname
+  }
+}
+
+# ------------------------------------------------------------
+#  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 ""
   }
 }
 
Index: library/managedwin.ith
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/managedwin.ith,v
retrieving revision 1.7
diff -u -r1.7 managedwin.ith
--- library/managedwin.ith	15 Oct 2002 21:19:51 -0000	1.7
+++ library/managedwin.ith	5 Apr 2004 20:21:22 -0000
@@ -25,6 +25,7 @@
     method pickle {}
     method reveal {}
     method window_name {wname {iname ""}}
+    proc window_instance {ins}
 
     proc find {win}
     proc open {class args}
@@ -33,6 +34,8 @@
     proc restart {}
     proc startup {}
     proc shutdown {}
+
+    common win_instance ""
   }
 
   protected {
@@ -63,5 +66,7 @@
     proc _create {class args}
     proc _open {class args}
     proc _make_icon_window {name {file "gdbtk_icon"}}
+    variable _wname {}
+    variable _iname {}
   }
 }
Index: library/prefs.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/prefs.tcl,v
retrieving revision 1.28
diff -u -r1.28 prefs.tcl
--- library/prefs.tcl	11 Dec 2003 22:19:15 -0000	1.28
+++ library/prefs.tcl	5 Apr 2004 20:21:22 -0000
@@ -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 @@
   }
 
   # 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 @@
     # 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 @@
   
   # 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 @@
   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 @@
   }
   
   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
   }
Index: library/regwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/regwin.itb,v
retrieving revision 1.26
diff -u -r1.26 regwin.itb
--- library/regwin.itb	27 Mar 2003 18:02:08 -0000	1.26
+++ library/regwin.itb	5 Apr 2004 20:21:22 -0000
@@ -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 @@
 }
 
 # ------------------------------------------------------------------
-#  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)
 }
 
 
Index: library/regwin.ith
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/regwin.ith,v
retrieving revision 1.11
diff -u -r1.11 regwin.ith
--- library/regwin.ith	17 Dec 2002 20:29:12 -0000	1.11
+++ library/regwin.ith	5 Apr 2004 20:21:22 -0000
@@ -64,7 +64,6 @@
     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 @@
     method set_variable {event}
     method update {event}
     method arch_changed {event}
+    method reconfig {}
   }
 }
Index: library/session.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
retrieving revision 1.14
diff -u -r1.14 session.tcl
--- library/session.tcl	4 Feb 2003 07:15:49 -0000	1.14
+++ library/session.tcl	5 Apr 2004 20:21:22 -0000
@@ -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 @@
     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 @@
     # 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 @@
       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 @@
     }
 
     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 @@
       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)
+    }
   }
 
   #
Index: library/srcbar.itcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/srcbar.itcl,v
retrieving revision 1.22
diff -u -r1.22 srcbar.itcl
--- library/srcbar.itcl	20 Dec 2002 22:01:36 -0000	1.22
+++ library/srcbar.itcl	5 Apr 2004 20:21:22 -0000
@@ -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 @@
     
     $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 @@
     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 @@
 
   # The GdbMenuBar component
   private variable Menu
+  private variable color_menu
 
   # The GdbToolBar component
   private variable Tool
Index: library/tclIndex
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/tclIndex,v
retrieving revision 1.29
diff -u -r1.29 tclIndex
--- library/tclIndex	10 Feb 2003 09:47:52 -0000	1.29
+++ library/tclIndex	5 Apr 2004 20:21:22 -0000
@@ -129,6 +129,9 @@
 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(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::_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(::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::_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]]
Index: library/util.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/util.tcl,v
retrieving revision 1.12
diff -u -r1.12 util.tcl
--- library/util.tcl	8 Nov 2002 05:25:20 -0000	1.12
+++ library/util.tcl	5 Apr 2004 20:21:22 -0000
@@ -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
@@ -272,4 +272,60 @@
   }
   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}]]
+}
+
 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]