# Global preference class implementation for GDBtk.
# Copyright 1997, 1998, 1999 Cygnus Solutions
#
# 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.
# ----------------------------------------------------------------------
# Implements Global preferences dialog
#
# ----------------------------------------------------------------------
# ------------------------------------------------------------------
# PROC: _init - set up the tracing labels info
# ------------------------------------------------------------------
body GlobalPref::_init {} {
if {$inited} {
return
}
set inited 1
array set tracing_labels {
0 "Tracing features disabled"
1 "Tracing features enabled"
max_len 0
}
foreach elem [array names tracing_labels] {
set len [string length $tracing_labels($elem)]
set tracing_labels(max_len) \
[expr $len > $tracing_labels(max_len) ? $len : $tracing_labels(max_len) ]
}
}
# ------------------------------------------------------------------
# METHOD: constructor - create the Global Preferences object
# ------------------------------------------------------------------
body GlobalPref::constructor {args} {
window_name "Global Preferences"
_init
build_win
eval itk_initialize $args
}
# ------------------------------------------------------------------
# METHOD: destructor - destroy the Global Preferences object
# ------------------------------------------------------------------
body GlobalPref::destructor {} {
foreach thunk $Fonts {
font delete test-$thunk-font
}
}
# ------------------------------------------------------------------
# METHOD: build_win - build the dialog
# ------------------------------------------------------------------
body GlobalPref::build_win {} {
global tcl_platform GDBTK_LIBRARY
debug
frame $itk_interior.f
frame $itk_interior.x
set frame $itk_interior.f
# Icons
frame $frame.icons
label $frame.icons.lab -text "Icons "
combobox::combobox $frame.icons.cb -editable 0 -maxheight 10\
-command [code $this change_icons]
# get list of icon directories
set icondirlist ""
cd $GDBTK_LIBRARY
foreach foo [glob -- *] {
if {[file isdirectory $foo] && [file exists [file join $foo "icons.txt"]]} {
lappend icondirlist $foo
}
}
set width 14
# load combobox
set imagedir [pref get gdb/ImageDir]
foreach dir $icondirlist {
if {![string compare $dir $imagedir]} {
set cdir 1
} else {
set cdir 0
}
set foo [file join $dir "icons.txt"]
if {[catch {::open $foo r} fid]} {
# failed
if {$cdir} {$frame.icons.cb entryset "unknown icons"}
$frame.icons.cb list insert end "unknown icons"
} else {
if {[gets $fid txt] >= 0} {
if {$cdir} {$frame.icons.cb entryset $txt}
if {[string length $txt] > $width} {set width [string length $txt]}
$frame.icons.cb list insert end $txt
} else {
if {$cdir} {$frame.icons.cb entryset "unknown icons"}
$frame.icons.cb list insert end "unknown icons"
}
close $fid
}
}
$frame.icons.cb configure -width $width
# searching for fixed font families take a long time
# therefore, we cache the font names. The font cache
# can be saved in the init file. A way should be provided
# to rescan the font list, without deleting the entry from the
# init file.
set font_cache [pref get gdb/font_cache]
if {$font_cache == ""} {
if {$tcl_platform(platform) == "unix"} {
toplevel .c
wm title .c "Scanning for fonts"
message .c.m -width 3i -text "Scanning system for fonts\n\nPlease wait..." \
-relief flat -padx 30 -pady 30 \
-bg [pref get gdb/global_prefs/message_bg] \
-fg [pref get gdb/global_prefs/message_fg]
::update
pack .c.m
focus .c
::raise .c
::update
}
set fam [font families]
foreach fn $fam {
if {[font metrics [list $fn] -fixed] == 1} {
lappend font_cache $fn
}
}
pref set gdb/font_cache $font_cache
if {$tcl_platform(platform) == "unix"} { destroy .c }
}
Labelledframe $frame.d -text "Fonts"
set f [$frame.d get_frame]
make_font_item $f fixed "Fixed Font:" $font_cache
if {$tcl_platform(platform) != "windows"} {
# Cannot change the windows menu font ourselves
make_font_item $f menu "Menu Font:" [font families]
}
make_font_item $f default "Default Font:" [font families]
make_font_item $f status "Status Bar Font:" [font families]
# This is the tracing preference
set tracing_cb [pref get gdb/mode]
if { ![info exists tracing_labels($tracing_cb)]} {
debug "Got unknown mode value: $tracing_cb"
set tracing_labels($tracing_cb) "Unknown gdb mode..."
}
frame $frame.tracing
checkbutton $frame.tracing.cb -variable [scope tracing_cb] \
-text $tracing_labels($tracing_cb) \
-command [code $this toggle_tracing $frame.tracing.cb] \
-width $tracing_labels(max_len) -anchor w
pack $frame.tracing.cb -pady 10 -side left -fill none
# help browser preferences
if {$tcl_platform(platform) == "windows"} {
set help_text "Use Internet Browser to View Help Files"
} else {
set help_text "Use Netscape to View Help Files"
}
frame $frame.browser
checkbutton $frame.browser.cb \
-text $help_text -variable [pref varname gdb/help/browser]
pack $frame.browser.cb -pady 10 -side left -fill none
# use_icons
if {$tcl_platform(platform) == "unix"} {
frame $frame.use_icons
checkbutton $frame.use_icons.cb \
-text "Use builtin image as icon." -variable [pref varname gdb/use_icons]
pack $frame.use_icons.cb -pady 10 -side left -fill none
}
# console wrap
frame $frame.consolewrap
checkbutton $frame.consolewrap.cw -text "wrap text in console window" \
-variable [pref varname gdb/console/wrap]
pack $frame.consolewrap.cw -pady 10 -side left -fill none
pack $frame.icons.lab $frame.icons.cb -side left
pack $frame.icons -side top -padx 10 -pady 10
pack $frame.tracing -side top -fill x -expand 0 -side bottom
pack $frame.browser -side top -fill x -expand 0 -side bottom
if {$tcl_platform(platform) == "unix"} {
pack $frame.use_icons -side top -fill x -expand 0 -side bottom
}
pack $frame.consolewrap -side top -fill x -expand 0 -side bottom
pack $frame.d -side top -fill both -expand yes
# make buttons
button $itk_interior.x.ok -text OK -underline 0 -width 7 -command [code $this ok]
button $itk_interior.x.apply -text Apply -width 7 -underline 0 -command [code $this apply]
button $itk_interior.x.cancel -text Cancel -width 7 -underline 0 -command [code $this cancel]
pack $itk_interior.x.ok $itk_interior.x.apply $itk_interior.x.cancel -side left
standard_button_box $itk_interior.x
pack $itk_interior.x -fill x -padx 5 -pady 5 -side bottom
pack $itk_interior.f -fill both -expand yes -padx 10 -pady 5
bind $itk_interior.x.ok <Return> \
"$itk_interior.x.ok flash; $itk_interior.x.ok invoke"
focus $itk_interior.x.ok
# We don't want the window flashing around as we change the fonts...
::update idletasks
resize_font_item_height
pack propagate $itk_interior.f 0
}
# ------------------------------------------------------------------
# PRIVATE METHOD: make_font_item
# ------------------------------------------------------------------
body GlobalPref::make_font_item {f name label font_list} {
# create ComboBox with font name
lappend Fonts $name
set Original($name,family) [font actual global/$name -family]
set Original($name,size) [font actual global/$name -size]
font create test-$name-font -family $Original($name,family) \
-size $Original($name,size)
label $f.${name}x -text $label
combobox::combobox $f.${name}n -editable 0 -value $Original($name,family) \
-command [code $this wfont_changed family $name]
foreach a $font_list {
$f.${name}n list insert end $a
}
tixControl $f.${name}s -label Size: -integer true -max 18 -min 6 \
-value $Original(${name},size) -command [code $this font_changed size $name]
[$f.${name}s subwidget entry] configure -width 2
label $f.${name}l -text ABCDEFabcdef0123456789 -font test-$name-font
grid $f.${name}x $f.${name}n $f.${name}s $f.${name}l -sticky we -padx 5 -pady 5
grid columnconfigure $f 3 -weight 1
}
# ------------------------------------------------------------------
# PRIVATE METHOD: resize_font_item_height
# ------------------------------------------------------------------
body GlobalPref::resize_font_item_height {} {
foreach font $Fonts {
set master [$itk_interior.f.d get_frame]
set row [gridCGet $master.${font}l -row]
grid rowconfigure $master $row -minsize [lindex [grid bbox $master 0 $row 3 $row ] 3]
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: change_icons
# ------------------------------------------------------------------
body GlobalPref::change_icons {w args} {
global gdb_ImageDir GDBTK_LIBRARY
set index [$w list curselection]
if {$index != ""} {
set dir [lindex $icondirlist $index]
pref set gdb/ImageDir $dir
set gdb_ImageDir [file join $GDBTK_LIBRARY $dir]
ManagedWin::restart
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: wfont_changed - callback from font comboboxes
# PRIVATE METHOD: font_changed - callback from font tixControls
# ------------------------------------------------------------------
body GlobalPref::wfont_changed {attribute font w val} {
font_changed $attribute $font $val
}
body GlobalPref::font_changed {attribute font val} {
# val will be a size or a font name
switch $attribute {
size {
set oldval [font configure test-$font-font -size]
font configure test-$font-font -size $val
}
family {
set oldval [font configure test-$font-font -family]
font configure test-$font-font -family $val
}
default { debug "GlobalPref::font_changed -- invalid change" }
}
}
# ------------------------------------------------------------------
# METHOD: toggle_tracing_mode - toggles the tracing mode on and off
# ------------------------------------------------------------------
body GlobalPref::toggle_tracing_mode {} {
pref set gdb/mode $tracing_cb
# Reset the button-1 behavior if you are going out of trace mode.
if {!$tracing_cb} {
pref set gdb/B1_behavior 1
}
}
body GlobalPref::toggle_tracing {win} {
debug foo
$win configure -text $tracing_labels($tracing_cb)
}
# ------------------------------------------------------------------
# METHOD: ok - called to accept settings and close dialog
# ------------------------------------------------------------------
body GlobalPref::ok {} {
apply 1
}
# ------------------------------------------------------------------
# METHOD: apply - apply current settings to the screen
# ------------------------------------------------------------------
body GlobalPref::apply {{deleteMe 0}} {
set commands {}
# If you are not destroying the window, then make sure to
# propagate the geometry info from the font frame, so that changing
# the fonts IN the window don't cause some of the buttons to
# get obscured...
if {!$deleteMe} {
pack propagate $itk_interior.f 1
}
foreach thunk $Fonts {
set font [font configure test-$thunk-font]
if {[pref get global/font/$thunk] != $font} {
lappend commands [list pref set global/font/$thunk $font]
}
}
if {[pref get gdb/mode] != $tracing_cb} {
lappend commands toggle_tracing_mode
}
if {[llength $commands] > 0} {
foreach command $commands {
eval $command
}
if {$deleteMe} {
unpost
}
ManagedWin::restart
return
}
if {$deleteMe} {
unpost
} else {
after idle "
update idletasks
[code $this resize_font_item_height]
pack propagate $itk_interior.f 0
"
}
}
# ------------------------------------------------------------------
# METHOD: cancel - forget current settings -- reset to original
# state and close preferences
# ------------------------------------------------------------------
body GlobalPref::cancel {} {
# Reset fonts if different
set commands {}
foreach thunk $Fonts {
set family [font configure global/$thunk -family]
set size [font configure global/$thunk -size]
if {$Original($thunk,family) != $family || $Original($thunk,size) != $size} {
lappend commands [list pref set global/font/$thunk \
[list -family $Original($thunk,family) -size $Original($thunk,size)]]
}
}
if {[llength $commands] > 0} {
foreach command $commands {
eval $command
}
}
if {[llength $commands] > 0} {
ManagedWin::restart
}
unpost
}