summaryrefslogtreecommitdiff
path: root/gdb/gdbtk/library/variables.tcl
blob: c55b41d8e63d8c1f8fc8a5f9d889caa44b58e58c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
# Variable display window 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 variable windows for gdb. LocalsWin and WatchWin both
# inherit from this class. You need only override the method 
# 'getVariablesBlankPath' and a few other things...
# ----------------------------------------------------------------------

class VariableWin {
    inherit EmbeddedWin GDBWin
    protected variable Sizebox 1

    # ------------------------------------------------------------------
    #  CONSTRUCTOR - create new watch window
    # ------------------------------------------------------------------
    constructor {args} {
	#
	#  Create a window with the same name as this object
	#
	gdbtk_busy
	set _queue [Queue \#auto]
	build_win $itk_interior
	gdbtk_idle

	add_hook gdb_update_hook "$this update"
	add_hook gdb_busy_hook "$this disable_ui"
	add_hook gdb_no_inferior_hook "$this no_inferior"
	add_hook gdb_idle_hook [list $this idle]
	add_hook gdb_clear_file_hook [code $this clear_file]
    }

    # ------------------------------------------------------------------
    #  METHOD:  build_win - build the watch window
    # ------------------------------------------------------------------
    method build_win {f} {
	global tixOption tcl_platform Display
	#    debug "VariableWin::build_win"
	set width [font measure src-font "W"]
	# Choose the default width to be...
	set width [expr {40 * $width}]
	if {$tcl_platform(platform) == "windows"} {
	    set scrollmode both
	} else {
	    set scrollmode auto
	}

	debug "tree=$f.tree"
	set Tree [tixTree $f.tree        \
		      -opencmd  "$this open"  \
		      -closecmd "$this close" \
		      -ignoreinvoke 1         \
		      -width $width           \
		      -browsecmd [list $this selectionChanged] \
		      -scrollbar $scrollmode \
		      -sizebox $Sizebox]
	if {![pref get gdb/mode]} {
	    $Tree configure -command [list $this editEntry]
	}
	set Hlist [$Tree subwidget hlist]

	# FIXME: probably should use columns instead.
	$Hlist configure -header 1

	set l [expr {$EntryLength - $Length - [string length "Name"]}]
	# Ok, this is as hack as it gets
	set blank "                                                                                                                                                             "
	$Hlist header create 0 -itemtype text \
	    -text "Name[string range $blank 0 $l]Value"

	# Configure the look of the tree
	set sbg [$Hlist cget -bg]
	set fg [$Hlist cget -fg]
	set bg $tixOption(input1_bg)
	set width [font measure src-font $LengthString]
	$Hlist configure -indent $width -bg $bg \
	    -selectforeground $fg -selectbackground $sbg \
	    -selectborderwidth 0 -separator . -font src-font

	# Get display styles
	set normal_fg    [$Hlist cget -fg]
	set highlight_fg [pref get gdb/variable/highlight_fg]
	set disabled_fg  [pref get gdb/variable/disabled_fg]
	set NormalTextStyle [tixDisplayStyle text -refwindow $Hlist \
				 -bg $bg -fg $normal_fg -font src-font]
	set HighlightTextStyle [tixDisplayStyle text -refwindow $Hlist \
				    -bg $bg -fg $highlight_fg -font src-font]
	set DisabledTextStyle [tixDisplayStyle text -refwindow $Hlist \
				   -bg $bg -fg $disabled_fg -font src-font]

	if {[catch {gdb_cmd "show output-radix"} msg]} {
	    set Radix 10
	} else {
	    regexp {[0-9]+} $msg Radix
	}


	# Update the tree display
	update
	pack $Tree -expand yes -fill both

	# Create the popup menu for this widget
	bind $Hlist <3> "$this postMenu %X %Y"
	bind $Hlist <KeyPress-space> [code $this toggleView]

	# Do not use the tixPopup widget... 
	set Popup [menu $f.menu -tearoff 0]
	set disabled_foreground [$Popup cget -foreground]
	$Popup configure -disabledforeground $disabled_foreground
	set ViewMenu [menu $Popup.view]

	# Populate the view menu
	$ViewMenu add radiobutton -label "Hex" -variable Display($this) \
	    -value hexadecimal
	$ViewMenu add radiobutton -label "Decimal" -variable Display($this) \
	    -value decimal
	$ViewMenu add radiobutton -label "Binary" -variable Display($this) \
	    -value binary
	$ViewMenu add radiobutton -label "Octal" -variable Display($this) \
	    -value octal
	$ViewMenu add radiobutton -label "Natural" -variable Display($this) \
	    -value natural

	$Popup add command -label "dummy" -state disabled
	$Popup add separator
	$Popup add cascade -label "Format" -menu $ViewMenu
	#    $Popup add checkbutton -label "Auto Update"
	#    $Popup add command -label "Update Now"
	if {![pref get gdb/mode]} {
	    $Popup add command -label "Edit"
	}

	# Make sure to update menu info.
	selectionChanged ""

	window_name "Local Variables" "Locals"
    }

    # ------------------------------------------------------------------
    #  DESTRUCTOR - destroy window containing widget
    # ------------------------------------------------------------------
    destructor {
	#    debug "VariableWin::destructor"
	# Make sure to clean up the frame
	catch {destroy $_frame}
	
	# Delete the display styles used with this window
	destroy $NormalTextStyle
	destroy $HighlightTextStyle
	destroy $DisabledTextStyle

	# Remove this window and all hooks
	remove_hook gdb_update_hook "$this update"
	remove_hook gdb_busy_hook "$this disable_ui"
	remove_hook gdb_no_inferior_hook "$this no_inferior"
	remove_hook gdb_idle_hook [list $this idle]
	remove_hook gdb_clear_file_hook [code $this clear_file]
    }

    # ------------------------------------------------------------------
    #  METHOD:  clear_file - Clear out state and prepare for loading
    #              a new executable.
    # ------------------------------------------------------------------
    method clear_file {} {
	no_inferior
    }

    # ------------------------------------------------------------------
    #  METHOD:  reconfig - used when preferences change
    # ------------------------------------------------------------------
    method reconfig {} {
	#    debug "VariableWin::reconfig"
	foreach win [winfo children $itk_interior] { 
	    destroy $win
	}

	build_win $itk_interior
    }

    # ------------------------------------------------------------------
    #  METHOD:  build_menu_helper - Create the menu for a subclass.
    # ------------------------------------------------------------------
    method build_menu_helper {first} {
	global Display
	menu [namespace tail $this].mmenu

	[namespace tail $this].mmenu add cascade -label $first -underline 0 -menu [namespace tail $this].mmenu.var

	menu [namespace tail $this].mmenu.var
	if {![pref get gdb/mode]} {
	    [namespace tail $this].mmenu.var add command -label Edit -underline 0 -state disabled \
		-command [format {
		    %s editEntry [%s getSelection]
		} $this $this]
	}
	[namespace tail $this].mmenu.var add cascade -label Format -underline 0 \
	    -menu [namespace tail $this].mmenu.var.format

	menu [namespace tail $this].mmenu.var.format
	foreach label {Hex Decimal Binary Octal Natural} fmt {hexadecimal decimal binary octal natural} {
	    [namespace tail $this].mmenu.var.format add radiobutton \
		-label $label -underline 0 \
		-value $fmt -variable Display($this) \
		-command [format {
		    %s setDisplay [%s getSelection] %s
		} $this $this $fmt]
	}

	#    [namespace tail $this].mmenu add cascade -label Update -underline 0 -menu [namespace tail $this].mmenu.update
	#    menu [namespace tail $this].mmenu.update

	# The -variable is set when a selection is made in the tree.
	#    [namespace tail $this].mmenu.update add checkbutton -label "Auto Update" -underline 0 \
	    #      -command [format {
	#	%s toggleUpdate [%s getSelection]
	#      } $this $this]
	#    [namespace tail $this].mmenu.update add command -label "Update Now" -underline 0 \
	    #      -accelerator "Ctrl+U" -command [format {
	#	%s updateNow [%s getSelection]
	#      } $this $this]

	set top [winfo toplevel [namespace tail $this]]
	$top configure -menu [namespace tail $this].mmenu
	bind_plain_key $top Control-u [format {
	    if {!$Running} {
		if {[%s getSelection] != ""} {
		    %s updateNow [%s getSelection]
		}
	    }
	} $this $this $this]

	return [namespace tail $this].mmenu.var
    }

    # Return the current selection, or the empty string if none.
    method getSelection {} {
	return [$Hlist info selection]
    }

    # This is called when a selection is made.  It updates the main
    # menu.
    method selectionChanged {variable} {
	global Display

	if {$Running} {
	    # Clear the selection, too
	    $Hlist selection clear
	    return
	}

	# if something is being edited, cancel it
	if {[info exists EditEntry]} {
	    UnEdit
	}

	if {$variable == ""} {
	    set state disabled
	} else {
	    set state normal
	}

	foreach menu [list [namespace tail $this].mmenu.var [namespace tail $this].mmenu.var.format ] {
	    set i [$menu index last]
	    while {$i >= 0} {
		if {[$menu type $i] != "cascade"} {
		    $menu entryconfigure $i -state $state
		}
		incr i -1
	    }
	}

	if {$variable != "" && [$variable editable]} {
	    set state normal
	} else {
	    set state disabled
	}

	if {$variable != ""} {
	    set Display($this) [$variable format]
	}

	foreach label {Hex Decimal Binary Octal Natural} {
	    [namespace tail $this].mmenu.var.format entryconfigure $label
	    if {$label != "Hex"} {
		[namespace tail $this].mmenu.var.format entryconfigure $label -state $state
	    }
	}
	#    [namespace tail $this].mmenu.update entryconfigure 0 -variable Update($this,$name)
    }

    method updateNow {variable} {
	# debug "VariableWin::updateNow $variable"

	if {!$Running} {
	    set text [label $variable]
	    $Hlist entryconfigure $variable -itemtype text -text $text
	}
    }

    method getEntry {x y} {
	set realY [expr {$y - [winfo rooty $Hlist]}]

	# Get the tree entry which we are over
	return [$Hlist nearest $realY]
    }

    method editEntry {variable} {
	if {!$Running} {
	    if {$variable != "" && [$variable editable]} {
		edit $variable
	    }
	}
    }

    method postMenu {X Y} {
	global Update Display
	#    debug "VariableWin::postMenu"

	# Quicky for menu posting problems.. How to unpost and post??

	if {[winfo ismapped $Popup] || $Running} {
	    return
	}

	set variable [getEntry $X $Y]
	if {[string length $variable] > 0} {
	    # Configure menu items
	    # the title is always first..
	    #set labelIndex [$Popup index "dummy"]
	    set viewIndex [$Popup index "Format"]
	    #      set autoIndex [$Popup index "Auto Update"]
	    #      set updateIndex [$Popup index "Update Now"]
	    set noEdit [catch {$Popup index "Edit"} editIndex]

	    # Retitle and set update commands
	    $Popup entryconfigure 0 -label "[$variable name]"
	    #      $Popup entryconfigure $autoIndex -command "$this toggleUpdate \{$entry\}" \
		-variable Update($this,$entry) 
	    #      $Popup entryconfigure $updateIndex -command "$this updateNow \{$entry\}"

	    # Edit pane
	    if {$variable != "" && [$variable editable]} {
		if {!$noEdit} {
		    $Popup delete $editIndex
		}
		if {![pref get gdb/mode]} {
		    $Popup  add command -label Edit -command "$this edit \{$variable\}"
		}
	    } else {
		if {!$noEdit} {
		    $Popup delete $editIndex
		}
	    }

	    # Set view menu
	    set Display($this) [$variable format]
	    foreach i {0 1 2 3 4} fmt {hexadecimal decimal binary octal natural} {
		debug "configuring entry $i ([$ViewMenu entrycget $i -label]) to $fmt"
		$ViewMenu entryconfigure $i \
		    -command "$this setDisplay \{$variable\} $fmt"
	    }

	    tk_popup $Popup $X $Y
	}
    }

    # ------------------------------------------------------------------
    # METHOD edit -- edit a variable
    # ------------------------------------------------------------------
    method edit {variable} {
	global Update tixOption

	# disable menus
	selectionChanged ""
        debug "editing \"$variable\""

	set fg   [$Hlist cget -foreground]
	set bg   [$Hlist cget -background]

	if {$Editing == ""} {
	    # Must create the frame
	    set Editing [frame $Hlist.frame -bg $bg -bd 0 -relief flat]
	    set lbl [::label $Editing.lbl -fg $fg -bg $bg -font src-font]
	    set ent [entry $Editing.ent -bg $tixOption(bg) -font src-font]
	    pack $lbl $ent -side left
	}

	if {[info exists EditEntry]} {
	    # We already are editing something... So reinstall it first
	    # I guess we discard any changes?
	    UnEdit
	}

	# Update the label/entry widgets for this instance
	set Update($this,$variable) 1
	set EditEntry $variable
	set label [label $variable 1];	# do not append value
	$Editing.lbl configure -text "$label  "
	$Editing.ent delete 0 end

	# Strip the pointer type, text, etc, from pointers, and such
	set err [catch {$variable value} text]
	if {$err} {return}
	if {[$variable format] == "natural"} {
	    # Natural formats must be stripped. They often contain
	    # things like strings and characters after them.
	    set index [string first \  $text]
	    if {$index != -1} {
		set text [string range $text 0 [expr {$index - 1}]]
	    }
	}
	$Editing.ent insert 0 $text

	# Find out what the previous entry is
	set previous [getPrevious $variable]

	$Hlist delete entry $variable

	set cmd [format { \
			      %s add {%s} %s -itemtype window -window %s \
			  } $Hlist $variable $previous $Editing]
	eval $cmd

	if {[$variable numChildren] > 0} {
	    $Tree setmode $variable open
	}

	# Set focus to entry
	focus $Editing.ent
	$Editing.ent selection to end

	# Setup key bindings
	bind $Editing.ent <Return> "$this changeValue"
	bind $Hlist <Return> "$this changeValue"
	bind $Editing.ent <Escape> "$this UnEdit"
	bind $Hlist <Escape> "$this UnEdit"
    }

    method getPrevious {variable} {
	set prev [$Hlist info prev $variable]
	set parent [$Hlist info parent $variable]

	if {$prev != ""} {
	    # A problem occurs with PREV if its parent is not the same as the entry's
	    # parent. For example, consider these variables in the window:
	    # + foo        struct {...}
	    # - bar        struct {...}
	    #     a        1
	    #     b        2
	    # local        0
	    # if you attempt to edit "local", previous will be set at "bar.b", not
	    # "struct bar"...
	    if {[$Hlist info parent $prev] != $parent} {
		# This is the problem!
		# Find this object's sibling in that parent and place it there.
		set children [$Hlist info children $parent]
		set p {}
		foreach child $children {
		    if {$child == $variable} {
			break
		    }
		    set p $child
		}

		if {$p == {}} {
		    # This is the topmost child
		    set previous "-before [lindex $children 1]"
		} else {
		    set previous "-after $p"
		}
	    } else {
		set previous "-after \{$prev\}"
	    }
	} else {
	    # this is the first!
	    set previous "-at 0"
	}
	
	if {$prev == "$parent"} {
	    # This is the topmost-member of a sub-grouping..
	    set previous "-at 0"
	}

	return $previous
    }

    method UnEdit {} {
	set previous [getPrevious $EditEntry]
	
	$Hlist delete entry $EditEntry
	set cmd [format {\
			     %s add {%s} %s -itemtype text -text {%s} \
			 } $Hlist $EditEntry $previous [label $EditEntry]]
	eval $cmd
	if {[$EditEntry numChildren] > 0} {
	    $Tree setmode $EditEntry open
	}
	
	# Unbind
	bind $Hlist <Return> {}
	bind $Hlist <Escape> {}
	if {$Editing != ""} {
	    bind $Editing.ent <Return> {}
	    bind $Editing.ent <Escape> {}
	}
	
	unset EditEntry
	selectionChanged ""
    }

    method changeValue {} {
	# Get the old value
	set new [string trim [$Editing.ent get] \ \r\n]
	if {$new == ""} {
	    UnEdit
	    return
	}

	if {[catch {$EditEntry value $new} errTxt]} {
	    tk_messageBox -icon error -type ok -message $errTxt \
		-title "Error in Expression" -parent [winfo toplevel $itk_interior]
	    focus $Editing.ent
	    $Editing.ent selection to end
	} else {
	    UnEdit

            # We may have changed a register or something else that is 
            # being displayed in another window
            gdbtk_update
	    
	    # Get rid of entry... and replace it with new value
	    focus $Tree
	}
    }


    # ------------------------------------------------------------------
    #  METHOD:  toggleView: Toggle open/close the current selection.
    # ------------------------------------------------------------------  
    method toggleView {} {

	set v [getSelection]
	set mode [$Tree getmode $v]

	# In the tixTree widget, "open" means "openable", not that it is open...

	debug "mode=$mode"
	switch $mode {
	    open {
		$Tree setmode $v close
		open $v
	    }

	    close {
		$Tree setmode $v open
		close $v
	    }

	    default {
		dbug E "What happened?"
	    }
	}
    }

    method toggleUpdate {variable} {
	global Update

	if {$Update($this,$variable)} {
	    # Must update value
	    $Hlist entryconfigure $variable \
		-style $NormalTextStyle    \
		-text [label $variable]
	} else {
	    $Hlist entryconfigure $variable \
		-style $DisabledTextStyle
	}
	::update
    }

    method setDisplay {variable format} {
	debug "$variable $format"
	if {!$Running} {
	    $variable format $format
	    set ::Display($this) $format
	    $Hlist entryconfigure $variable -text [label $variable]
	}
    }
    
    # ------------------------------------------------------------------
    # METHOD:   label - used to label the entries in the tree
    # ------------------------------------------------------------------
    method label {variable {noValue 0}} {
	# Ok, this is as hack as it gets
	set blank "                                                                                                                                                             "
	# Use protected data Length to determine how big variable
	# name should be. This should clean the display up a little
	set name [$variable name]
	set indent [llength [split $variable .]]
	set indent [expr {$indent * $Length}]
	set len [string length $name]
	set l [expr {$EntryLength - $len - $indent}]
	set label "$name[string range $blank 0 $l]"
	#debug "label=$label $noValue"
	if {$noValue} {
	    return $label
	}

	set err [catch {$variable value} value]
	set value [string trim $value \ \r\t\n]
	#debug "err=$err value=$value"

	# Insert the variable's type for things like ptrs, etc.
	set type [$variable type]
	if {!$err} {
	    if {$value == "{...}"} {
		set val " $type $value"
	    } elseif {[string first * $type] != -1} {
		set val " ($type) $value"
	    } elseif {[string first \[ $type] != -1} {
		set val " $type"
	    } else {
		set val " $value"
	    }
	} else {
	    set val " $value"
	}

	return "$label $val"
    }

    # ------------------------------------------------------------------
    # METHOD:   open - used to open an entry in the variable tree
    # ------------------------------------------------------------------
    method open {path} {
	global Update
	# We must lookup all the variables for this struct
	#    debug "VariableWin::open $path"

	# Cancel any edits
	if {[info exists EditEntry]} {
	    UnEdit
	}

	if {!$Running} {
	    # Do not open disabled paths
	    if {$Update($this,$path)} {
		cursor watch
		populate $path
		cursor {}
	    }
	} else {
	    $Tree setmode $path open
	}
    }

    # ------------------------------------------------------------------
    # METHOD:   close - used to close an entry in the variable tree
    # ------------------------------------------------------------------
    method close {path} {
	global Update
	debug "VariableWin::close $path"
	# Close the path and destroy all the entry widgets

	# Cancel any edits
	if {[info exists EditEntry]} {
	    UnEdit
	}

	if {!$Running} {
	    # Only update when we we are not disabled
	    if {$Update($this,$path)} {

		# Delete the offspring of this entry
		$Hlist delete offspring $path
	    }
	} else {
	    $Tree setmode $path close
	}
    }

    method isVariable {var} {

	set err [catch {gdb_cmd "output $var"} msg]
	if {$err 
	    || [regexp -nocase "no symbol|syntax error" $msg]} {
	    return 0
	}

	return 1
    }

    # OVERRIDE THIS METHOD
    method getVariablesBlankPath {} {
	debug "You forgot to override getVariablesBlankPath!!"
	return {}
    }

    method cmd {cmd} {
	eval $cmd
    }
    
    # ------------------------------------------------------------------
    # METHOD:   populate - populate an entry in the tree
    # ------------------------------------------------------------------
    method populate {parent} {
	global Update
	debug "VariableWin::populate \"$parent\""

	if {[string length $parent] == 0} {
	    set variables [getVariablesBlankPath]
	} else {
	    set variables [$parent children]
	}

	debug "variables=$variables"
	eval $_queue push $variables
	for {set variable [$_queue pop]} {$variable != ""} {set variable [$_queue pop]} {
	    debug "inserting variable: $variable"
	    set Update($this,$variable) 1

	    $Hlist add $variable          \
		-itemtype text              \
		-text [label $variable]
	    if {[$variable numChildren] > 0} {
		# Make sure we get this labeled as openable
		$Tree setmode $variable open
	    }

	    # Special case: If we see "public" with no value or type, then we
	    # have one of our special c++/java children. Open it automagically
	    # for the user.
	    if {[string compare [$variable name] "public"] == 0
		&& [$variable type] == "" && [$variable value] == ""} {
		eval $_queue push [$variable children]
		$Tree setmode $variable close
	    }
	}

	debug "done with populate"
    }

    # Get all current locals
    proc getLocals {} {

	set vars {}
	set err [catch {gdb_get_args} v]
	if {!$err} {
	    set vars [concat $vars $v]
	}

	set err [catch {gdb_get_locals} v]
	if {!$err} {
	    set vars [concat $vars $v]
	}

	debug "--getLocals:\n$vars\n--getLocals"
	return [lsort $vars]
    }

    method context_switch {} {
	set err [catch {gdb_selected_frame} current_frame]
	debug "1: err=$err; _frame=\"$_frame\"; current_frame=\"$current_frame\""
	if {$err && $_frame != ""} {
	    # No current frame
	    debug "no current frame"
	    catch {destroy $_frame}
	    set _frame {}
	    return 1
	} elseif {$current_frame == "" && $_frame == ""} {
	    debug "2"
	    return 0
	} elseif {$_frame == "" || $current_frame != [$_frame address]} {
	    # We've changed frames. If we knew something about
	    # the stack layout, we could be more intelligent about
	    # destroying variables, but we don't know that here (yet).
	    debug "switching to frame at $current_frame"

	    # Destroy the old frame and create the new one
	    catch {destroy $_frame}
	    set _frame [Frame ::\#auto $current_frame]
	    debug "created new frame: $_frame at [$_frame address]"
	    return 1
	}

	# Nothing changed
	debug "3"
	return 0
    }

    # OVERRIDE THIS METHOD and call it from there
    method update {} {
	global Update
	debug "VariableWin::update"

	# First, reset color on label to black
	foreach w $ChangeList {
	    catch {
		$Hlist entryconfigure $w -style $NormalTextStyle
	    }
	}

	# Tell toplevel variables to update themselves. This will
	# give us a list of all the variables in the table that
	# have changed values.
	set ChangeList {}
	set variables [$Hlist info children {}]
	foreach var $variables {
	    #      debug "VARIABLE: $var ($Update($this,$var))"
	    set ChangeList [concat $ChangeList [$var update]]
	}

	foreach var $ChangeList {
	    $Hlist entryconfigure $var \
		-style  $HighlightTextStyle   \
		-text [label $var]
	}
    }

    method idle {} {
	# Re-enable the UI
	enable_ui
    }

    # RECURSION!!
    method displayedVariables {top} {
	#    debug "VariableWin::displayedVariables"
	set variableList {}
	set variables [$Hlist info children $top]
	foreach var $variables {
	    set mode [$Tree getmode $var]
	    if {$mode == "close"} {
		set moreVars [displayedVariables $var]
		lappend variableList [join $moreVars]
	    }
	    lappend variableList $var
	}

	return [join $variableList]
    }

    method deleteTree {} {
	global Update
	debug "deleteTree"
	#    debug "VariableWin::deleteTree"
#	set variables [displayedVariables {}]

	# Delete all HList entries
	$Hlist delete all

	# Delete the variable objects
#	foreach i [array names Variables] {
#	    $Variables($i) delete
#	    unset Variables($i)
#	    catch {unset Update($this,$i)}
#	}
    }

    # ------------------------------------------------------------------
    # METHOD:   enable_ui
    #           Enable all ui elements.
    # ------------------------------------------------------------------
    method enable_ui {} {
	
	# Clear fencepost
	set Running 0
	cursor {}
    }

    # ------------------------------------------------------------------
    # METHOD:   disable_ui
    #           Disable all ui elements that could affect gdb's state
    # ------------------------------------------------------------------
    method disable_ui {} {

	# Set fencepost
	set Running 1

	# Cancel any edits
	if {[info exists EditEntry]} {
	    UnEdit
	}

	# Change cursor
	cursor watch
    }

    # ------------------------------------------------------------------
    # METHOD:   no_inferior
    #           Reset this object.
    # ------------------------------------------------------------------
    method no_inferior {} {

	# Clear out the Hlist
	deleteTree

	# Clear fencepost
	set Running 0
	set _frame {}
	cursor {}
    }

    # ------------------------------------------------------------------
    #  METHOD:  cursor - change the toplevel's cursor
    # ------------------------------------------------------------------
    method cursor {what} {
	[winfo toplevel [namespace tail $this]] configure -cursor $what
	::update idletasks
    }

    #
    # PUBLIC DATA
    #

    #
    #  PROTECTED DATA
    #

    # the tixTree widget for this class
    protected variable Tree  {}

    # the hlist of this widget
    protected variable Hlist {}

    # entry widgets which need to have their color changed back to black
    # when idle (used in conjunction with update)
    protected variable ChangeList {}

    protected variable ViewMenu
    protected variable Popup

    # These are for setting the indent level to an number of characters.
    # This will help clean the tree a little
    common EntryLength 15
    common Length 1
    common LengthString " "

    # These should be common... but deletion?
    # Display styles for HList
    protected variable HighlightTextStyle
    protected variable NormalTextStyle
    protected variable DisabledTextStyle
    
    protected variable Radix

    # Frame object for the selected frame
    protected variable _frame {}

    protected variable Editing {}
    protected variable EditEntry

    # Fencepost for enable/disable_ui and idle/busy hooks.
    protected variable Running 0

    # little queue for convenience
    protected variable _queue {}
}