9 set current_output_win .command.
text
11 option add
*Foreground White
12 option add
*Background Blue
14 proc echo
string {puts stdout
$string}
16 if [info exists env
(EDITOR
)] then
{
17 set editor
$env(EDITOR
)
24 # These functions are called by GDB (from C code) to do various things in
25 # TK-land. All start with the prefix `gdbtk_tcl_' to make them easy to find.
31 # gdbtk_tcl_fputs (text) - Output text to the command window
35 # GDB calls this to output TEXT to the GDB command window. The text is
36 # placed at the end of the text widget. Note that output may not occur,
37 # due to buffering. Use gdbtk_tcl_flush to cause an immediate update.
40 proc gdbtk_tcl_fputs
{arg
} {
41 global current_output_win
43 $current_output_win insert end
"$arg"
44 $current_output_win yview
-pickplace end
50 # gdbtk_tcl_flush () - Flush output to the command window
54 # GDB calls this to force all buffered text to the GDB command window.
57 proc gdbtk_tcl_flush
{} {
58 $current_output_win yview
-pickplace end
65 # gdbtk_tcl_query (message) - Create a yes/no query dialog box
69 # GDB calls this to create a yes/no dialog box containing MESSAGE. GDB
70 # is hung while the dialog box is active (ie: no commands will work),
71 # however windows can still be refreshed in case of damage or exposure.
74 proc gdbtk_tcl_query
{message} {
75 tk_dialog .query
"gdb : query" "$message" {} 1 "No" "Yes"
81 # gdbtk_start_variable_annotation (args ...) -
85 # Not yet implemented.
88 proc gdbtk_tcl_start_variable_annotation
{valaddr ref_type stor_cl cum_expr field type_cast
} {
89 echo
"gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast"
95 # gdbtk_end_variable_annotation (args ...) -
99 # Not yet implemented.
102 proc gdbtk_tcl_end_variable_annotation
{} {
103 echo gdbtk_tcl_end_variable_annotation
109 # gdbtk_tcl_breakpoint (action bpnum file line) - Notify the TK
110 # interface of changes to breakpoints.
114 # GDB calls this to notify TK of changes to breakpoints. ACTION is one
116 # create - Notify of breakpoint creation
117 # delete - Notify of breakpoint deletion
118 # enable - Notify of breakpoint enabling
119 # disable - Notify of breakpoint disabling
121 # All actions take the same set of arguments: BPNUM is the breakpoint
122 # number, FILE is the source file and LINE is the line number, and PC is
123 # the pc of the affected breakpoint.
126 proc gdbtk_tcl_breakpoint
{action bpnum
file line pc
} {
127 ${action
}_breakpoint
$bpnum $file $line $pc
130 proc asm_win_name
{funcname
} {
131 regsub -all {\.
} $funcname _ temp
133 return .asm.func_
${temp
}
139 # create_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
143 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
144 # land of breakpoint creation. This consists of recording the file and
145 # line number in the breakpoint_file and breakpoint_line arrays. Also,
146 # if there is already a window associated with FILE, it is updated with
150 proc create_breakpoint
{bpnum
file line pc
} {
152 global breakpoint_file
153 global breakpoint_line
154 global pos_to_breakpoint
155 global pos_to_bpcount
159 # Record breakpoint locations
161 set breakpoint_file
($bpnum) $file
162 set breakpoint_line
($bpnum) $line
163 set pos_to_breakpoint
($file:$line) $bpnum
164 if ![info exists pos_to_bpcount
($file:$line)] {
165 set pos_to_bpcount
($file:$line) 0
167 incr pos_to_bpcount
($file:$line)
168 set pos_to_breakpoint
($pc) $bpnum
169 if ![info exists pos_to_bpcount
($pc)] {
170 set pos_to_bpcount
($pc) 0
172 incr pos_to_bpcount
($pc)
174 # If there's a window for this file, update it
176 if [info exists wins
($file)] {
177 insert_breakpoint_tag
$wins($file) $line
180 # If there's an assembly window, update that too
182 set win
[asm_win_name
$cfunc]
183 if [winfo exists
$win] {
184 insert_breakpoint_tag
$win [pc_to_line
$pclist($cfunc) $pc]
191 # delete_breakpoint (bpnum file line pc) - Delete breakpoint info from TK land
195 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
196 # land of breakpoint destruction. This consists of removing the file and
197 # line number from the breakpoint_file and breakpoint_line arrays. Also,
198 # if there is already a window associated with FILE, the tags are removed
202 proc delete_breakpoint
{bpnum
file line pc
} {
204 global breakpoint_file
205 global breakpoint_line
206 global pos_to_breakpoint
207 global pos_to_bpcount
210 # Save line number and file for later
212 set line
$breakpoint_line($bpnum)
214 set file $breakpoint_file($bpnum)
216 # Reset breakpoint annotation info
218 if {$pos_to_bpcount($file:$line) > 0} {
219 decr pos_to_bpcount
($file:$line)
221 if {$pos_to_bpcount($file:$line) == 0} {
222 catch "unset pos_to_breakpoint($file:$line)"
224 unset breakpoint_file
($bpnum)
225 unset breakpoint_line
($bpnum)
227 # If there's a window for this file, update it
229 if [info exists wins
($file)] {
230 delete_breakpoint_tag
$wins($file) $line
235 # If there's an assembly window, update that too
237 if {$pos_to_bpcount($pc) > 0} {
238 decr pos_to_bpcount
($pc)
240 if {$pos_to_bpcount($pc) == 0} {
241 catch "unset pos_to_breakpoint($pc)"
243 set win
[asm_win_name
$cfunc]
244 if [winfo exists
$win] {
245 delete_breakpoint_tag
$win [pc_to_line
$pclist($cfunc) $pc]
254 # enable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
258 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
259 # land of a breakpoint being enabled. This consists of unstippling the
260 # specified breakpoint indicator.
263 proc enable_breakpoint
{bpnum
file line pc
} {
267 if [info exists wins
($file)] {
268 $wins($file) tag configure
$line -fgstipple {}
271 # If there's an assembly window, update that too
273 set win
[asm_win_name
$cfunc]
274 if [winfo exists
$win] {
275 $win tag configure
[pc_to_line
$pclist($cfunc) $pc] -fgstipple {}
282 # disable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
286 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
287 # land of a breakpoint being disabled. This consists of stippling the
288 # specified breakpoint indicator.
291 proc disable_breakpoint
{bpnum
file line pc
} {
295 if [info exists wins
($file)] {
296 $wins($file) tag configure
$line -fgstipple gray50
299 # If there's an assembly window, update that too
301 set win
[asm_win_name
$cfunc]
302 if [winfo exists
$win] {
303 $win tag configure
[pc_to_line
$pclist($cfunc) $pc] -fgstipple gray50
310 # insert_breakpoint_tag (win line) - Insert a breakpoint tag in WIN.
314 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to insert a
315 # breakpoint tag into window WIN at line LINE.
318 proc insert_breakpoint_tag
{win line
} {
319 $win configure
-state normal
321 $win insert
$line.0 "B"
322 $win tag add
$line $line.0
323 $win tag add delete
$line.0 "$line.0 lineend"
324 $win tag add margin
$line.0 "$line.0 lineend"
326 $win configure
-state disabled
332 # delete_breakpoint_tag (win line) - Remove a breakpoint tag from WIN.
336 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to remove a
337 # breakpoint tag from window WIN at line LINE.
340 proc delete_breakpoint_tag
{win line
} {
341 $win configure
-state normal
343 $win insert
$line.0 " "
344 $win tag delete
$line
345 $win tag add delete
$line.0 "$line.0 lineend"
346 $win tag add margin
$line.0 "$line.0 lineend"
347 $win configure
-state disabled
350 proc gdbtk_tcl_busy
{} {
351 .start configure
-state disabled
352 .stop configure
-state normal
353 .step configure
-state disabled
354 .next configure
-state disabled
355 .
continue configure
-state disabled
356 .finish configure
-state disabled
357 .quit configure
-state disabled
358 .up configure
-state disabled
359 .down configure
-state disabled
360 .bottom configure
-state disabled
361 .asm_but configure
-state disabled
362 .registers configure
-state disabled
363 .asm.stepi configure
-state disabled
364 .asm.nexti configure
-state disabled
365 .asm.
continue configure
-state disabled
366 .asm.finish configure
-state disabled
367 .asm.up configure
-state disabled
368 .asm.down configure
-state disabled
369 .asm.bottom configure
-state disabled
370 .asm.
close configure
-state disabled
373 proc gdbtk_tcl_idle
{} {
374 .start configure
-state normal
375 .stop configure
-state disabled
376 .step configure
-state normal
377 .next configure
-state normal
378 .
continue configure
-state normal
379 .finish configure
-state normal
380 .quit configure
-state normal
381 .up configure
-state normal
382 .down configure
-state normal
383 .bottom configure
-state normal
384 .asm_but configure
-state normal
385 .registers configure
-state normal
386 .asm.stepi configure
-state normal
387 .asm.nexti configure
-state normal
388 .asm.
continue configure
-state normal
389 .asm.finish configure
-state normal
390 .asm.up configure
-state normal
391 .asm.down configure
-state normal
392 .asm.bottom configure
-state normal
393 .asm.
close configure
-state normal
399 # decr (var val) - compliment to incr
404 proc decr
{var
{val
1}} {
406 set num
[expr $num - $val]
413 # pc_to_line (pclist pc) - convert PC to a line number.
417 # Convert PC to a line number from PCLIST. If exact line isn't found,
418 # we return the first line that starts before PC.
420 proc pc_to_line
{pclist pc
} {
421 set line
[lsearch -exact $pclist $pc]
423 if {$line >= 1} { return $line }
426 foreach linepc
[lrange $pclist 1 end
] {
427 if {$pc < $linepc} { decr line
; return $line }
430 return [expr $line - 1]
436 # file popup menu - Define the file popup menu.
440 # This menu just contains a bunch of buttons that do various things to
441 # the line under the cursor.
445 # Edit - Run the editor (specified by the environment variable EDITOR) on
446 # this file, at the current line.
447 # Breakpoint - Set a breakpoint at the current line. This just shoves
448 # a `break' command at GDB with the appropriate file and line
449 # number. Eventually, GDB calls us back (at gdbtk_tcl_breakpoint)
450 # to notify us of where the breakpoint needs to show up.
453 menu .file_popup
-cursor hand2
454 .file_popup add command
-label "Not yet set" -state disabled
455 .file_popup add separator
456 .file_popup add command
-label "Edit" -command {exec $editor +$selected_line $selected_file &}
457 .file_popup add command
-label "Set breakpoint" -command {gdb_cmd
"break $selected_file:$selected_line"}
462 # file popup menu - Define the file popup menu bindings.
466 # This defines the binding for the file popup menu. Currently, there is
467 # only one, which is activated when Button-1 is released. This causes
468 # the menu to be unposted, releases the grab for the menu, and then
469 # unhighlights the line under the cursor. After that, the selected menu
473 bind .file_popup
<Any-ButtonRelease-1
> {
476 # First, remove the menu, and release the pointer
479 grab release .file_popup
481 # Unhighlight the selected line
483 $selected_win tag delete breaktag
485 # Actually invoke the menubutton here!
493 # file_popup_menu (win x y xrel yrel) - Popup the file popup menu.
497 # This procedure is invoked as a result of a command binding in the
498 # listing window. It does several things:
499 # o - It highlights the line under the cursor.
500 # o - It pops up the file popup menu which is intended to do
501 # various things to the aforementioned line.
502 # o - Grabs the mouse for the file popup menu.
505 # Button 1 has been pressed in a listing window. Pop up a menu.
507 proc file_popup_menu
{win x y xrel yrel
} {
510 global file_to_debug_file
516 # Map TK window name back to file name.
518 set file $win_to_file($win)
520 set pos
[$win index
@$xrel,$yrel]
522 # Record selected file and line for menu button actions
524 set selected_file
$file_to_debug_file($file)
525 set selected_line
[lindex [split $pos .
] 0]
526 set selected_win
$win
528 # Highlight the selected line
530 eval $win tag config breaktag
$highlight
531 $win tag add breaktag
"$pos linestart" "$pos linestart + 1l"
533 # Post the menu near the pointer, (and grab it)
535 .file_popup entryconfigure
0 -label "$selected_file:$selected_line"
536 .file_popup post
[expr $x-[winfo width .file_popup
]/2] [expr $y-10]
543 # listing_window_button_1 (win x y xrel yrel) - Handle button 1 in listing window
547 # This procedure is invoked as a result of holding down button 1 in the
548 # listing window. The action taken depends upon where the button was
549 # pressed. If it was in the left margin (the breakpoint column), it
550 # sets or clears a breakpoint. In the main text area, it will pop up a
554 proc listing_window_button_1
{win x y xrel yrel
} {
557 global file_to_debug_file
562 global pos_to_breakpoint
564 # Map TK window name back to file name.
566 set file $win_to_file($win)
568 set pos
[split [$win index
@$xrel,$yrel] .
]
570 # Record selected file and line for menu button actions
572 set selected_file
$file_to_debug_file($file)
573 set selected_line
[lindex $pos 0]
574 set selected_col
[lindex $pos 1]
575 set selected_win
$win
577 # If we're in the margin, then toggle the breakpoint
579 if {$selected_col < 8} {
580 set pos_break
$selected_file:$selected_line
581 set pos
$file:$selected_line
582 set tmp pos_to_breakpoint
($pos)
583 if [info exists
$tmp] {
585 gdb_cmd
"delete $bpnum"
587 gdb_cmd
"break $pos_break"
592 # Post the menu near the pointer, (and grab it)
594 .file_popup entryconfigure
0 -label "$selected_file:$selected_line"
595 .file_popup post
[expr $x-[winfo width .file_popup
]/2] [expr $y-10]
602 # asm_window_button_1 (win x y xrel yrel) - Handle button 1 in asm window
606 # This procedure is invoked as a result of holding down button 1 in the
607 # assembly window. The action taken depends upon where the button was
608 # pressed. If it was in the left margin (the breakpoint column), it
609 # sets or clears a breakpoint. In the main text area, it will pop up a
613 proc asm_window_button_1
{win x y xrel yrel
} {
616 global file_to_debug_file
621 global pos_to_breakpoint
625 set pos
[split [$win index
@$xrel,$yrel] .
]
627 # Record selected file and line for menu button actions
629 set selected_line
[lindex $pos 0]
630 set selected_col
[lindex $pos 1]
631 set selected_win
$win
635 set pc
[lindex $pclist($cfunc) $selected_line]
637 # If we're in the margin, then toggle the breakpoint
639 if {$selected_col < 8} {
640 set tmp pos_to_breakpoint
($pc)
641 if [info exists
$tmp] {
643 gdb_cmd
"delete $bpnum"
650 # Post the menu near the pointer, (and grab it)
652 # .file_popup entryconfigure 0 -label "$selected_file:$selected_line"
653 # .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10]
660 # do_nothing - Does absoultely nothing.
664 # This procedure does nothing. It is used as a placeholder to allow
665 # the disabling of bindings that would normally be inherited from the
666 # parent widget. I can't think of any other way to do this.
669 proc do_nothing
{} {}
674 # create_expr_win - Creat expression display window
678 # Create the expression display window.
681 proc create_expr_win
{} {
684 wm title .
expr Expression
685 canvas .
expr.c
-yscrollcommand {.
expr.scroll
set} -cursor hand2
\
686 -borderwidth 2 -relief groove
687 scrollbar .
expr.scroll
-orient vertical
-command {.
expr.c yview
}
688 entry .
expr.
entry -borderwidth 2 -relief groove
690 pack .
expr.
entry -side bottom
-fill x
691 pack .
expr.c
-side left
-fill both
-expand yes
692 pack .
expr.scroll
-side right
-fill y
694 .
expr.c create
text 100 0 -text "Text string"
695 .
expr.c create rectangle
245 195 255 205 -outline black
-fill white
701 # display_expression (expression) - Display EXPRESSION in display window
705 # Display EXPRESSION and it's value in the expression display window.
708 proc display_expression
{expression
} {
709 if ![winfo exists .
expr] {create_expr_win
}
717 # create_file_win (filename) - Create a win for FILENAME.
721 # The new text widget.
725 # This procedure creates a text widget for FILENAME. It returns the
726 # newly created widget. First, a text widget is created, and given basic
727 # configuration info. Second, all the bindings are setup. Third, the
728 # file FILENAME is read into the text widget. Fourth, margins and line
732 proc create_file_win
{filename} {
733 global breakpoint_file
734 global breakpoint_line
736 # Replace all the dirty characters in $filename with clean ones, and generate
737 # a unique name for the text widget.
739 regsub -all {\.|
/} $filename {} temp
742 # Open the file, and read it into the text widget
744 if [catch "open $filename" fh
] {
745 # File can't be read. Put error message into .nofile window and return.
747 catch {destroy .nofile
}
748 text .nofile
-height 25 -width 80 -relief raised
-borderwidth 2 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
749 .nofile insert
0.0 $fh
750 .nofile configure
-state disabled
751 bind .nofile
<1> do_nothing
752 bind .nofile
<B1-Motion
> do_nothing
756 # Actually create and do basic configuration on the text widget.
758 text $win -height 25 -width 80 -relief raised
-borderwidth 2 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
760 # Setup all the bindings
762 bind $win <Enter
> {focus %W
}
763 # bind $win <1> {listing_window_button_1 %W %X %Y %x %y}
764 bind $win <1> do_nothing
765 bind $win <B1-Motion
> do_nothing
767 bind $win n
{gdb_cmd next
; update_ptr
}
768 bind $win s
{gdb_cmd step
; update_ptr
}
769 bind $win c
{gdb_cmd
continue ; update_ptr
}
770 bind $win f
{gdb_cmd finish
; update_ptr
}
771 bind $win u
{gdb_cmd up
; update_ptr
}
772 bind $win d
{gdb_cmd down
; update_ptr
}
775 $win insert
0.0 [read $fh]
778 # Add margins (for annotations) and a line number to each line
780 set numlines
[$win index end
]
781 set numlines
[lindex [split $numlines .
] 0]
782 for {set i
1} {$i <= $numlines} {incr i
} {
783 $win insert
$i.0 [format " %4d " $i]
784 $win tag add margin
$i.0 $i.8
785 $win tag add
source $i.8 "$i.0 lineend"
788 $win tag
bind margin
<1> {listing_window_button_1
%W
%X
%Y
%x
%y
}
789 $win tag
bind source <1> {
790 %W mark
set anchor
"@%x,%y wordstart"
791 set last
[%W index
"@%x,%y wordend"]
792 %W tag remove sel
0.0 anchor
793 %W tag remove sel
$last end
794 %W tag add sel anchor
$last
796 # $win tag bind source <Double-Button-1> {
797 # %W mark set anchor "@%x,%y wordstart"
798 # set last [%W index "@%x,%y wordend"]
799 # %W tag remove sel 0.0 anchor
800 # %W tag remove sel $last end
801 # %W tag add sel anchor $last
802 # echo "Selected [selection get]"
804 $win tag
bind source <B1-Motion
> {
805 %W tag remove sel
0.0 anchor
806 %W tag remove sel
$last end
807 %W tag add sel anchor
@%x
,%y
809 $win tag
bind sel
<1> do_nothing
810 $win tag
bind sel
<Double-Button-1
> {display_expression
[selection get
]}
814 # Scan though the breakpoint data base and install any destined for this file
816 foreach bpnum
[array names breakpoint_file
] {
817 if {$breakpoint_file($bpnum) == $filename} {
818 insert_breakpoint_tag
$win $breakpoint_line($bpnum)
822 # Disable the text widget to prevent user modifications
824 $win configure
-state disabled
831 # create_asm_win (funcname pc) - Create an assembly win for FUNCNAME.
835 # The new text widget.
839 # This procedure creates a text widget for FUNCNAME. It returns the
840 # newly created widget. First, a text widget is created, and given basic
841 # configuration info. Second, all the bindings are setup. Third, the
842 # function FUNCNAME is read into the text widget.
845 proc create_asm_win
{funcname pc
} {
846 global breakpoint_file
847 global breakpoint_line
848 global current_output_win
851 # Replace all the dirty characters in $filename with clean ones, and generate
852 # a unique name for the text widget.
854 set win
[asm_win_name
$funcname]
856 # Actually create and do basic configuration on the text widget.
858 text $win -height 25 -width 80 -relief raised
-borderwidth 2 \
859 -setgrid true
-cursor hand2
-yscrollcommand asmscrollproc
861 # Setup all the bindings
863 bind $win <Enter
> {focus %W
}
864 bind $win <1> {asm_window_button_1
%W
%X
%Y
%x
%y
}
865 bind $win <B1-Motion
> do_nothing
866 bind $win n
{gdb_cmd nexti
; update_ptr
}
867 bind $win s
{gdb_cmd stepi
; update_ptr
}
868 bind $win c
{gdb_cmd
continue ; update_ptr
}
869 bind $win f
{gdb_cmd finish
; update_ptr
}
870 bind $win u
{gdb_cmd up
; update_ptr
}
871 bind $win d
{gdb_cmd down
; update_ptr
}
873 # Disassemble the code, and read it into the new text widget
875 set current_output_win
$win
876 gdb_cmd
"disassemble $pc"
877 set current_output_win .command.
text
879 set numlines
[$win index end
]
880 set numlines
[lindex [split $numlines .
] 0]
883 # Delete the first and last lines, cuz these contain useless info
886 $win delete
{end
- 1 lines
} end
889 # Add margins (for annotations) and note the PC for each line
891 catch "unset pclist($funcname)"
892 lappend pclist
($funcname) Unused
893 for {set i
1} {$i <= $numlines} {incr i
} {
894 scan [$win get
$i.0 "$i.0 lineend"] "%s " pc
895 lappend pclist
($funcname) $pc
900 # Scan though the breakpoint data base and install any destined for this file
902 # foreach bpnum [array names breakpoint_file] {
903 # if {$breakpoint_file($bpnum) == $filename} {
904 # insert_breakpoint_tag $win $breakpoint_line($bpnum)
908 # Disable the text widget to prevent user modifications
910 $win configure
-state disabled
917 # asmscrollproc (WINHEIGHT SCREENHEIGHT SCREENTOP SCREENBOT) - Update the
918 # asm window scrollbar.
922 # This procedure is called to update the assembler window's scrollbar.
925 proc asmscrollproc
{args
} {
926 global asm_screen_height asm_screen_top asm_screen_bot
928 eval ".asm.scroll set $args"
929 set asm_screen_height
[lindex $args 1]
930 set asm_screen_top
[lindex $args 2]
931 set asm_screen_bot
[lindex $args 3]
937 # update_listing (linespec) - Update the listing window according to
942 # This procedure is called from various places to update the listing
943 # window based on LINESPEC. It is usually invoked with the result of
946 # It will move the cursor, and scroll the text widget if necessary.
947 # Also, it will switch to another text widget if necessary, and update
948 # the label widget too.
950 # LINESPEC is a list of the form:
952 # { DEBUG_FILE FUNCNAME FILENAME LINE }, where:
954 # DEBUG_FILE - is the abbreviated form of the file name. This is usually
955 # the file name string given to the cc command. This is
956 # primarily needed for breakpoint commands, and when an
957 # abbreviated for of the filename is desired.
958 # FUNCNAME - is the name of the function.
959 # FILENAME - is the fully qualified (absolute) file name. It is usually
960 # the same as $PWD/$DEBUG_FILE, where PWD is the working dir
961 # at the time the cc command was given. This is used to
962 # actually locate the file to be displayed.
963 # LINE - The line number to be displayed.
965 # Usually, this procedure will just move the cursor one line down to the
966 # next line to be executed. However, if the cursor moves out of range
967 # or into another file, it will scroll the text widget so that the line
968 # of interest is in the middle of the viewable portion of the widget.
971 proc update_listing
{linespec
} {
979 global file_to_debug_file
981 # Rip the linespec apart
983 set line
[lindex $linespec 3]
984 set filename [lindex $linespec 2]
985 set funcname
[lindex $linespec 1]
986 set debug_file
[lindex $linespec 0]
988 # Sometimes there's no source file for this location
990 if {$filename == ""} {set filename Blank
}
992 # If we want to switch files, we need to unpack the current text widget, and
993 # stick in the new one.
995 if {$filename != $cfile} then
{
996 pack forget
$wins($cfile)
999 # Create a text widget for this file if necessary
1001 if ![info exists wins
($cfile)] then
{
1002 set wins
($cfile) [create_file_win
$cfile]
1003 if {$wins($cfile) != ".nofile"} {
1004 set win_to_file
($wins($cfile)) $cfile
1005 set file_to_debug_file
($cfile) $debug_file
1006 set pointers
($cfile) 1.1
1010 # Pack the text widget into the listing widget, and scroll to the right place
1012 pack $wins($cfile) -side left
-expand yes
-in .listing
-fill both
-after .
label
1013 $wins($cfile) yview
[expr $line - $screen_height / 2]
1016 # Update the label widget in case the filename or function name has changed
1018 if {$current_label != "$filename.$funcname"} then
{
1019 set tail
[expr [string last
/ $filename] + 1]
1020 .
label configure
-text "[string range $filename $tail end] : ${funcname}()"
1021 set current_label
$filename.
$funcname
1024 # Update the pointer, scrolling the text widget if necessary to keep the
1025 # pointer in an acceptable part of the screen.
1027 if [info exists pointers
($cfile)] then
{
1028 $wins($cfile) configure
-state normal
1029 set pointer_pos
$pointers($cfile)
1030 $wins($cfile) configure
-state normal
1031 $wins($cfile) delete
$pointer_pos
1032 $wins($cfile) insert
$pointer_pos " "
1034 set pointer_pos
[$wins($cfile) index
$line.1]
1035 set pointers
($cfile) $pointer_pos
1037 $wins($cfile) delete
$pointer_pos
1038 $wins($cfile) insert
$pointer_pos "\xbb"
1040 if {$line < $screen_top + 1
1041 ||
$line > $screen_bot} then
{
1042 $wins($cfile) yview
[expr $line - $screen_height / 2]
1045 $wins($cfile) configure
-state disabled
1052 # update_ptr - Update the listing window.
1056 # This routine will update the listing window using the result of
1060 proc update_ptr
{} {update_listing
[gdb_loc
]}
1065 # asm_command - Open up the assembly window.
1069 # Create an assembly window if it doesn't exist.
1072 proc asm_command
{} {
1075 if ![winfo exists .asm
] {
1077 set win
[asm_win_name
$cfunc]
1081 wm title .asm Assembly
1083 label .asm.
label -text "*NIL*" -borderwidth 2 -relief raised
1084 text $win -height 25 -width 80 -relief raised
-borderwidth 2 \
1085 -setgrid true
-cursor hand2
\
1086 -yscrollcommand asmscrollproc
1087 scrollbar .asm.scroll
-orient vertical
\
1088 -command {[asm_win_name
$cfunc] yview
}
1091 button .asm.stepi
-text Stepi
\
1092 -command {gdb_cmd stepi
; update_ptr
}
1093 button .asm.nexti
-text Nexti
\
1094 -command {gdb_cmd nexti
; update_ptr
}
1095 button .asm.
continue -text Continue
\
1096 -command {gdb_cmd
continue ; update_ptr
}
1097 button .asm.finish
-text Finish
\
1098 -command {gdb_cmd finish
; update_ptr
}
1099 button .asm.up
-text Up
-command {gdb_cmd up
; update_ptr
}
1100 button .asm.down
-text Down
\
1101 -command {gdb_cmd down
; update_ptr
}
1102 button .asm.bottom
-text Bottom
\
1103 -command {gdb_cmd
{frame 0} ; update_ptr
}
1104 button .asm.
close -text Close
-command {destroy .asm
}
1106 pack .asm.
label -side top
-fill x
1107 pack .asm.stepi .asm.nexti .asm.
continue .asm.finish .asm.up
\
1108 .asm.down .asm.bottom .asm.
close -side left
-in .asm.buts
1109 pack .asm.buts
-side top
-fill x
1110 pack $win -side left
-expand yes
-fill both
1111 pack .asm.scroll
-side left
-fill y
1120 # registers_command - Open up the register display window.
1124 # Create the register display window, with automatic updates.
1127 proc registers_command
{} {
1130 if ![winfo exists .reg
] {
1133 wm title .reg Registers
1136 text $win -height 41 -width 45 -relief raised
\
1138 -setgrid true
-cursor hand2
1140 pack $win -side left
-expand yes
-fill both
1149 # update_registers - Update the registers window.
1153 # This procedure updates the registers window.
1156 proc update_registers
{} {
1157 global current_output_win
1161 $win configure
-state normal
1165 set current_output_win
$win
1166 gdb_cmd
"info registers"
1167 set current_output_win .command.
text
1170 $win configure
-state disabled
1176 # update_assembly - Update the assembly window.
1180 # This procedure updates the assembly window.
1183 proc update_assembly
{linespec
} {
1185 global screen_height
1189 global current_label
1191 global file_to_debug_file
1192 global current_asm_label
1194 global asm_screen_height asm_screen_top asm_screen_bot
1196 # Rip the linespec apart
1198 set pc
[lindex $linespec 4]
1199 set line
[lindex $linespec 3]
1200 set filename [lindex $linespec 2]
1201 set funcname
[lindex $linespec 1]
1202 set debug_file
[lindex $linespec 0]
1204 set win
[asm_win_name
$cfunc]
1206 # Sometimes there's no source file for this location
1208 if {$filename == ""} {set filename Blank
}
1210 # If we want to switch funcs, we need to unpack the current text widget, and
1211 # stick in the new one.
1213 if {$funcname != $cfunc } {
1217 set win
[asm_win_name
$cfunc]
1219 # Create a text widget for this func if necessary
1221 if {![winfo exists
$win]} {
1222 create_asm_win
$cfunc $pc
1223 set asm_pointers
($cfunc) 1.1
1224 set current_asm_label NIL
1227 # Pack the text widget, and scroll to the right place
1229 pack $win -side left
-expand yes
-fill both
\
1231 set line
[pc_to_line
$pclist($cfunc) $pc]
1232 $win yview
[expr $line - $asm_screen_height / 2]
1235 # Update the label widget in case the filename or function name has changed
1237 if {$current_asm_label != "$pc $funcname"} then
{
1238 .asm.
label configure
-text "$pc $funcname"
1239 set current_asm_label
"$pc $funcname"
1242 # Update the pointer, scrolling the text widget if necessary to keep the
1243 # pointer in an acceptable part of the screen.
1245 if [info exists asm_pointers
($cfunc)] then
{
1246 $win configure
-state normal
1247 set pointer_pos
$asm_pointers($cfunc)
1248 $win configure
-state normal
1249 $win delete
$pointer_pos
1250 $win insert
$pointer_pos " "
1252 # Map the PC back to a line in the window
1254 set line
[pc_to_line
$pclist($cfunc) $pc]
1257 echo
"Can't find PC $pc"
1261 set pointer_pos
[$win index
$line.1]
1262 set asm_pointers
($cfunc) $pointer_pos
1264 $win delete
$pointer_pos
1265 $win insert
$pointer_pos "\xbb"
1267 if {$line < $asm_screen_top + 1
1268 ||
$line > $asm_screen_bot} then
{
1269 $win yview
[expr $line - $asm_screen_height / 2]
1272 # echo "Picking line $line"
1273 # $win yview -pickplace $line
1275 $win configure
-state disabled
1279 proc update_ptr
{} {
1280 update_listing
[gdb_loc
]
1281 if [winfo exists .asm
] {
1282 update_assembly
[gdb_loc
]
1284 if [winfo exists .reg
] {
1292 # listing window - Define the listing window.
1298 # Setup listing window
1304 label .
label -text "*No file*" -borderwidth 2 -relief raised
1305 text $wins($cfile) -height 25 -width 80 -relief raised
-borderwidth 2 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
1306 scrollbar .scroll
-orient vertical
-command {$wins($cfile) yview
}
1308 if {[tk colormodel .
text] == "color"} {
1309 set highlight
"-background red2 -borderwidth 2 -relief sunk"
1311 set fg
[lindex [.
text config
-foreground] 4]
1312 set bg
[lindex [.
text config
-background] 4]
1313 set highlight
"-foreground $bg -background $fg -borderwidth 0"
1316 proc textscrollproc
{args
} {global screen_height screen_top screen_bot
1317 eval ".scroll set $args"
1318 set screen_height
[lindex $args 1]
1319 set screen_top
[lindex $args 2]
1320 set screen_bot
[lindex $args 3]}
1322 $wins($cfile) insert
0.0 " This page intentionally left blank."
1323 $wins($cfile) configure
-state disabled
1325 pack .
label -side bottom
-fill x
-in .listing
1326 pack $wins($cfile) -side left
-expand yes
-in .listing
-fill both
1327 pack .scroll
-side left
-fill y
-in .listing
1329 button .start
-text Start
-command \
1330 {gdb_cmd
{break main
}
1331 gdb_cmd
{enable delete
$bpnum}
1334 button .stop
-text Stop
-fg red
-activeforeground red
-state disabled
-command gdb_stop
1335 button .step
-text Step
-command {gdb_cmd step
; update_ptr
}
1336 button .next
-text Next
-command {gdb_cmd next
; update_ptr
}
1337 button .
continue -text Continue
-command {gdb_cmd
continue ; update_ptr
}
1338 button .finish
-text Finish
-command {gdb_cmd finish
; update_ptr
}
1339 #button .test -text Test -command {echo [info var]}
1340 button .quit
-text Quit
-command {gdb_cmd quit
}
1341 button .up
-text Up
-command {gdb_cmd up
; update_ptr
}
1342 button .down
-text Down
-command {gdb_cmd down
; update_ptr
}
1343 button .bottom
-text Bottom
-command {gdb_cmd
{frame 0} ; update_ptr
}
1344 button .asm_but
-text Asm
-command {asm_command
; update_ptr
}
1345 button .registers
-text Regs
-command {registers_command
; update_ptr
}
1347 proc files_command
{} {
1348 toplevel .files_window
1350 wm minsize .files_window
1 1
1351 # wm overrideredirect .files_window true
1352 listbox .files_window.
list -geometry 30x20
-setgrid true
1353 button .files_window.
close -text Close
-command {destroy .files_window
}
1354 tk_listboxSingleSelect .files_window.
list
1355 eval .files_window.
list insert
0 [lsort [gdb_listfiles
]]
1356 pack .files_window.
list -side top
-fill both
-expand yes
1357 pack .files_window.
close -side bottom
-fill x
-expand no
-anchor s
1358 bind .files_window.
list <Any-ButtonRelease-1
> {
1359 set file [%W get
[%W curselection
]]
1360 gdb_cmd
"list $file:1,0"
1361 update_listing
[gdb_loc
$file:1]
1362 destroy .files_window
}
1365 button .files
-text Files
-command files_command
1367 pack .listing
-side bottom
-fill both
-expand yes
1368 #pack .test -side bottom -fill x
1369 pack .start .stop .step .next .
continue .finish .up .down .bottom .asm_but
\
1370 .registers .files .quit
-side left
1372 wm title .command Command
1374 # Setup command window
1376 label .command.
label -text "* Command Buffer *" -borderwidth 2 -relief raised
1377 text .command.
text -height 25 -width 80 -relief raised
-borderwidth 2 -setgrid true
-cursor hand2
-yscrollcommand {.command.scroll
set}
1378 scrollbar .command.scroll
-orient vertical
-command {.command.
text yview
}
1380 pack .command.
label -side top
-fill x
1381 pack .command.
text -side left
-expand yes
-fill both
1382 pack .command.scroll
-side right
-fill y
1386 gdb_cmd
{set language c
}
1387 gdb_cmd
{set height
0}
1388 gdb_cmd
{set width
0}
1390 bind .command.
text <Enter
> {focus %W
}
1391 bind .command.
text <Delete
> {delete_char
%W
}
1392 bind .command.
text <BackSpace
> {delete_char
%W
}
1393 bind .command.
text <Control-u
> {delete_line
%W
}
1394 bind .command.
text <Any-Key
> {
1398 %W yview
-pickplace end
1399 append command_line
%A
1401 bind .command.
text <Key-Return
> {
1405 %W yview
-pickplace end
1406 gdb_cmd
$command_line
1409 %W insert end
"(gdb) "
1410 %W yview
-pickplace end
1413 proc delete_char
{win
} {
1416 tk_textBackspace
$win
1417 $win yview
-pickplace insert
1418 set tmp
[expr [string length
$command_line] - 2]
1419 set command_line
[string range
$command_line 0 $tmp]
1422 proc delete_line
{win
} {
1425 $win delete
{end linestart
+ 6 chars
} end
1426 $win yview
-pickplace insert
1430 wm minsize .command
1 1