diff options
Diffstat (limited to 'gdb/gdbtk/library/globalpref.itb')
| -rw-r--r-- | gdb/gdbtk/library/globalpref.itb | 408 |
1 files changed, 0 insertions, 408 deletions
diff --git a/gdb/gdbtk/library/globalpref.itb b/gdb/gdbtk/library/globalpref.itb deleted file mode 100644 index a7eb809864e..00000000000 --- a/gdb/gdbtk/library/globalpref.itb +++ /dev/null @@ -1,408 +0,0 @@ -# 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 -} |