URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtcl/] [globalpref.itb] - Blame information for rev 1765

Details | Compare with Previous | View Log


# 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 {
 
    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 curdir [pwd]
  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
      dbug E "couldn't open $foo:$fid"
      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
  cd $curdir
 
  # 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  \
    "$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
}

Line No.	Rev	Author	Line
1	578	markom	`# Global preference class implementation for GDBtk.`
2			`# Copyright 1997, 1998, 1999 Cygnus Solutions`
3			`#`
4			`# This program is free software; you can redistribute it and/or modify it`
5			`# under the terms of the GNU General Public License (GPL) as published by`
6			`# the Free Software Foundation; either version 2 of the License, or (at`
7			`# your option) any later version.`
8			`#`
9			`# This program is distributed in the hope that it will be useful,`
10			`# but WITHOUT ANY WARRANTY; without even the implied warranty of`
11			`# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
12			`# GNU General Public License for more details.`
13
14
15			`# ----------------------------------------------------------------------`
16			`# Implements Global preferences dialog`
17			`#`
18			`# ----------------------------------------------------------------------`
19
20			`# ------------------------------------------------------------------`
21			`# PROC: _init - set up the tracing labels info`
22			`# ------------------------------------------------------------------`
23			`body GlobalPref::_init {} {`
24			`if {$inited} {`
25			`return`
26			`}`
27
28			`set inited 1`
29
30			`array set tracing_labels {`
31
32			`1 "Tracing features enabled"`
33			`max_len 0`
34			`}`
35
36			`foreach elem [array names tracing_labels] {`
37			`set len [string length $tracing_labels($elem)]`
38			`set tracing_labels(max_len) \`
39			`[expr $len > $tracing_labels(max_len) ? $len : $tracing_labels(max_len) ]`
40			`}`
41			`}`
42
43			`# ------------------------------------------------------------------`
44			`# METHOD: constructor - create the Global Preferences object`
45			`# ------------------------------------------------------------------`
46			`body GlobalPref::constructor {args} {`
47			`window_name "Global Preferences"`
48			`_init`
49			`build_win`
50			`eval itk_initialize $args`
51			`}`
52
53			`# ------------------------------------------------------------------`
54			`# METHOD: destructor - destroy the Global Preferences object`
55			`# ------------------------------------------------------------------`
56			`body GlobalPref::destructor {} {`
57			`foreach thunk $Fonts {`
58			`font delete test-$thunk-font`
59			`}`
60			`}`
61
62			`# ------------------------------------------------------------------`
63			`# METHOD: build_win - build the dialog`
64			`# ------------------------------------------------------------------`
65			`body GlobalPref::build_win {} {`
66			`global tcl_platform GDBTK_LIBRARY`
67			`debug`
68			`frame $itk_interior.f`
69			`frame $itk_interior.x`
70			`set frame $itk_interior.f`
71
72			`# Icons`
73			`frame $frame.icons`
74			`label $frame.icons.lab -text "Icons "`
75			`combobox::combobox $frame.icons.cb -editable 0 -maxheight 10\`
76			`-command [code $this change_icons]`
77
78			`# get list of icon directories`
79			`set curdir [pwd]`
80			`set icondirlist ""`
81			`cd $GDBTK_LIBRARY`
82			`foreach foo [glob -- *] {`
83			`if {[file isdirectory $foo] && [file exists [file join $foo "icons.txt"]]} {`
84			`lappend icondirlist $foo`
85			`}`
86			`}`
87
88			`set width 14`
89			`# load combobox`
90			`set imagedir [pref get gdb/ImageDir]`
91			`foreach dir $icondirlist {`
92			`if {![string compare $dir $imagedir]} {`
93			`set cdir 1`
94			`} else {`
95			`set cdir 0`
96			`}`
97			`set foo [file join $dir "icons.txt"]`
98			`if {[catch {::open $foo r} fid]} {`
99			`# failed`
100			`dbug E "couldn't open $foo:$fid"`
101			`if {$cdir} {$frame.icons.cb entryset "unknown icons"}`
102			`$frame.icons.cb list insert end "unknown icons"`
103			`} else {`
104			`if {[gets $fid txt] >= 0} {`
105			`if {$cdir} {$frame.icons.cb entryset $txt}`
106			`if {[string length $txt] > $width} {set width [string length $txt]}`
107			`$frame.icons.cb list insert end $txt`
108			`} else {`
109			`if {$cdir} {$frame.icons.cb entryset "unknown icons"}`
110			`$frame.icons.cb list insert end "unknown icons"`
111			`}`
112			`close $fid`
113			`}`
114			`}`
115			`$frame.icons.cb configure -width $width`
116			`cd $curdir`
117
118			`# searching for fixed font families take a long time`
119			`# therefore, we cache the font names. The font cache`
120			`# can be saved in the init file. A way should be provided`
121			`# to rescan the font list, without deleting the entry from the`
122			`# init file.`
123			`set font_cache [pref get gdb/font_cache]`
124			`if {$font_cache == ""} {`
125			`if {$tcl_platform(platform) == "unix"} {`
126			`toplevel .c`
127			`wm title .c "Scanning for fonts"`
128			`message .c.m -width 3i -text "Scanning system for fonts\n\nPlease wait..." \`
129			`-relief flat -padx 30 -pady 30 \`
130			`-bg [pref get gdb/global_prefs/message_bg] \`
131			`-fg [pref get gdb/global_prefs/message_fg]`
132			`::update`
133			`pack .c.m`
134			`focus .c`
135			`::raise .c`
136			`::update`
137			`}`
138			`set fam [font families]`
139			`foreach fn $fam {`
140			`if {[font metrics [list $fn] -fixed] == 1} {`
141			`lappend font_cache $fn`
142			`}`
143			`}`
144			`pref set gdb/font_cache $font_cache`
145			`if {$tcl_platform(platform) == "unix"} { destroy .c }`
146			`}`
147
148			`Labelledframe $frame.d -text "Fonts"`
149			`set f [$frame.d get_frame]`
150
151			`make_font_item $f fixed "Fixed Font:" $font_cache`
152
153			`if {$tcl_platform(platform) != "windows"} {`
154			`# Cannot change the windows menu font ourselves`
155			`make_font_item $f menu "Menu Font:" [font families]`
156			`}`
157
158			`make_font_item $f default "Default Font:" [font families]`
159			`make_font_item $f status "Status Bar Font:" [font families]`
160
161			`# This is the tracing preference`
162			`set tracing_cb [pref get gdb/mode]`
163			`if { ![info exists tracing_labels($tracing_cb)]} {`
164			`debug "Got unknown mode value: $tracing_cb"`
165			`set tracing_labels($tracing_cb) "Unknown gdb mode..."`
166			`}`
167
168			`frame $frame.tracing`
169			`checkbutton $frame.tracing.cb -variable [scope tracing_cb] \`
170			`-text $tracing_labels($tracing_cb) \`
171			`-command [code $this toggle_tracing $frame.tracing.cb] \`
172			`-width $tracing_labels(max_len) -anchor w`
173			`pack $frame.tracing.cb -pady 10 -side left -fill none`
174
175			`# help browser preferences`
176			`if {$tcl_platform(platform) == "windows"} {`
177			`set help_text "Use Internet Browser to View Help Files"`
178			`} else {`
179			`set help_text "Use Netscape to View Help Files"`
180			`}`
181			`frame $frame.browser`
182			`checkbutton $frame.browser.cb \`
183			`-text $help_text -variable [pref varname gdb/help/browser]`
184			`pack $frame.browser.cb -pady 10 -side left -fill none`
185
186			`# use_icons`
187			`if {$tcl_platform(platform) == "unix"} {`
188			`frame $frame.use_icons`
189			`checkbutton $frame.use_icons.cb \`
190			`-text "Use builtin image as icon." -variable [pref varname gdb/use_icons]`
191			`pack $frame.use_icons.cb -pady 10 -side left -fill none`
192			`}`
193
194			`# console wrap`
195			`frame $frame.consolewrap`
196			`checkbutton $frame.consolewrap.cw -text "wrap text in console window" \`
197			`-variable [pref varname gdb/console/wrap]`
198			`pack $frame.consolewrap.cw -pady 10 -side left -fill none`
199
200			`pack $frame.icons.lab $frame.icons.cb -side left`
201			`pack $frame.icons -side top -padx 10 -pady 10`
202			`pack $frame.tracing -side top -fill x -expand 0 -side bottom`
203			`pack $frame.browser -side top -fill x -expand 0 -side bottom`
204			`if {$tcl_platform(platform) == "unix"} {`
205			`pack $frame.use_icons -side top -fill x -expand 0 -side bottom`
206			`}`
207			`pack $frame.consolewrap -side top -fill x -expand 0 -side bottom`
208			`pack $frame.d -side top -fill both -expand yes`
209
210			`# make buttons`
211			`button $itk_interior.x.ok -text OK -underline 0 -width 7 -command [code $this ok]`
212			`button $itk_interior.x.apply -text Apply -width 7 -underline 0 -command [code $this apply]`
213			`button $itk_interior.x.cancel -text Cancel -width 7 -underline 0 -command [code $this cancel]`
214			`pack $itk_interior.x.ok $itk_interior.x.apply $itk_interior.x.cancel -side left`
215			`standard_button_box $itk_interior.x`
216			`pack $itk_interior.x -fill x -padx 5 -pady 5 -side bottom`
217
218
219			`pack $itk_interior.f -fill both -expand yes -padx 10 -pady 5`
220
221			`bind $itk_interior.x.ok \`
222			`"$itk_interior.x.ok flash; $itk_interior.x.ok invoke"`
223			`focus $itk_interior.x.ok`
224
225			`# We don't want the window flashing around as we change the fonts...`
226
227			`::update idletasks`
228
229			`resize_font_item_height`
230			`pack propagate $itk_interior.f 0`
231
232			`}`
233			`# ------------------------------------------------------------------`
234			`# PRIVATE METHOD: make_font_item`
235			`# ------------------------------------------------------------------`
236			`body GlobalPref::make_font_item {f name label font_list} {`
237
238			`# create ComboBox with font name`
239			`lappend Fonts $name`
240
241			`set Original($name,family) [font actual global/$name -family]`
242			`set Original($name,size) [font actual global/$name -size]`
243			`font create test-$name-font -family $Original($name,family) \`
244			`-size $Original($name,size)`
245			`label $f.${name}x -text $label`
246
247			`combobox::combobox $f.${name}n -editable 0 -value $Original($name,family) \`
248			`-command [code $this wfont_changed family $name]`
249
250			`foreach a $font_list {`
251			`$f.${name}n list insert end $a`
252			`}`
253
254			`tixControl $f.${name}s -label Size: -integer true -max 18 -min 6 \`
255			`-value $Original(${name},size) -command [code $this font_changed size $name]`
256			`[$f.${name}s subwidget entry] configure -width 2`
257			`label $f.${name}l -text ABCDEFabcdef0123456789 -font test-$name-font`
258
259			`grid $f.${name}x $f.${name}n $f.${name}s $f.${name}l -sticky we -padx 5 -pady 5`
260			`grid columnconfigure $f 3 -weight 1`
261
262			`}`
263
264			`# ------------------------------------------------------------------`
265			`# PRIVATE METHOD: resize_font_item_height`
266			`# ------------------------------------------------------------------`
267			`body GlobalPref::resize_font_item_height {} {`
268			`foreach font $Fonts {`
269			`set master [$itk_interior.f.d get_frame]`
270			`set row [gridCGet $master.${font}l -row]`
271			`grid rowconfigure $master $row -minsize [lindex [grid bbox $master 0 $row 3 $row ] 3]`
272			`}`
273			`}`
274
275			`# ------------------------------------------------------------------`
276			`# PRIVATE METHOD: change_icons`
277			`# ------------------------------------------------------------------`
278			`body GlobalPref::change_icons {w args} {`
279			`global gdb_ImageDir GDBTK_LIBRARY`
280			`set index [$w list curselection]`
281			`if {$index != ""} {`
282			`set dir [lindex $icondirlist $index]`
283			`pref set gdb/ImageDir $dir`
284			`set gdb_ImageDir [file join $GDBTK_LIBRARY $dir]`
285			`ManagedWin::restart`
286			`}`
287			`}`
288
289			`# ------------------------------------------------------------------`
290			`# PRIVATE METHOD: wfont_changed - callback from font comboboxes`
291			`# PRIVATE METHOD: font_changed - callback from font tixControls`
292			`# ------------------------------------------------------------------`
293			`body GlobalPref::wfont_changed {attribute font w val} {`
294			`font_changed $attribute $font $val`
295			`}`
296
297			`body GlobalPref::font_changed {attribute font val} {`
298			`# val will be a size or a font name`
299
300			`switch $attribute {`
301			`size {`
302			`set oldval [font configure test-$font-font -size]`
303			`font configure test-$font-font -size $val`
304			`}`
305
306			`family {`
307			`set oldval [font configure test-$font-font -family]`
308			`font configure test-$font-font -family $val`
309			`}`
310
311			`default { debug "GlobalPref::font_changed -- invalid change" }`
312			`}`
313			`}`
314
315			`# ------------------------------------------------------------------`
316			`# METHOD: toggle_tracing_mode - toggles the tracing mode on and off`
317			`# ------------------------------------------------------------------`
318			`body GlobalPref::toggle_tracing_mode {} {`
319			`pref set gdb/mode $tracing_cb`
320			`# Reset the button-1 behavior if you are going out of trace mode.`
321			`if {!$tracing_cb} {`
322			`pref set gdb/B1_behavior 1`
323			`}`
324			`}`
325
326			`body GlobalPref::toggle_tracing {win} {`
327			`debug foo`
328			`$win configure -text $tracing_labels($tracing_cb)`
329			`}`
330
331			`# ------------------------------------------------------------------`
332			`# METHOD: ok - called to accept settings and close dialog`
333			`# ------------------------------------------------------------------`
334			`body GlobalPref::ok {} {`
335			`apply 1`
336			`}`
337
338			`# ------------------------------------------------------------------`
339			`# METHOD: apply - apply current settings to the screen`
340			`# ------------------------------------------------------------------`
341			`body GlobalPref::apply {{deleteMe 0}} {`
342			`set commands {}`
343
344			`# If you are not destroying the window, then make sure to`
345			`# propagate the geometry info from the font frame, so that changing`
346			`# the fonts IN the window don't cause some of the buttons to`
347			`# get obscured...`
348
349			`if {!$deleteMe} {`
350			`pack propagate $itk_interior.f 1`
351			`}`
352
353			`foreach thunk $Fonts {`
354			`set font [font configure test-$thunk-font]`
355			`if {[pref get global/font/$thunk] != $font} {`
356			`lappend commands [list pref set global/font/$thunk $font]`
357			`}`
358			`}`
359
360			`if {[pref get gdb/mode] != $tracing_cb} {`
361			`lappend commands toggle_tracing_mode`
362			`}`
363
364			`if {[llength $commands] > 0} {`
365			`foreach command $commands {`
366			`eval $command`
367			`}`
368			`if {$deleteMe} {`
369			`unpost`
370			`}`
371			`ManagedWin::restart`
372			`return`
373			`}`
374			`if {$deleteMe} {`
375			`unpost`
376			`} else {`
377			`after idle "`
378			`update idletasks`
379			`[code $this resize_font_item_height]`
380			`pack propagate $itk_interior.f 0`
381			`"`
382			`}`
383			`}`
384
385			`# ------------------------------------------------------------------`
386			`# METHOD: cancel - forget current settings -- reset to original`
387			`# state and close preferences`
388			`# ------------------------------------------------------------------`
389			`body GlobalPref::cancel {} {`
390			`# Reset fonts if different`
391			`set commands {}`
392			`foreach thunk $Fonts {`
393			`set family [font configure global/$thunk -family]`
394			`set size [font configure global/$thunk -size]`
395			`if {$Original($thunk,family) != $family \|\| $Original($thunk,size) != $size} {`
396			`lappend commands [list pref set global/font/$thunk \`
397			`[list -family $Original($thunk,family) -size $Original($thunk,size)]]`
398			`}`
399			`}`
400
401			`if {[llength $commands] > 0} {`
402			`foreach command $commands {`
403			`eval $command`
404			`}`
405			`}`
406			`if {[llength $commands] > 0} {`
407			`ManagedWin::restart`
408			`}`
409			`unpost`
410			`}`

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtcl/] [globalpref.itb] - Blame information for rev 1765