gdb/gdbtk/library/mempref.itb

   1 # Memory display preferences window for Insight.
   2 # Copyright (C) 1998, 1999, 2002, 2003, 2006 Red Hat
   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 #  METHOD:  constructor - build the dialog
  17 # ------------------------------------------------------------------
  18 itcl::body MemPref::constructor {args} {
  19
  20   window_name "Memory Preferences"
  21
  22   eval itk_initialize $args
  23
  24   if {$float_size == ""} {
  25     set float_size [gdb_eval sizeof(float)]
  26     set double_size [gdb_eval sizeof(double)]
  27   }
  28
  29   if {[string compare $format f] == 0} {
  30     set gformat x
  31     set format_disabled 1
  32     if {$size == $float_size} {
  33       set gsize 3
  34     } elseif {$size == $double_size} {
  35       set gsize 5
  36     }
  37   } else {
  38     set gsize $size
  39     set gformat $format
  40   }
  41
  42   set gnumbytes $numbytes
  43   set gbpr $bpr
  44   set gbprlist [list 4 8 16 32 64 128]
  45   set gascii $ascii
  46   set gascii_char $ascii_char
  47
  48   build_win
  49
  50   if {$format_disabled} {
  51     set format_disabled 0
  52     disable_format
  53   }
  54
  55   wm resizable [winfo toplevel $itk_interior] 0 0
  56 }
  57
  58 # ------------------------------------------------------------------
  59 #  METHOD:  destructor - destroy the dialog
  60 # ------------------------------------------------------------------
  61 itcl::body MemPref::destructor {} {
  62   trace vdelete [scope gnumbytes] w [code $this check_numbytes]
  63 }
  64
  65 # ------------------------------------------------------------------
  66 #  METHOD:  build_win - build the dialog
  67 # ------------------------------------------------------------------
  68 itcl::body MemPref::build_win {} {
  69
  70   frame $itk_interior.f
  71   set f [frame $itk_interior.f.a]
  72   frame $itk_interior.f.b
  73
  74   # SIZE
  75   Labelledframe $f.f1 -anchor nw -text Size
  76   set fr [$f.f1 get_frame]
  77
  78   set Widgets(rb-Byte) [radiobutton $fr.1 -variable [scope gsize] -text Byte \
  79                           -value 1 -command [code $this enable_format]]
  80   set Widgets(rb-half_word) [radiobutton $fr.2 -variable [scope gsize] -text "Half Word" \
  81                                -value 2 -command [code $this enable_format]]
  82   set Widgets(rb-word) [radiobutton $fr.4 -variable [scope gsize] -text Word \
  83                           -value 4 -command [code $this enable_format]]
  84   set Widgets(rb-d_word) [radiobutton $fr.8 -variable [scope gsize] -text "Double Word" \
  85                             -value 8 -command [code $this enable_format]]
  86   set Widgets(rb-float) [radiobutton $fr.f -variable [scope gsize] -text Float \
  87                            -value 3 -command [code $this disable_format]]
  88   set Widgets(rb-d_float) [radiobutton $fr.d -variable [scope gsize] -text "Double Float" \
  89                              -value 5 -command [code $this disable_format]]
  90   grid $fr.1 $fr.4 $fr.f -sticky w -padx 4
  91   grid $fr.2 $fr.8 $fr.d -sticky w -padx 4
  92
  93   # FORMAT
  94   Labelledframe $f.f2 -anchor nw -text Format
  95   set fr [$f.f2 get_frame]
  96   set Widgets(rb-binary) [radiobutton $fr.1 -variable [scope gformat] \
  97                             -text Binary -value t]
  98   set Widgets(rb-octal) [radiobutton $fr.2 -variable [scope gformat] \
  99                            -text Octal -value o]
 100   set Widgets(rb-hex) [radiobutton $fr.3 -variable [scope gformat] \
 101                          -text Hex -value x]
 102   set Widgets(rb-signed_dec) [radiobutton $fr.4 -variable [scope gformat] \
 103                                 -text "Signed Decimal" -value d]
 104   set Widgets(rb-unsign_dec) [radiobutton $fr.5 -variable [scope gformat] \
 105                                 -text "Unsigned Decimal" -value u]
 106
 107   grid $fr.1 $fr.2 $fr.3 -sticky w -padx 4
 108   grid $fr.4 $fr.5 x -sticky w -padx 4
 109
 110   # TOTAL BYTES
 111   Labelledframe $f.fx -anchor nw -text "Number of Bytes"
 112
 113   if {$gnumbytes == 0} {
 114     set gnumbytes $default_numbytes
 115     set gvar 0
 116   } else {
 117     set gvar 1
 118   }
 119
 120   set fr [$f.fx get_frame]
 121   set Widgets(rb-win_size) [radiobutton $fr.1 -variable [scope gvar] -text "Depends on window size" \
 122                               -value 0 -command [code $this toggle_size_control]]
 123   frame $fr.2
 124   set Widgets(rb-fixed) [radiobutton $fr.2.b -variable [scope gvar] -text Fixed \
 125                            -value 1 -command [code $this toggle_size_control]]
 126
 127   set old_numbytes $default_numbytes
 128   set Widgets(e-numbytes) [entry $fr.2.e -textvariable [scope gnumbytes] -width 3]
 129   set normal_background [$Widgets(e-numbytes) cget -background]
 130
 131   #
 132   # Trace gnumbytes so it will always be a +'ve integer...  Have to set this
 133   # trace AFTER the widget's textvariable is set so this trace will fire
 134   # BEFORE the widget's trace.
 135   #
 136
 137   trace variable [scope gnumbytes] w [code $this check_numbytes]
 138
 139   label $fr.2.l -text bytes
 140   grid $fr.2.b $fr.2.e $fr.2.l -sticky we
 141   grid $fr.1 x -sticky w -padx 4
 142   grid $fr.2 x -sticky w -padx 4
 143   grid columnconfigure $fr 1 -weight 1
 144
 145   # MISC
 146   Labelledframe $f.1 -anchor nw -text "Miscellaneous"
 147   set fr [$f.1 get_frame]
 148   frame $fr.1
 149   label $fr.1.plabel -height 1 -width 1 -bg $color -relief raised
 150   set Widgets(b-color) [button $fr.1.pc -text "Change color..."  \
 151                           -command [code $this pick $fr.1.plabel]]
 152   grid $fr.1.plabel $fr.1.pc
 153   frame $fr.2
 154   label $fr.2.l -text "Bytes Per Row "
 155   set Widgets(b-bytes_per_row) [::combobox::combobox $fr.2.c \
 156                                   -command [code $this set_bytes_per_row]  \
 157                                   -width 4 -editable 1 -font global/fixed \
 158                                   -bg $::Colors(textbg)]
 159   foreach item $gbprlist {
 160     $fr.2.c list insert end $item
 161   }
 162   $fr.2.c configure -value $gbpr
 163
 164   pack $fr.2.l -side left -anchor e
 165   pack $fr.2.c -side right
 166
 167   set Widgets(cb-display_ascii) [checkbutton $fr.3 -variable [scope gascii] -text "Display ASCII"]
 168   frame $fr.4
 169   set Widgets(e-ascii_char) [entry $fr.4.e -textvariable [scope gascii_char] -width 1]
 170   label $fr.4.l -text "Control Char"
 171   grid $fr.4.e $fr.4.l -sticky we
 172   grid $fr.2 x $fr.3 -sticky w -padx 4
 173   grid $fr.4 -sticky w -padx 4
 174   grid columnconfigure $fr 1 -weight 1
 175
 176   grid $f.f1 -padx 5 -pady 6 -sticky news
 177   grid $f.f2 -padx 5 -pady 6 -sticky news
 178   grid $f.fx -padx 5 -pady 6 -sticky news
 179   grid $f.1 -padx 5 -pady 6 -sticky we
 180
 181
 182   set Widgets(b-ok) [button $itk_interior.f.b.ok -text OK -command [code $this ok] -width 7 -default active]
 183   focus $Widgets(b-ok)
 184
 185   # If there is an OK button, set Return in the entry field to invoke it...
 186
 187   bind $Widgets(e-numbytes) <KeyPress-Return> "$Widgets(b-ok) flash ; $Widgets(b-ok) invoke"
 188
 189   set Widgets(b-cancel) [button $itk_interior.f.b.quit -text Cancel -command [code $this cancel] -width 7]
 190   set Widgets(b-apply) [button $itk_interior.f.b.apply -text Apply -command [code $this apply] -width 7]
 191   standard_button_box $itk_interior.f.b
 192
 193   grid $itk_interior.f.a
 194   grid $itk_interior.f.b -sticky news
 195   grid $itk_interior.f
 196
 197   #
 198   # Set the state of the window size entry here...
 199   #
 200   toggle_size_control
 201
 202 }
 203
 204 # ------------------------------------------------------------------
 205 #  METHOD:  busy - make the widget unusable
 206 # ------------------------------------------------------------------
 207 itcl::body MemPref::busy {} {
 208   set top [winfo toplevel $itk_interior]
 209   $top configure -cursor watch
 210
 211   # Disable all the radiobuttons and what not
 212   foreach w [array names Widgets] {
 213     set WidgetState($w) [$Widgets($w) cget -state]
 214   }
 215   foreach w [array names Widgets] {
 216     $Widgets($w) configure -state disabled
 217   }
 218 }
 219
 220 # ------------------------------------------------------------------
 221 #  METHOD:  idle - make the widget useable
 222 # ------------------------------------------------------------------
 223 itcl::body MemPref::idle {} {
 224   set top [winfo toplevel $itk_interior]
 225   $top configure -cursor {}
 226
 227   # Re-enable all widgets
 228   foreach w [array names Widgets] {
 229     $Widgets($w) configure -state $WidgetState($w)
 230   }
 231 }
 232 # ------------------------------------------------------------------
 233 #  METHOD:  ok - apply and quit
 234 # ------------------------------------------------------------------
 235 itcl::body MemPref::ok {} {
 236   apply
 237   unpost
 238 }
 239
 240 # ------------------------------------------------------------------
 241 #  METHOD:  cancel - just close the dialog w/o saving changes
 242 # ------------------------------------------------------------------
 243 itcl::body MemPref::cancel {} {
 244   unpost
 245 }
 246
 247 # ------------------------------------------------------------------
 248 #  METHOD:  check_numbytes - a trace to make sure gnumbytes is an int > 0
 249 # ------------------------------------------------------------------
 250 itcl::body MemPref::check_numbytes {var index mode} {
 251   upvar \#0 $var true
 252   if {($true != "") && ([catch {expr {(int($true) != double($true)) || $true <= 0}} val]
 253                         || $val)} {
 254     bell
 255     set true $old_numbytes
 256   } else {
 257     set old_numbytes $true
 258   }
 259 }
 260
 261 # ------------------------------------------------------------------
 262 #  METHOD:  set_bytes_per_row - combobox callback to set the bytes per row
 263 # ------------------------------------------------------------------
 264 itcl::body MemPref::set_bytes_per_row {w value} {
 265   if {[string is integer -strict $value] && [expr {$value != 0}]} {
 266     # The input is a value number.
 267     set gbpr $value
 268     set gbpr [string trim $gbpr]
 269
 270     # Too high a number will cause a Segmentation fault.
 271     if {[expr {$gbpr > 150}]} {set gbpr 150}
 272
 273     # Insert the value into the combo box list, if it isn't there already.
 274     set found [lsearch $gbprlist $gbpr]
 275
 276     if {$found == -1} {
 277       lappend gbprlist $gbpr
 278       $Widgets(b-bytes_per_row) list insert end $gbpr
 279     }
 280
 281     set s $gsize
 282     if {$s == 3} {set s 4}
 283     if {$s == 5} {set s 8}
 284     set rem [expr {$gbpr % $s}]
 285     if {$rem != 0} {
 286       # The bytes-per-row is not a multiple of the size.
 287       set gbpr [expr {$gbpr + ($s - $rem)}]
 288     }
 289   }
 290
 291   # Set the display to the new value. This may be different if the input
 292   # was zero or not a number, or if the user entered any whitespace.
 293   $Widgets(b-bytes_per_row) delete 0 end
 294   $Widgets(b-bytes_per_row) insert end $gbpr
 295 }
 296
 297 # ------------------------------------------------------------------
 298 #  METHOD:  toggle_size_control - toggle the state of the entry box as the
 299 #           control method changes
 300 # ------------------------------------------------------------------
 301 itcl::body MemPref::toggle_size_control {} {
 302
 303   if {$gvar} {
 304     $Widgets(e-numbytes) configure -state normal \
 305       -background $normal_background
 306   } else {
 307     $Widgets(e-numbytes) configure -state disabled -background lightgray
 308     if {[info exists Widgets(b-ok)]} {
 309       focus $Widgets(b-ok)
 310     }
 311   }
 312 }
 313
 314 # ------------------------------------------------------------------
 315 #  METHOD:  apply - apply changes to the parent window
 316 # ------------------------------------------------------------------
 317 itcl::body MemPref::apply {} {
 318
 319   busy
 320   gdbtk_busy
 321
 322   if {$gvar == 0} {
 323     set numbytes 0
 324   } elseif {$gnumbytes == "" || $gnumbytes == 0} {
 325     # Protect against the case where someone sets the
 326     # entry field to an empty string, or pastes in a 0...
 327     bell
 328     set gnumbytes $default_numbytes
 329     set numbytes $gnumbytes
 330   } else {
 331     set numbytes $gnumbytes
 332   }
 333   switch $gsize {
 334     3 {
 335       set size $float_size
 336       set format f
 337     }
 338     5 {
 339       set size $double_size
 340       set format f
 341     }
 342     default {
 343       set size $gsize
 344       set format $gformat
 345     }
 346   }
 347
 348   # Ensure the value has been read from the text field.
 349   set_bytes_per_row "" [$Widgets(b-bytes_per_row) get]
 350
 351   # pass all the changed values back to parent
 352   debug "$win configChange -size $size -numbytes $numbytes \
 353              -format $format -ascii $gascii \
 354              -ascii_char $gascii_char -bytes_per_row $gbpr \
 355              -color $color"
 356   eval $win configure -size $size -numbytes $numbytes \
 357     -format $format -ascii $gascii \
 358     -ascii_char $gascii_char -bytes_per_row $gbpr \
 359     -color $color
 360
 361   $win reconfig
 362
 363   gdbtk_idle
 364   idle
 365 }
 366
 367 # ------------------------------------------------------------------
 368 #  METHOD:  enable_format - turn on the format radio buttons
 369 # ------------------------------------------------------------------
 370 itcl::body MemPref::enable_format {} {
 371   # First ensure bytes per row is a multiple of the size.
 372   # Use the value of the widget, not $gbpr to ensure the typed value is kept.
 373   set_bytes_per_row "" [$Widgets(b-bytes_per_row) get]
 374
 375   if {!$format_disabled} {
 376     return
 377   }
 378
 379   foreach widget {rb-binary rb-octal rb-hex rb-signed_dec rb-unsign_dec} {
 380     $Widgets($widget) configure -state normal
 381   }
 382   set format_disabled 0
 383 }
 384
 385
 386 # ------------------------------------------------------------------
 387 #  METHOD:  disable_format - turn off the format radio buttons
 388 # ------------------------------------------------------------------
 389 itcl::body MemPref::disable_format {} {
 390   # First ensure bytes per row is a multiple of the size.
 391   # Use the value of the widget, not $gbpr to ensure the typed value is kept.
 392   set_bytes_per_row "" [$Widgets(b-bytes_per_row) get]
 393
 394   if {$format_disabled} {
 395     return
 396   }
 397
 398   foreach widget {rb-binary rb-octal rb-hex rb-signed_dec rb-unsign_dec} {
 399     $Widgets($widget) configure -state disabled
 400   }
 401   set format_disabled 1
 402 }
 403
 404 # ------------------------------------------------------------------
 405 #  METHOD:  pick - pick colors
 406 # ------------------------------------------------------------------
 407 itcl::body MemPref::pick {lab} {
 408   set new_color [tk_chooseColor -initialcolor $color -title "Choose color"]
 409   if {$new_color != $color && $new_color != ""} {
 410     set color $new_color
 411     $lab configure -bg $color
 412   }
 413 }
 414
 415
 416 # ------------------------------------------------------------------
 417 #  METHOD:  reconfig - used when preferences change
 418 # ------------------------------------------------------------------
 419 itcl::body MemPref::reconfig {} {
 420   # for now, just delete and recreate
 421   destroy $itk_interior.f
 422   build_win
 423 }
 424