gdb/gdbtk/library/variables.tcl

   1 # Variable display window 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 variable windows for gdb. LocalsWin and WatchWin both
  17 # inherit from this class. You need only override the method
  18 # 'getVariablesBlankPath' and a few other things...
  19 # ----------------------------------------------------------------------
  20
  21 class VariableWin {
  22     inherit EmbeddedWin GDBWin
  23     protected variable Sizebox 1
  24
  25     # ------------------------------------------------------------------
  26     #  CONSTRUCTOR - create new watch window
  27     # ------------------------------------------------------------------
  28     constructor {args} {
  29         #
  30         #  Create a window with the same name as this object
  31         #
  32         gdbtk_busy
  33         set _queue [Queue \#auto]
  34         build_win $itk_interior
  35         gdbtk_idle
  36
  37         add_hook gdb_update_hook "$this update"
  38         add_hook gdb_busy_hook "$this disable_ui"
  39         add_hook gdb_no_inferior_hook "$this no_inferior"
  40         add_hook gdb_idle_hook [list $this idle]
  41         add_hook gdb_clear_file_hook [code $this clear_file]
  42     }
  43
  44     # ------------------------------------------------------------------
  45     #  METHOD:  build_win - build the watch window
  46     # ------------------------------------------------------------------
  47     method build_win {f} {
  48         global tixOption tcl_platform Display
  49         #    debug "VariableWin::build_win"
  50         set width [font measure src-font "W"]
  51         # Choose the default width to be...
  52         set width [expr {40 * $width}]
  53         if {$tcl_platform(platform) == "windows"} {
  54             set scrollmode both
  55         } else {
  56             set scrollmode auto
  57         }
  58
  59         debug "tree=$f.tree"
  60         set Tree [tixTree $f.tree        \
  61                       -opencmd  "$this open"  \
  62                       -closecmd "$this close" \
  63                       -ignoreinvoke 1         \
  64                       -width $width           \
  65                       -browsecmd [list $this selectionChanged] \
  66                       -scrollbar $scrollmode \
  67                       -sizebox $Sizebox]
  68         if {![pref get gdb/mode]} {
  69             $Tree configure -command [list $this editEntry]
  70         }
  71         set Hlist [$Tree subwidget hlist]
  72
  73         # FIXME: probably should use columns instead.
  74         $Hlist configure -header 1
  75
  76         set l [expr {$EntryLength - $Length - [string length "Name"]}]
  77         # Ok, this is as hack as it gets
  78         set blank "                                                                                                                                                             "
  79         $Hlist header create 0 -itemtype text \
  80             -text "Name[string range $blank 0 $l]Value"
  81
  82         # Configure the look of the tree
  83         set sbg [$Hlist cget -bg]
  84         set fg [$Hlist cget -fg]
  85         set bg $tixOption(input1_bg)
  86         set width [font measure src-font $LengthString]
  87         $Hlist configure -indent $width -bg $bg \
  88             -selectforeground $fg -selectbackground $sbg \
  89             -selectborderwidth 0 -separator . -font src-font
  90
  91         # Get display styles
  92         set normal_fg    [$Hlist cget -fg]
  93         set highlight_fg [pref get gdb/variable/highlight_fg]
  94         set disabled_fg  [pref get gdb/variable/disabled_fg]
  95         set NormalTextStyle [tixDisplayStyle text -refwindow $Hlist \
  96                                  -bg $bg -fg $normal_fg -font src-font]
  97         set HighlightTextStyle [tixDisplayStyle text -refwindow $Hlist \
  98                                     -bg $bg -fg $highlight_fg -font src-font]
  99         set DisabledTextStyle [tixDisplayStyle text -refwindow $Hlist \
 100                                    -bg $bg -fg $disabled_fg -font src-font]
 101
 102         if {[catch {gdb_cmd "show output-radix"} msg]} {
 103             set Radix 10
 104         } else {
 105             regexp {[0-9]+} $msg Radix
 106         }
 107
 108
 109         # Update the tree display
 110         update
 111         pack $Tree -expand yes -fill both
 112
 113         # Create the popup menu for this widget
 114         bind $Hlist <3> "$this postMenu %X %Y"
 115         bind $Hlist <KeyPress-space> [code $this toggleView]
 116
 117         # Do not use the tixPopup widget...
 118         set Popup [menu $f.menu -tearoff 0]
 119         set disabled_foreground [$Popup cget -foreground]
 120         $Popup configure -disabledforeground $disabled_foreground
 121         set ViewMenu [menu $Popup.view]
 122
 123         # Populate the view menu
 124         $ViewMenu add radiobutton -label "Hex" -variable Display($this) \
 125             -value hexadecimal
 126         $ViewMenu add radiobutton -label "Decimal" -variable Display($this) \
 127             -value decimal
 128         $ViewMenu add radiobutton -label "Binary" -variable Display($this) \
 129             -value binary
 130         $ViewMenu add radiobutton -label "Octal" -variable Display($this) \
 131             -value octal
 132         $ViewMenu add radiobutton -label "Natural" -variable Display($this) \
 133             -value natural
 134
 135         $Popup add command -label "dummy" -state disabled
 136         $Popup add separator
 137         $Popup add cascade -label "Format" -menu $ViewMenu
 138         #    $Popup add checkbutton -label "Auto Update"
 139         #    $Popup add command -label "Update Now"
 140         if {![pref get gdb/mode]} {
 141             $Popup add command -label "Edit"
 142         }
 143
 144         # Make sure to update menu info.
 145         selectionChanged ""
 146
 147         window_name "Local Variables" "Locals"
 148     }
 149
 150     # ------------------------------------------------------------------
 151     #  DESTRUCTOR - destroy window containing widget
 152     # ------------------------------------------------------------------
 153     destructor {
 154         #    debug "VariableWin::destructor"
 155         # Make sure to clean up the frame
 156         catch {destroy $_frame}
 157
 158         # Delete the display styles used with this window
 159         destroy $NormalTextStyle
 160         destroy $HighlightTextStyle
 161         destroy $DisabledTextStyle
 162
 163         # Remove this window and all hooks
 164         remove_hook gdb_update_hook "$this update"
 165         remove_hook gdb_busy_hook "$this disable_ui"
 166         remove_hook gdb_no_inferior_hook "$this no_inferior"
 167         remove_hook gdb_idle_hook [list $this idle]
 168         remove_hook gdb_clear_file_hook [code $this clear_file]
 169     }
 170
 171     # ------------------------------------------------------------------
 172     #  METHOD:  clear_file - Clear out state and prepare for loading
 173     #              a new executable.
 174     # ------------------------------------------------------------------
 175     method clear_file {} {
 176         no_inferior
 177     }
 178
 179     # ------------------------------------------------------------------
 180     #  METHOD:  reconfig - used when preferences change
 181     # ------------------------------------------------------------------
 182     method reconfig {} {
 183         #    debug "VariableWin::reconfig"
 184         foreach win [winfo children $itk_interior] {
 185             destroy $win
 186         }
 187
 188         build_win $itk_interior
 189     }
 190
 191     # ------------------------------------------------------------------
 192     #  METHOD:  build_menu_helper - Create the menu for a subclass.
 193     # ------------------------------------------------------------------
 194     method build_menu_helper {first} {
 195         global Display
 196         menu [namespace tail $this].mmenu
 197
 198         [namespace tail $this].mmenu add cascade -label $first -underline 0 -menu [namespace tail $this].mmenu.var
 199
 200         menu [namespace tail $this].mmenu.var
 201         if {![pref get gdb/mode]} {
 202             [namespace tail $this].mmenu.var add command -label Edit -underline 0 -state disabled \
 203                 -command [format {
 204                     %s editEntry [%s getSelection]
 205                 } $this $this]
 206         }
 207         [namespace tail $this].mmenu.var add cascade -label Format -underline 0 \
 208             -menu [namespace tail $this].mmenu.var.format
 209
 210         menu [namespace tail $this].mmenu.var.format
 211         foreach label {Hex Decimal Binary Octal Natural} fmt {hexadecimal decimal binary octal natural} {
 212             [namespace tail $this].mmenu.var.format add radiobutton \
 213                 -label $label -underline 0 \
 214                 -value $fmt -variable Display($this) \
 215                 -command [format {
 216                     %s setDisplay [%s getSelection] %s
 217                 } $this $this $fmt]
 218         }
 219
 220         #    [namespace tail $this].mmenu add cascade -label Update -underline 0 -menu [namespace tail $this].mmenu.update
 221         #    menu [namespace tail $this].mmenu.update
 222
 223         # The -variable is set when a selection is made in the tree.
 224         #    [namespace tail $this].mmenu.update add checkbutton -label "Auto Update" -underline 0 \
 225             #      -command [format {
 226         #       %s toggleUpdate [%s getSelection]
 227         #      } $this $this]
 228         #    [namespace tail $this].mmenu.update add command -label "Update Now" -underline 0 \
 229             #      -accelerator "Ctrl+U" -command [format {
 230         #       %s updateNow [%s getSelection]
 231         #      } $this $this]
 232
 233         set top [winfo toplevel [namespace tail $this]]
 234         $top configure -menu [namespace tail $this].mmenu
 235         bind_plain_key $top Control-u [format {
 236             if {!$Running} {
 237                 if {[%s getSelection] != ""} {
 238                     %s updateNow [%s getSelection]
 239                 }
 240             }
 241         } $this $this $this]
 242
 243         return [namespace tail $this].mmenu.var
 244     }
 245
 246     # Return the current selection, or the empty string if none.
 247     method getSelection {} {
 248         return [$Hlist info selection]
 249     }
 250
 251     # This is called when a selection is made.  It updates the main
 252     # menu.
 253     method selectionChanged {variable} {
 254         global Display
 255
 256         if {$Running} {
 257             # Clear the selection, too
 258             $Hlist selection clear
 259             return
 260         }
 261
 262         # if something is being edited, cancel it
 263         if {[info exists EditEntry]} {
 264             UnEdit
 265         }
 266
 267         if {$variable == ""} {
 268             set state disabled
 269         } else {
 270             set state normal
 271         }
 272
 273         foreach menu [list [namespace tail $this].mmenu.var [namespace tail $this].mmenu.var.format ] {
 274             set i [$menu index last]
 275             while {$i >= 0} {
 276                 if {[$menu type $i] != "cascade"} {
 277                     $menu entryconfigure $i -state $state
 278                 }
 279                 incr i -1
 280             }
 281         }
 282
 283         if {$variable != "" && [$variable editable]} {
 284             set state normal
 285         } else {
 286             set state disabled
 287         }
 288
 289         if {$variable != ""} {
 290             set Display($this) [$variable format]
 291         }
 292
 293         foreach label {Hex Decimal Binary Octal Natural} {
 294             [namespace tail $this].mmenu.var.format entryconfigure $label
 295             if {$label != "Hex"} {
 296                 [namespace tail $this].mmenu.var.format entryconfigure $label -state $state
 297             }
 298         }
 299         #    [namespace tail $this].mmenu.update entryconfigure 0 -variable Update($this,$name)
 300     }
 301
 302     method updateNow {variable} {
 303         # debug "VariableWin::updateNow $variable"
 304
 305         if {!$Running} {
 306             set text [label $variable]
 307             $Hlist entryconfigure $variable -itemtype text -text $text
 308         }
 309     }
 310
 311     method getEntry {x y} {
 312         set realY [expr {$y - [winfo rooty $Hlist]}]
 313
 314         # Get the tree entry which we are over
 315         return [$Hlist nearest $realY]
 316     }
 317
 318     method editEntry {variable} {
 319         if {!$Running} {
 320             if {$variable != "" && [$variable editable]} {
 321                 edit $variable
 322             }
 323         }
 324     }
 325
 326     method postMenu {X Y} {
 327         global Update Display
 328         #    debug "VariableWin::postMenu"
 329
 330         # Quicky for menu posting problems.. How to unpost and post??
 331
 332         if {[winfo ismapped $Popup] || $Running} {
 333             return
 334         }
 335
 336         set variable [getEntry $X $Y]
 337         if {[string length $variable] > 0} {
 338             # Configure menu items
 339             # the title is always first..
 340             #set labelIndex [$Popup index "dummy"]
 341             set viewIndex [$Popup index "Format"]
 342             #      set autoIndex [$Popup index "Auto Update"]
 343             #      set updateIndex [$Popup index "Update Now"]
 344             set noEdit [catch {$Popup index "Edit"} editIndex]
 345
 346             # Retitle and set update commands
 347             $Popup entryconfigure 0 -label "[$variable name]"
 348             #      $Popup entryconfigure $autoIndex -command "$this toggleUpdate \{$entry\}" \
 349                 -variable Update($this,$entry)
 350             #      $Popup entryconfigure $updateIndex -command "$this updateNow \{$entry\}"
 351
 352             # Edit pane
 353             if {$variable != "" && [$variable editable]} {
 354                 if {!$noEdit} {
 355                     $Popup delete $editIndex
 356                 }
 357                 if {![pref get gdb/mode]} {
 358                     $Popup  add command -label Edit -command "$this edit \{$variable\}"
 359                 }
 360             } else {
 361                 if {!$noEdit} {
 362                     $Popup delete $editIndex
 363                 }
 364             }
 365
 366             # Set view menu
 367             set Display($this) [$variable format]
 368             foreach i {0 1 2 3 4} fmt {hexadecimal decimal binary octal natural} {
 369                 debug "configuring entry $i ([$ViewMenu entrycget $i -label]) to $fmt"
 370                 $ViewMenu entryconfigure $i \
 371                     -command "$this setDisplay \{$variable\} $fmt"
 372             }
 373
 374             tk_popup $Popup $X $Y
 375         }
 376     }
 377
 378     # ------------------------------------------------------------------
 379     # METHOD edit -- edit a variable
 380     # ------------------------------------------------------------------
 381     method edit {variable} {
 382         global Update tixOption
 383
 384         # disable menus
 385         selectionChanged ""
 386         debug "editing \"$variable\""
 387
 388         set fg   [$Hlist cget -foreground]
 389         set bg   [$Hlist cget -background]
 390
 391         if {$Editing == ""} {
 392             # Must create the frame
 393             set Editing [frame $Hlist.frame -bg $bg -bd 0 -relief flat]
 394             set lbl [::label $Editing.lbl -fg $fg -bg $bg -font src-font]
 395             set ent [entry $Editing.ent -bg $tixOption(bg) -font src-font]
 396             pack $lbl $ent -side left
 397         }
 398
 399         if {[info exists EditEntry]} {
 400             # We already are editing something... So reinstall it first
 401             # I guess we discard any changes?
 402             UnEdit
 403         }
 404
 405         # Update the label/entry widgets for this instance
 406         set Update($this,$variable) 1
 407         set EditEntry $variable
 408         set label [label $variable 1];  # do not append value
 409         $Editing.lbl configure -text "$label  "
 410         $Editing.ent delete 0 end
 411
 412         # Strip the pointer type, text, etc, from pointers, and such
 413         set err [catch {$variable value} text]
 414         if {$err} {return}
 415         if {[$variable format] == "natural"} {
 416             # Natural formats must be stripped. They often contain
 417             # things like strings and characters after them.
 418             set index [string first \  $text]
 419             if {$index != -1} {
 420                 set text [string range $text 0 [expr {$index - 1}]]
 421             }
 422         }
 423         $Editing.ent insert 0 $text
 424
 425         # Find out what the previous entry is
 426         set previous [getPrevious $variable]
 427
 428         close $variable
 429         $Hlist delete entry $variable
 430
 431         set cmd [format { \
 432                               %s add {%s} %s -itemtype window -window %s \
 433                           } $Hlist $variable $previous $Editing]
 434         eval $cmd
 435
 436         if {[$variable numChildren] > 0} {
 437             $Tree setmode $variable open
 438         }
 439
 440         # Set focus to entry
 441         focus $Editing.ent
 442         $Editing.ent selection to end
 443
 444         # Setup key bindings
 445         bind $Editing.ent <Return> "$this changeValue"
 446         bind $Hlist <Return> "$this changeValue"
 447         bind $Editing.ent <Escape> "$this UnEdit"
 448         bind $Hlist <Escape> "$this UnEdit"
 449     }
 450
 451     method getPrevious {variable} {
 452         set prev [$Hlist info prev $variable]
 453         set parent [$Hlist info parent $variable]
 454
 455         if {$prev != ""} {
 456             # A problem occurs with PREV if its parent is not the same as the entry's
 457             # parent. For example, consider these variables in the window:
 458             # + foo        struct {...}
 459             # - bar        struct {...}
 460             #     a        1
 461             #     b        2
 462             # local        0
 463             # if you attempt to edit "local", previous will be set at "bar.b", not
 464             # "struct bar"...
 465             if {[$Hlist info parent $prev] != $parent} {
 466                 # This is the problem!
 467                 # Find this object's sibling in that parent and place it there.
 468                 set children [$Hlist info children $parent]
 469                 set p {}
 470                 foreach child $children {
 471                     if {$child == $variable} {
 472                         break
 473                     }
 474                     set p $child
 475                 }
 476
 477                 if {$p == {}} {
 478                     # This is the topmost child
 479                     set previous "-before [lindex $children 1]"
 480                 } else {
 481                     set previous "-after $p"
 482                 }
 483             } else {
 484                 set previous "-after \{$prev\}"
 485             }
 486         } else {
 487             # this is the first!
 488             set previous "-at 0"
 489         }
 490
 491         if {$prev == "$parent"} {
 492             # This is the topmost-member of a sub-grouping..
 493             set previous "-at 0"
 494         }
 495
 496         return $previous
 497     }
 498
 499     method UnEdit {} {
 500         set previous [getPrevious $EditEntry]
 501
 502         $Hlist delete entry $EditEntry
 503         set cmd [format {\
 504                              %s add {%s} %s -itemtype text -text {%s} \
 505                          } $Hlist $EditEntry $previous [label $EditEntry]]
 506         eval $cmd
 507         if {[$EditEntry numChildren] > 0} {
 508             $Tree setmode $EditEntry open
 509         }
 510
 511         # Unbind
 512         bind $Hlist <Return> {}
 513         bind $Hlist <Escape> {}
 514         if {$Editing != ""} {
 515             bind $Editing.ent <Return> {}
 516             bind $Editing.ent <Escape> {}
 517         }
 518
 519         unset EditEntry
 520         selectionChanged ""
 521     }
 522
 523     method changeValue {} {
 524         # Get the old value
 525         set new [string trim [$Editing.ent get] \ \r\n]
 526         if {$new == ""} {
 527             UnEdit
 528             return
 529         }
 530
 531         if {[catch {$EditEntry value $new} errTxt]} {
 532             tk_messageBox -icon error -type ok -message $errTxt \
 533                 -title "Error in Expression" -parent [winfo toplevel $itk_interior]
 534             focus $Editing.ent
 535             $Editing.ent selection to end
 536         } else {
 537             UnEdit
 538
 539             # Get rid of entry... and replace it with new value
 540             focus $Tree
 541         }
 542     }
 543
 544
 545     # ------------------------------------------------------------------
 546     #  METHOD:  toggleView: Toggle open/close the current selection.
 547     # ------------------------------------------------------------------
 548     method toggleView {} {
 549
 550         set v [getSelection]
 551         set mode [$Tree getmode $v]
 552
 553         # In the tixTree widget, "open" means "openable", not that it is open...
 554
 555         debug "mode=$mode"
 556         switch $mode {
 557             open {
 558                 $Tree setmode $v close
 559                 open $v
 560             }
 561
 562             close {
 563                 $Tree setmode $v open
 564                 close $v
 565             }
 566
 567             default {
 568                 dbug E "What happened?"
 569             }
 570         }
 571     }
 572
 573     method toggleUpdate {variable} {
 574         global Update
 575
 576         if {$Update($this,$variable)} {
 577             # Must update value
 578             $Hlist entryconfigure $variable \
 579                 -style $NormalTextStyle    \
 580                 -text [label $variable]
 581         } else {
 582             $Hlist entryconfigure $variable \
 583                 -style $DisabledTextStyle
 584         }
 585         ::update
 586     }
 587
 588     method setDisplay {variable format} {
 589         debug "$variable $format"
 590         if {!$Running} {
 591             $variable format $format
 592             set ::Display($this) $format
 593             $Hlist entryconfigure $variable -text [label $variable]
 594         }
 595     }
 596
 597     # ------------------------------------------------------------------
 598     # METHOD:   label - used to label the entries in the tree
 599     # ------------------------------------------------------------------
 600     method label {variable {noValue 0}} {
 601         # Ok, this is as hack as it gets
 602         set blank "                                                                                                                                                             "
 603         # Use protected data Length to determine how big variable
 604         # name should be. This should clean the display up a little
 605         set name [$variable name]
 606         set indent [llength [split $variable .]]
 607         set indent [expr {$indent * $Length}]
 608         set len [string length $name]
 609         set l [expr {$EntryLength - $len - $indent}]
 610         set label "$name[string range $blank 0 $l]"
 611         #debug "label=$label $noValue"
 612         if {$noValue} {
 613             return $label
 614         }
 615
 616         set err [catch {$variable value} value]
 617         set value [string trim $value \ \r\t\n]
 618         #debug "err=$err value=$value"
 619
 620         # Insert the variable's type for things like ptrs, etc.
 621         set type [$variable type]
 622         if {!$err} {
 623             if {$value == "{...}"} {
 624                 set val " $type $value"
 625             } elseif {[string first * $type] != -1} {
 626                 set val " ($type) $value"
 627             } elseif {[string first \[ $type] != -1} {
 628                 set val " $type"
 629             } else {
 630                 set val " $value"
 631             }
 632         } else {
 633             set val " $value"
 634         }
 635
 636         return "$label $val"
 637     }
 638
 639     # ------------------------------------------------------------------
 640     # METHOD:   open - used to open an entry in the variable tree
 641     # ------------------------------------------------------------------
 642     method open {path} {
 643         global Update
 644         # We must lookup all the variables for this struct
 645         #    debug "VariableWin::open $path"
 646
 647         if {!$Running} {
 648             # Do not open disabled paths
 649             if {$Update($this,$path)} {
 650                 cursor watch
 651                 populate $path
 652                 cursor {}
 653             }
 654         } else {
 655             $Tree setmode $path open
 656         }
 657     }
 658
 659     # ------------------------------------------------------------------
 660     # METHOD:   close - used to close an entry in the variable tree
 661     # ------------------------------------------------------------------
 662     method close {path} {
 663         global Update
 664         debug "VariableWin::close $path"
 665         # Close the path and destroy all the entry widgets
 666
 667         # Cancel any edits
 668         if {[info exists EditEntry]} {
 669             UnEdit
 670         }
 671
 672         if {!$Running} {
 673             # Only update when we we are not disabled
 674             if {$Update($this,$path)} {
 675
 676                 # Delete the offspring of this entry
 677                 $Hlist delete offspring $path
 678             }
 679         } else {
 680             $Tree setmode $path close
 681         }
 682     }
 683
 684     method isVariable {var} {
 685
 686         set err [catch {gdb_cmd "output $var"} msg]
 687         if {$err
 688             || [regexp -nocase "no symbol|syntax error" $msg]} {
 689             return 0
 690         }
 691
 692         return 1
 693     }
 694
 695     # OVERRIDE THIS METHOD
 696     method getVariablesBlankPath {} {
 697         debug "You forgot to override getVariablesBlankPath!!"
 698         return {}
 699     }
 700
 701     method cmd {cmd} {
 702         eval $cmd
 703     }
 704
 705     # ------------------------------------------------------------------
 706     # METHOD:   populate - populate an entry in the tree
 707     # ------------------------------------------------------------------
 708     method populate {parent} {
 709         global Update
 710         debug "VariableWin::populate \"$parent\""
 711
 712         if {[string length $parent] == 0} {
 713             set variables [getVariablesBlankPath]
 714         } else {
 715             set variables [$parent children]
 716         }
 717
 718         debug "variables=$variables"
 719         eval $_queue push $variables
 720         for {set variable [$_queue pop]} {$variable != ""} {set variable [$_queue pop]} {
 721             debug "inserting variable: $variable"
 722             set Update($this,$variable) 1
 723
 724             $Hlist add $variable          \
 725                 -itemtype text              \
 726                 -text [label $variable]
 727             if {[$variable numChildren] > 0} {
 728                 # Make sure we get this labeled as openable
 729                 $Tree setmode $variable open
 730             }
 731
 732             # Special case: If we see "public" with no value or type, then we
 733             # have one of our special c++/java children. Open it automagically
 734             # for the user.
 735             if {[string compare [$variable name] "public"] == 0
 736                 && [$variable type] == "" && [$variable value] == ""} {
 737                 eval $_queue push [$variable children]
 738                 $Tree setmode $variable close
 739             }
 740         }
 741
 742         debug "done with populate"
 743     }
 744
 745     # Get all current locals
 746     proc getLocals {} {
 747
 748         set vars {}
 749         set err [catch {gdb_get_args} v]
 750         if {!$err} {
 751             set vars [concat $vars $v]
 752         }
 753
 754         set err [catch {gdb_get_locals} v]
 755         if {!$err} {
 756             set vars [concat $vars $v]
 757         }
 758
 759         debug "--getLocals:\n$vars\n--getLocals"
 760         return [lsort $vars]
 761     }
 762
 763     method context_switch {} {
 764         set err [catch {gdb_selected_frame} current_frame]
 765         debug "1: err=$err; _frame=\"$_frame\"; current_frame=\"$current_frame\""
 766         if {$err && $_frame != ""} {
 767             # No current frame
 768             debug "no current frame"
 769             catch {destroy $_frame}
 770             set _frame {}
 771             return 1
 772         } elseif {$current_frame == "" && $_frame == ""} {
 773             debug "2"
 774             return 0
 775         } elseif {$_frame == "" || $current_frame != [$_frame address]} {
 776             # We've changed frames. If we knew something about
 777             # the stack layout, we could be more intelligent about
 778             # destroying variables, but we don't know that here (yet).
 779             debug "switching to frame at $current_frame"
 780
 781             # Destroy the old frame and create the new one
 782             catch {destroy $_frame}
 783             set _frame [Frame ::\#auto $current_frame]
 784             debug "created new frame: $_frame at [$_frame address]"
 785             return 1
 786         }
 787
 788         # Nothing changed
 789         debug "3"
 790         return 0
 791     }
 792
 793     # OVERRIDE THIS METHOD and call it from there
 794     method update {} {
 795         global Update
 796         debug "VariableWin::update"
 797
 798         # First, reset color on label to black
 799         foreach w $ChangeList {
 800             catch {
 801                 $Hlist entryconfigure $w -style $NormalTextStyle
 802             }
 803         }
 804
 805         # Tell toplevel variables to update themselves. This will
 806         # give us a list of all the variables in the table that
 807         # have changed values.
 808         set ChangeList {}
 809         set variables [$Hlist info children {}]
 810         foreach var $variables {
 811             #      debug "VARIABLE: $var ($Update($this,$var))"
 812             set ChangeList [concat $ChangeList [$var update]]
 813         }
 814
 815         foreach var $ChangeList {
 816             $Hlist entryconfigure $var \
 817                 -style  $HighlightTextStyle   \
 818                 -text [label $var]
 819         }
 820     }
 821
 822     method idle {} {
 823         # Re-enable the UI
 824         enable_ui
 825     }
 826
 827     # RECURSION!!
 828     method displayedVariables {top} {
 829         #    debug "VariableWin::displayedVariables"
 830         set variableList {}
 831         set variables [$Hlist info children $top]
 832         foreach var $variables {
 833             set mode [$Tree getmode $var]
 834             if {$mode == "close"} {
 835                 set moreVars [displayedVariables $var]
 836                 lappend variableList [join $moreVars]
 837             }
 838             lappend variableList $var
 839         }
 840
 841         return [join $variableList]
 842     }
 843
 844     method deleteTree {} {
 845         global Update
 846         debug "deleteTree"
 847         #    debug "VariableWin::deleteTree"
 848 #       set variables [displayedVariables {}]
 849
 850         # Delete all HList entries
 851         $Hlist delete all
 852
 853         # Delete the variable objects
 854 #       foreach i [array names Variables] {
 855 #           $Variables($i) delete
 856 #           unset Variables($i)
 857 #           catch {unset Update($this,$i)}
 858 #       }
 859     }
 860
 861     # ------------------------------------------------------------------
 862     # METHOD:   enable_ui
 863     #           Enable all ui elements.
 864     # ------------------------------------------------------------------
 865     method enable_ui {} {
 866
 867         # Clear fencepost
 868         set Running 0
 869         cursor {}
 870     }
 871
 872     # ------------------------------------------------------------------
 873     # METHOD:   disable_ui
 874     #           Disable all ui elements that could affect gdb's state
 875     # ------------------------------------------------------------------
 876     method disable_ui {} {
 877
 878         # Set fencepost
 879         set Running 1
 880
 881         # Cancel any edits
 882         if {[info exists EditEntry]} {
 883             UnEdit
 884         }
 885
 886         # Change cursor
 887         cursor watch
 888     }
 889
 890     # ------------------------------------------------------------------
 891     # METHOD:   no_inferior
 892     #           Reset this object.
 893     # ------------------------------------------------------------------
 894     method no_inferior {} {
 895
 896         # Clear out the Hlist
 897         deleteTree
 898
 899         # Clear fencepost
 900         set Running 0
 901         set _frame {}
 902         cursor {}
 903     }
 904
 905     # ------------------------------------------------------------------
 906     #  METHOD:  cursor - change the toplevel's cursor
 907     # ------------------------------------------------------------------
 908     method cursor {what} {
 909         [winfo toplevel [namespace tail $this]] configure -cursor $what
 910         ::update idletasks
 911     }
 912
 913     #
 914     # PUBLIC DATA
 915     #
 916
 917     #
 918     #  PROTECTED DATA
 919     #
 920
 921     # the tixTree widget for this class
 922     protected variable Tree  {}
 923
 924     # the hlist of this widget
 925     protected variable Hlist {}
 926
 927     # entry widgets which need to have their color changed back to black
 928     # when idle (used in conjunction with update)
 929     protected variable ChangeList {}
 930
 931     protected variable ViewMenu
 932     protected variable Popup
 933
 934     # These are for setting the indent level to an number of characters.
 935     # This will help clean the tree a little
 936     common EntryLength 15
 937     common Length 1
 938     common LengthString " "
 939
 940     # These should be common... but deletion?
 941     # Display styles for HList
 942     protected variable HighlightTextStyle
 943     protected variable NormalTextStyle
 944     protected variable DisabledTextStyle
 945
 946     protected variable Radix
 947
 948     # Frame object for the selected frame
 949     protected variable _frame {}
 950
 951     protected variable Editing {}
 952     protected variable EditEntry
 953
 954     # Fencepost for enable/disable_ui and idle/busy hooks.
 955     protected variable Running 0
 956
 957     # little queue for convenience
 958     protected variable _queue {}
 959 }