# ----------------------------------------------------------------------
# ------------------------------------------------------------------
-# PROC: _init - set up the tracing labels info
+# METHOD: _init - set up the tracing labels info
# ------------------------------------------------------------------
body GlobalPref::_init {} {
if {$inited} {
}
# ------------------------------------------------------------------
+# METHOD: init_var - initialize preference variables
+# ------------------------------------------------------------------
+body GlobalPref::_init_var {} {
+ set vlist {gdb/ImageDir gdb/console/wrap gdb/mode
+ gdb/help/browser gdb/use_icons}
+
+ foreach var $vlist {
+ set _saved($var) [pref get $var]
+ set _new($var) $_saved($var)
+ }
+}
+
+# ------------------------------------------------------------------
# METHOD: constructor - create the Global Preferences object
# ------------------------------------------------------------------
body GlobalPref::constructor {args} {
window_name "Global Preferences"
_init
- build_win
+ _init_var
+ _build_win
eval itk_initialize $args
}
# METHOD: destructor - destroy the Global Preferences object
# ------------------------------------------------------------------
body GlobalPref::destructor {} {
- foreach thunk $Fonts {
+ foreach thunk $_fonts {
font delete test-$thunk-font
}
}
# ------------------------------------------------------------------
-# METHOD: build_win - build the dialog
+# METHOD: _build_win - build the dialog
# ------------------------------------------------------------------
-body GlobalPref::build_win {} {
+body GlobalPref::_build_win {} {
global tcl_platform GDBTK_LIBRARY
debug
frame $itk_interior.f
frame $frame.icons
label $frame.icons.lab -text "Icons "
combobox::combobox $frame.icons.cb -editable 0 -maxheight 10\
- -command [code $this change_icons]
+ -command [code $this _change_icons]
# get list of icon directories
set curdir [pwd]
- set icondirlist ""
+ set _icondirlist ""
cd $GDBTK_LIBRARY
foreach foo [glob -- *] {
if {[file isdirectory $foo] && [file exists [file join $foo "icons.txt"]]} {
- lappend icondirlist $foo
+ lappend _icondirlist $foo
}
}
set width 14
# load combobox
- set imagedir [pref get gdb/ImageDir]
- foreach dir $icondirlist {
- if {![string compare $dir $imagedir]} {
+ foreach dir $_icondirlist {
+ if {![string compare $dir $_saved(gdb/ImageDir)]} {
set cdir 1
} else {
set cdir 0
# to rescan the font list, without deleting the entry from the
# init file.
set font_cache [pref get gdb/font_cache]
+
+ # get list of fonts, removing some that typically
+ # are not useful or cause tk problems
+ set fam [lremove [font families] "open look glyph"]
+ set fam [lremove $fam "open look cursor"]
+ set fam [lremove $fam "song ti"]
+ set fam [lremove $fam "clearlyu"]
+ set fam [lremove $fam "clearlyu alternate glyphs"]
+ set fam [lremove $fam "clearlyu arabic extra"]
+ set fam [lremove $fam "clearlyu ligature"]
+ set fam [lremove $fam "clearlyu pua"]
+ set fam [lremove $fam "fangsong ti"]
+ set fam [lremove $fam "newspaper"]
+ set fam [lremove $fam "palatino linotype"]
+ set fam [lsort $fam]
+
if {$font_cache == ""} {
if {$tcl_platform(platform) == "unix"} {
toplevel .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 }
+ if {[winfo exists .c]} { destroy .c }
}
Labelledframe $frame.d -text "Fonts"
set f [$frame.d get_frame]
- make_font_item $f fixed "Fixed Font:" $font_cache
+ _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 menu "Menu Font:" $fam
}
- make_font_item $f default "Default Font:" [font families]
- make_font_item $f status "Status Bar Font:" [font families]
+ _make_font_item $f default "Default Font:" $fam
+ _make_font_item $f status "Status Bar Font:" $fam
# 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"
+ dbug E "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] \
+ checkbutton $frame.tracing.cb -variable [scope _new(gdb/mode)] \
-text $tracing_labels($tracing_cb) \
- -command [code $this toggle_tracing $frame.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
}
frame $frame.browser
checkbutton $frame.browser.cb \
- -text $help_text -variable [pref varname gdb/help/browser]
+ -text $help_text -variable [scope _new(gdb/help/browser)]
pack $frame.browser.cb -pady 10 -side left -fill none
# use_icons
if {$tcl_platform(platform) == "unix"} {
frame $frame.use_icons
checkbutton $frame.use_icons.cb \
- -text "Use builtin image as icon." -variable [pref varname gdb/use_icons]
+ -text "Use builtin image as icon." -variable [scope _new(gdb/use_icons)]
pack $frame.use_icons.cb -pady 10 -side left -fill none
}
# console wrap
frame $frame.consolewrap
checkbutton $frame.consolewrap.cw -text "wrap text in console window" \
- -variable [pref varname gdb/console/wrap]
+ -variable [scope _new(gdb/console/wrap)]
pack $frame.consolewrap.cw -pady 10 -side left -fill none
pack $frame.icons.lab $frame.icons.cb -side left
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]
+ 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
::update idletasks
- resize_font_item_height
+ _resize_font_item_height
pack propagate $itk_interior.f 0
}
# ------------------------------------------------------------------
-# PRIVATE METHOD: make_font_item
+# PRIVATE METHOD: _make_font_item
# ------------------------------------------------------------------
-body GlobalPref::make_font_item {f name label font_list} {
+body GlobalPref::_make_font_item {f name label font_list} {
# create ComboBox with font name
- lappend Fonts $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)
+ 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) \
+ combobox::combobox $f.${name}n -editable 0 -value $_original($name,family) \
-command [code $this _change_font $name]
foreach a $font_list {
-decrement [code $this _change_size down $name]
} {}
label $f.${name}l -text ABCDEFabcdef0123456789 -font test-$name-font
- set _size($name) $Original($name,size)
+ set _size($name) $_original($name,size)
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
+# PRIVATE METHOD: _resize_font_item_height
# ------------------------------------------------------------------
-body GlobalPref::resize_font_item_height {} {
- foreach font $Fonts {
+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
+# PRIVATE METHOD: _change_icons
# ------------------------------------------------------------------
-body GlobalPref::change_icons {w args} {
- global gdb_ImageDir GDBTK_LIBRARY
+body GlobalPref::_change_icons {w args} {
+ debug
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
+ set _new(gdb/ImageDir) [lindex $_icondirlist $index]
}
}
font configure test-$font-font -size $_size($font)
}
-# ------------------------------------------------------------------
-# 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)
+body GlobalPref::_toggle_tracing {win} {
+ debug
+ $win configure -text $tracing_labels($_new(gdb/mode))
}
# ------------------------------------------------------------------
-# METHOD: ok - called to accept settings and close dialog
+# METHOD: _ok - called to accept settings and close dialog
# ------------------------------------------------------------------
-body GlobalPref::ok {} {
- apply 1
+body GlobalPref::_ok {} {
+ _apply 1
}
# ------------------------------------------------------------------
-# METHOD: apply - apply current settings to the screen
+# METHOD: _apply - apply current settings to the screen
# ------------------------------------------------------------------
-body GlobalPref::apply {{deleteMe 0}} {
- set commands {}
+body GlobalPref::_apply {{deleteMe 0}} {
+ debug
+ set changed_something 0
# If you are not destroying the window, then make sure to
# propagate the geometry info from the font frame, so that changing
pack propagate $itk_interior.f 1
}
- foreach thunk $Fonts {
+ 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]
+ pref set global/font/$thunk $font
+ set changed_something 1
}
}
- if {[pref get gdb/mode] != $tracing_cb} {
- lappend commands toggle_tracing_mode
- }
+ foreach var [array names _new] {
+ if {$_new($var) != [pref get $var]} {
+ debug "$var = $_new($var)"
- if {[llength $commands] > 0} {
- foreach command $commands {
- eval $command
- }
- if {$deleteMe} {
- unpost
+ if {$var == "gdb/mode"} {
+ if {!$_new(gdb/mode)} { pref set gdb/B1_behavior 1 }
+ } elseif {$var == "gdb/ImageDir"} {
+ set ::gdb_ImageDir [file join $::GDBTK_LIBRARY $_new($var)]
+ }
+ pref set $var $_new($var)
+ set changed_something 1
}
+ }
+
+ if {$changed_something} {
+ if {$deleteMe} { unpost }
ManagedWin::restart
return
}
- if {$deleteMe} {
- unpost
+ if {$deleteMe} {
+ unpost
} else {
after idle "
update idletasks
- [code $this resize_font_item_height]
+ [code $this _resize_font_item_height]
pack propagate $itk_interior.f 0
"
}
}
# ------------------------------------------------------------------
-# METHOD: cancel - forget current settings -- reset to original
+# METHOD: _cancel - forget current settings -- reset to original
# state and close preferences
# ------------------------------------------------------------------
-body GlobalPref::cancel {} {
+body GlobalPref::_cancel {} {
+ debug
+ set changed_something 0
+
# Reset fonts if different
- set commands {}
- foreach thunk $Fonts {
+ 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 {$_original($thunk,family) != $family || $_original($thunk,size) != $size} {
+ pref set global/font/$thunk \
+ [list -family $_original($thunk,family) -size $_original($thunk,size)]
+ set changed_something 1
}
}
- if {[llength $commands] > 0} {
- foreach command $commands {
- eval $command
+ foreach var [array names _saved] {
+ if {$_saved($var) != [pref get $var]} {
+ debug "$var = $_saved($var)"
+
+ if {$var == "gdb/mode"} {
+ if {!$_saved(gdb/mode)} { pref set gdb/B1_behavior 1 }
+ } elseif {$var == "gdb/ImageDir"} {
+ set ::gdb_ImageDir [file join $::GDBTK_LIBRARY $_saved($var)]
+ }
+ pref set $var $_saved($var)
+ set changed_something 1
}
}
- if {[llength $commands] > 0} {
+
+ if {$changed_something} {
ManagedWin::restart
}
unpost
}
+
+# ------------------------------------------------------------------
+# METHOD: cancel - override modal dialog cancel method.
+# The cancel method is actually called when
+# the window is closed. Name needs fixed.
+# ------------------------------------------------------------------
+body GlobalPref::cancel {} {
+ # when the window is closed, we want the preferences selected to
+ # be applied.
+ _apply 1
+}
OSDN Git Service
