4 set wins
($cfile) .src.
text
9 set current_output_win .cmd.
text
11 #option add *Foreground Black
12 #option add *Background White
13 #option add *Font -*-*-medium-r-normal--18-*-*-*-m-*-*-1
14 tk colormodel . monochrome
16 proc echo
string {puts stdout
$string}
18 if [info exists env
(EDITOR
)] then
{
19 set editor
$env(EDITOR
)
26 # These functions are called by GDB (from C code) to do various things in
27 # TK-land. All start with the prefix `gdbtk_tcl_' to make them easy to find.
33 # gdbtk_tcl_fputs (text) - Output text to the command window
37 # GDB calls this to output TEXT to the GDB command window. The text is
38 # placed at the end of the text widget. Note that output may not occur,
39 # due to buffering. Use gdbtk_tcl_flush to cause an immediate update.
42 proc gdbtk_tcl_fputs
{arg
} {
43 global current_output_win
45 $current_output_win insert end
"$arg"
46 $current_output_win yview
-pickplace end
52 # gdbtk_tcl_flush () - Flush output to the command window
56 # GDB calls this to force all buffered text to the GDB command window.
59 proc gdbtk_tcl_flush
{} {
60 $current_output_win yview
-pickplace end
67 # gdbtk_tcl_query (message) - Create a yes/no query dialog box
71 # GDB calls this to create a yes/no dialog box containing MESSAGE. GDB
72 # is hung while the dialog box is active (ie: no commands will work),
73 # however windows can still be refreshed in case of damage or exposure.
76 proc gdbtk_tcl_query
{message} {
77 tk_dialog .query
"gdb : query" "$message" {} 1 "No" "Yes"
83 # gdbtk_start_variable_annotation (args ...) -
87 # Not yet implemented.
90 proc gdbtk_tcl_start_variable_annotation
{valaddr ref_type stor_cl cum_expr field type_cast
} {
91 echo
"gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast"
97 # gdbtk_end_variable_annotation (args ...) -
101 # Not yet implemented.
104 proc gdbtk_tcl_end_variable_annotation
{} {
105 echo gdbtk_tcl_end_variable_annotation
111 # gdbtk_tcl_breakpoint (action bpnum file line) - Notify the TK
112 # interface of changes to breakpoints.
116 # GDB calls this to notify TK of changes to breakpoints. ACTION is one
118 # create - Notify of breakpoint creation
119 # delete - Notify of breakpoint deletion
120 # enable - Notify of breakpoint enabling
121 # disable - Notify of breakpoint disabling
123 # All actions take the same set of arguments: BPNUM is the breakpoint
124 # number, FILE is the source file and LINE is the line number, and PC is
125 # the pc of the affected breakpoint.
128 proc gdbtk_tcl_breakpoint
{action bpnum
file line pc
} {
129 ${action
}_breakpoint
$bpnum $file $line $pc
132 proc asm_win_name
{funcname
} {
133 regsub -all {\.
} $funcname _ temp
135 return .asm.func_
${temp
}
141 # create_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
145 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
146 # land of breakpoint creation. This consists of recording the file and
147 # line number in the breakpoint_file and breakpoint_line arrays. Also,
148 # if there is already a window associated with FILE, it is updated with
152 proc create_breakpoint
{bpnum
file line pc
} {
154 global breakpoint_file
155 global breakpoint_line
156 global pos_to_breakpoint
157 global pos_to_bpcount
161 # Record breakpoint locations
163 set breakpoint_file
($bpnum) $file
164 set breakpoint_line
($bpnum) $line
165 set pos_to_breakpoint
($file:$line) $bpnum
166 if ![info exists pos_to_bpcount
($file:$line)] {
167 set pos_to_bpcount
($file:$line) 0
169 incr pos_to_bpcount
($file:$line)
170 set pos_to_breakpoint
($pc) $bpnum
171 if ![info exists pos_to_bpcount
($pc)] {
172 set pos_to_bpcount
($pc) 0
174 incr pos_to_bpcount
($pc)
176 # If there's a window for this file, update it
178 if [info exists wins
($file)] {
179 insert_breakpoint_tag
$wins($file) $line
182 # If there's an assembly window, update that too
184 set win
[asm_win_name
$cfunc]
185 if [winfo exists
$win] {
186 insert_breakpoint_tag
$win [pc_to_line
$pclist($cfunc) $pc]
193 # delete_breakpoint (bpnum file line pc) - Delete breakpoint info from TK land
197 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
198 # land of breakpoint destruction. This consists of removing the file and
199 # line number from the breakpoint_file and breakpoint_line arrays. Also,
200 # if there is already a window associated with FILE, the tags are removed
204 proc delete_breakpoint
{bpnum
file line pc
} {
206 global breakpoint_file
207 global breakpoint_line
208 global pos_to_breakpoint
209 global pos_to_bpcount
212 # Save line number and file for later
214 set line
$breakpoint_line($bpnum)
216 set file $breakpoint_file($bpnum)
218 # Reset breakpoint annotation info
220 if {$pos_to_bpcount($file:$line) > 0} {
221 decr pos_to_bpcount
($file:$line)
223 if {$pos_to_bpcount($file:$line) == 0} {
224 catch "unset pos_to_breakpoint($file:$line)"
226 unset breakpoint_file
($bpnum)
227 unset breakpoint_line
($bpnum)
229 # If there's a window for this file, update it
231 if [info exists wins
($file)] {
232 delete_breakpoint_tag
$wins($file) $line
237 # If there's an assembly window, update that too
239 if {$pos_to_bpcount($pc) > 0} {
240 decr pos_to_bpcount
($pc)
242 if {$pos_to_bpcount($pc) == 0} {
243 catch "unset pos_to_breakpoint($pc)"
245 set win
[asm_win_name
$cfunc]
246 if [winfo exists
$win] {
247 delete_breakpoint_tag
$win [pc_to_line
$pclist($cfunc) $pc]
256 # enable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
260 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
261 # land of a breakpoint being enabled. This consists of unstippling the
262 # specified breakpoint indicator.
265 proc enable_breakpoint
{bpnum
file line pc
} {
269 if [info exists wins
($file)] {
270 $wins($file) tag configure
$line -fgstipple {}
273 # If there's an assembly window, update that too
275 set win
[asm_win_name
$cfunc]
276 if [winfo exists
$win] {
277 $win tag configure
[pc_to_line
$pclist($cfunc) $pc] -fgstipple {}
284 # disable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land
288 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to notify TK
289 # land of a breakpoint being disabled. This consists of stippling the
290 # specified breakpoint indicator.
293 proc disable_breakpoint
{bpnum
file line pc
} {
297 if [info exists wins
($file)] {
298 $wins($file) tag configure
$line -fgstipple gray50
301 # If there's an assembly window, update that too
303 set win
[asm_win_name
$cfunc]
304 if [winfo exists
$win] {
305 $win tag configure
[pc_to_line
$pclist($cfunc) $pc] -fgstipple gray50
312 # insert_breakpoint_tag (win line) - Insert a breakpoint tag in WIN.
316 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to insert a
317 # breakpoint tag into window WIN at line LINE.
320 proc insert_breakpoint_tag
{win line
} {
321 $win configure
-state normal
323 $win insert
$line.0 "B"
324 $win tag add
$line $line.0
325 $win tag add delete
$line.0 "$line.0 lineend"
326 $win tag add margin
$line.0 "$line.0 lineend"
328 $win configure
-state disabled
334 # delete_breakpoint_tag (win line) - Remove a breakpoint tag from WIN.
338 # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to remove a
339 # breakpoint tag from window WIN at line LINE.
342 proc delete_breakpoint_tag
{win line
} {
343 $win configure
-state normal
345 if {[string range
$win 0 3] == ".src"} then
{
346 $win insert
$line.0 "\xa4"
348 $win insert
$line.0 " "
350 $win tag delete
$line
351 $win tag add delete
$line.0 "$line.0 lineend"
352 $win tag add margin
$line.0 "$line.0 lineend"
353 $win configure
-state disabled
356 proc gdbtk_tcl_busy
{} {
357 .src.start configure
-state disabled
358 .src.stop configure
-state normal
359 .src.step configure
-state disabled
360 .src.next configure
-state disabled
361 .src.
continue configure
-state disabled
362 .src.finish configure
-state disabled
363 .src.up configure
-state disabled
364 .src.down configure
-state disabled
365 .src.bottom configure
-state disabled
366 .asm.stepi configure
-state disabled
367 .asm.nexti configure
-state disabled
368 .asm.
continue configure
-state disabled
369 .asm.finish configure
-state disabled
370 .asm.up configure
-state disabled
371 .asm.down configure
-state disabled
372 .asm.bottom configure
-state disabled
373 .asm.
close configure
-state disabled
376 proc gdbtk_tcl_idle
{} {
377 .src.start configure
-state normal
378 .src.stop configure
-state disabled
379 .src.step configure
-state normal
380 .src.next configure
-state normal
381 .src.
continue configure
-state normal
382 .src.finish configure
-state normal
383 .src.up configure
-state normal
384 .src.down configure
-state normal
385 .src.bottom 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 < 11} {
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 debug_file
} {
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
740 set win .src.
text$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 .src.nofile window and return.
747 catch {destroy .src.nofile
}
748 text .src.nofile
-height 25 -width 88 -relief raised
\
749 -borderwidth 2 -yscrollcommand textscrollproc
\
750 -setgrid true
-cursor hand2
751 .src.nofile insert
0.0 $fh
752 .src.nofile configure
-state disabled
753 bind .src.nofile
<1> do_nothing
754 bind .src.nofile
<B1-Motion
> do_nothing
758 # Actually create and do basic configuration on the text widget.
760 text $win -height 25 -width 88 -relief raised
-borderwidth 2 \
761 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
763 # Setup all the bindings
765 bind $win <Enter
> {focus %W
}
766 # bind $win <1> {listing_window_button_1 %W %X %Y %x %y}
767 bind $win <1> do_nothing
768 bind $win <B1-Motion
> do_nothing
770 bind $win n
{gdb_cmd next
; update_ptr
}
771 bind $win s
{gdb_cmd step
; update_ptr
}
772 bind $win c
{gdb_cmd
continue ; update_ptr
}
773 bind $win f
{gdb_cmd finish
; update_ptr
}
774 bind $win u
{gdb_cmd up
; update_ptr
}
775 bind $win d
{gdb_cmd down
; update_ptr
}
778 $win insert
0.0 [read $fh]
781 # Add margins (for annotations) and a line number to each line
783 set numlines
[$win index end
]
784 set numlines
[lindex [split $numlines .
] 0]
785 for {set i
1} {$i <= $numlines} {incr i
} {
786 $win insert
$i.0 [format " %4d " $i]
787 $win tag add
source $i.8 "$i.0 lineend"
792 foreach i
[gdb_sourcelines
$debug_file] {
794 $win insert
$i.0 "\xa4"
795 $win tag add margin
$i.0 $i.8
798 $win tag
bind margin
<1> {listing_window_button_1
%W
%X
%Y
%x
%y
}
799 $win tag
bind source <1> {
800 %W mark
set anchor
"@%x,%y wordstart"
801 set last
[%W index
"@%x,%y wordend"]
802 %W tag remove sel
0.0 anchor
803 %W tag remove sel
$last end
804 %W tag add sel anchor
$last
806 # $win tag bind source <Double-Button-1> {
807 # %W mark set anchor "@%x,%y wordstart"
808 # set last [%W index "@%x,%y wordend"]
809 # %W tag remove sel 0.0 anchor
810 # %W tag remove sel $last end
811 # %W tag add sel anchor $last
812 # echo "Selected [selection get]"
814 $win tag
bind source <B1-Motion
> {
815 %W tag remove sel
0.0 anchor
816 %W tag remove sel
$last end
817 %W tag add sel anchor
@%x
,%y
819 $win tag
bind sel
<1> do_nothing
820 $win tag
bind sel
<Double-Button-1
> {display_expression
[selection get
]}
824 # Scan though the breakpoint data base and install any destined for this file
826 foreach bpnum
[array names breakpoint_file
] {
827 if {$breakpoint_file($bpnum) == $filename} {
828 insert_breakpoint_tag
$win $breakpoint_line($bpnum)
832 # Disable the text widget to prevent user modifications
834 $win configure
-state disabled
841 # create_asm_win (funcname pc) - Create an assembly win for FUNCNAME.
845 # The new text widget.
849 # This procedure creates a text widget for FUNCNAME. It returns the
850 # newly created widget. First, a text widget is created, and given basic
851 # configuration info. Second, all the bindings are setup. Third, the
852 # function FUNCNAME is read into the text widget.
855 proc create_asm_win
{funcname pc
} {
856 global breakpoint_file
857 global breakpoint_line
858 global current_output_win
861 # Replace all the dirty characters in $filename with clean ones, and generate
862 # a unique name for the text widget.
864 set win
[asm_win_name
$funcname]
866 # Actually create and do basic configuration on the text widget.
868 text $win -height 25 -width 88 -relief raised
-borderwidth 2 \
869 -setgrid true
-cursor hand2
-yscrollcommand asmscrollproc
871 # Setup all the bindings
873 bind $win <Enter
> {focus %W
}
874 bind $win <1> {asm_window_button_1
%W
%X
%Y
%x
%y
}
875 bind $win <B1-Motion
> do_nothing
876 bind $win n
{gdb_cmd nexti
; update_ptr
}
877 bind $win s
{gdb_cmd stepi
; update_ptr
}
878 bind $win c
{gdb_cmd
continue ; update_ptr
}
879 bind $win f
{gdb_cmd finish
; update_ptr
}
880 bind $win u
{gdb_cmd up
; update_ptr
}
881 bind $win d
{gdb_cmd down
; update_ptr
}
883 # Disassemble the code, and read it into the new text widget
885 set temp
$current_output_win
886 set current_output_win
$win
887 gdb_cmd
"disassemble $pc"
888 set current_output_win
$temp
890 set numlines
[$win index end
]
891 set numlines
[lindex [split $numlines .
] 0]
894 # Delete the first and last lines, cuz these contain useless info
897 $win delete
{end
- 1 lines
} end
900 # Add margins (for annotations) and note the PC for each line
902 catch "unset pclist($funcname)"
903 lappend pclist
($funcname) Unused
904 for {set i
1} {$i <= $numlines} {incr i
} {
905 scan [$win get
$i.0 "$i.0 lineend"] "%s " pc
906 lappend pclist
($funcname) $pc
911 # Scan though the breakpoint data base and install any destined for this file
913 # foreach bpnum [array names breakpoint_file] {
914 # if {$breakpoint_file($bpnum) == $filename} {
915 # insert_breakpoint_tag $win $breakpoint_line($bpnum)
919 # Disable the text widget to prevent user modifications
921 $win configure
-state disabled
928 # asmscrollproc (WINHEIGHT SCREENHEIGHT SCREENTOP SCREENBOT) - Update the
929 # asm window scrollbar.
933 # This procedure is called to update the assembler window's scrollbar.
936 proc asmscrollproc
{args
} {
937 global asm_screen_height asm_screen_top asm_screen_bot
939 eval ".asm.scroll set $args"
940 set asm_screen_height
[lindex $args 1]
941 set asm_screen_top
[lindex $args 2]
942 set asm_screen_bot
[lindex $args 3]
948 # update_listing (linespec) - Update the listing window according to
953 # This procedure is called from various places to update the listing
954 # window based on LINESPEC. It is usually invoked with the result of
957 # It will move the cursor, and scroll the text widget if necessary.
958 # Also, it will switch to another text widget if necessary, and update
959 # the label widget too.
961 # LINESPEC is a list of the form:
963 # { DEBUG_FILE FUNCNAME FILENAME LINE }, where:
965 # DEBUG_FILE - is the abbreviated form of the file name. This is usually
966 # the file name string given to the cc command. This is
967 # primarily needed for breakpoint commands, and when an
968 # abbreviated for of the filename is desired.
969 # FUNCNAME - is the name of the function.
970 # FILENAME - is the fully qualified (absolute) file name. It is usually
971 # the same as $PWD/$DEBUG_FILE, where PWD is the working dir
972 # at the time the cc command was given. This is used to
973 # actually locate the file to be displayed.
974 # LINE - The line number to be displayed.
976 # Usually, this procedure will just move the cursor one line down to the
977 # next line to be executed. However, if the cursor moves out of range
978 # or into another file, it will scroll the text widget so that the line
979 # of interest is in the middle of the viewable portion of the widget.
982 proc update_listing
{linespec
} {
990 global file_to_debug_file
993 # Rip the linespec apart
995 set line
[lindex $linespec 3]
996 set filename [lindex $linespec 2]
997 set funcname
[lindex $linespec 1]
998 set debug_file
[lindex $linespec 0]
1000 # Sometimes there's no source file for this location
1002 if {$filename == ""} {set filename Blank
}
1004 # If we want to switch files, we need to unpack the current text widget, and
1005 # stick in the new one.
1007 if {$filename != $cfile} then
{
1008 pack forget
$wins($cfile)
1011 # Create a text widget for this file if necessary
1013 if ![info exists wins
($cfile)] then
{
1014 set wins
($cfile) [create_file_win
$cfile $debug_file]
1015 if {$wins($cfile) != ".src.nofile"} {
1016 set win_to_file
($wins($cfile)) $cfile
1017 set file_to_debug_file
($cfile) $debug_file
1018 set pointers
($cfile) 1.1
1022 # Pack the text widget into the listing widget, and scroll to the right place
1024 pack $wins($cfile) -side left
-expand yes
-in .src.
info \
1025 -fill both
-after .src.scroll
1027 # Make the scrollbar point at the new text widget
1029 .src.scroll configure
-command "$wins($cfile) yview"
1031 $wins($cfile) yview
[expr $line - $screen_height / 2]
1034 # Update the label widget in case the filename or function name has changed
1036 if {$current_label != "$filename.$funcname"} then
{
1037 set tail
[expr [string last
/ $filename] + 1]
1038 set .src.
label "[string range $filename $tail end] : ${funcname}()"
1039 # .src.label configure -text "[string range $filename $tail end] : ${funcname}()"
1040 set current_label
$filename.
$funcname
1043 # Update the pointer, scrolling the text widget if necessary to keep the
1044 # pointer in an acceptable part of the screen.
1046 if [info exists pointers
($cfile)] then
{
1047 $wins($cfile) configure
-state normal
1048 set pointer_pos
$pointers($cfile)
1049 $wins($cfile) configure
-state normal
1050 $wins($cfile) delete
$pointer_pos "$pointer_pos + 2 char"
1051 $wins($cfile) insert
$pointer_pos " "
1053 set pointer_pos
[$wins($cfile) index
$line.1]
1054 set pointers
($cfile) $pointer_pos
1056 $wins($cfile) delete
$pointer_pos "$pointer_pos + 2 char"
1057 $wins($cfile) insert
$pointer_pos "->"
1059 if {$line < $screen_top + 1
1060 ||
$line > $screen_bot} then
{
1061 $wins($cfile) yview
[expr $line - $screen_height / 2]
1064 $wins($cfile) configure
-state disabled
1071 # create_asm_window - Open up the assembly window.
1075 # Create an assembly window if it doesn't exist.
1078 proc create_asm_window
{} {
1081 if ![winfo exists .asm
] {
1083 set win
[asm_win_name
$cfunc]
1085 build_framework .asm Assembly
"*NIL*"
1087 .asm.
text configure
-yscrollcommand asmscrollproc
1092 button .asm.stepi
-width 6 -text Stepi
\
1093 -command {gdb_cmd stepi
; update_ptr
}
1094 button .asm.nexti
-width 6 -text Nexti
\
1095 -command {gdb_cmd nexti
; update_ptr
}
1096 button .asm.
continue -width 6 -text Cont
\
1097 -command {gdb_cmd
continue ; update_ptr
}
1098 button .asm.finish
-width 6 -text Finish
\
1099 -command {gdb_cmd finish
; update_ptr
}
1100 button .asm.up
-width 6 -text Up
-command {gdb_cmd up
; update_ptr
}
1101 button .asm.down
-width 6 -text Down
\
1102 -command {gdb_cmd down
; update_ptr
}
1103 button .asm.bottom
-width 6 -text Bottom
\
1104 -command {gdb_cmd
{frame 0} ; update_ptr
}
1106 pack .asm.stepi .asm.
continue .asm.up .asm.bottom
-side left
-padx 3 -pady 5 -in .asm.row1
1107 pack .asm.nexti .asm.finish .asm.down
-side left
-padx 3 -pady 5 -in .asm.row2
1109 pack .asm.row1 .asm.row2
-side top
-anchor w
1113 pack forget .asm.
text
1115 update_assembly
[gdb_loc
]
1119 proc reg_config_menu
{} {
1122 catch {destroy .reg.config
}
1123 toplevel .reg.config
1124 wm geometry .reg.config
+300+300
1125 wm title .reg.config
"Register configuration"
1126 wm iconname .reg.config
"Reg config"
1127 set regnames
[gdb_regnames
]
1128 set num_regs
[llength $regnames]
1130 button .reg.config.done
-text Done
-command {destroy .reg.config
}
1132 pack .reg.config.done
-side bottom
-fill x
1134 # Since there can be lots of registers, we build the window with no more than
1135 # 32 rows, and as many columns as needed.
1137 # First, figure out how many columns we need and create that many column frame
1140 set ncols
[expr ($num_regs + 31) / 32]
1142 for {set col
0} {$col < $ncols} {incr col
} {
1143 frame .reg.config.col
$col
1144 pack .reg.config.col
$col -side left
-anchor n
1147 # Now, create the checkbutton widgets and pack them in the appropriate columns
1151 for {set regnum
0} {$regnum < $num_regs} {incr regnum
} {
1152 set regname
[lindex $regnames $regnum]
1153 checkbutton .reg.config.col
$col.
$row -text $regname -pady 0 \
1154 -variable regena
($regnum) -relief flat
-anchor w
-bd 1 \
1155 -command "recompute_reg_display_list $num_regs
1157 update_registers all"
1159 pack .reg.config.col
$col.
$row -side top
-fill both
1172 # create_registers_window - Open up the register display window.
1176 # Create the register display window, with automatic updates.
1179 proc create_registers_window
{} {
1182 if [winfo exists .reg
] return
1184 # Create an initial register display list consisting of all registers
1186 if ![info exists reg_format
] {
1187 global reg_display_list
1188 global changed_reg_list
1192 set num_regs
[llength [gdb_regnames
]]
1193 for {set regnum
0} {$regnum < $num_regs} {incr regnum
} {
1194 set regena
($regnum) 1
1196 recompute_reg_display_list
$num_regs
1197 set changed_reg_list
$reg_display_list
1200 build_framework .reg Registers
1202 .reg.menubar.view.
menu add command
-label Natural
1203 .reg.menubar.view.
menu add command
-label Config
-command {
1207 .reg.menubar.view.
menu entryconfigure
0 -command {
1211 update_registers all
1214 .reg.menubar.view.
menu entryconfigure
1 -command {
1218 update_registers all
1221 .reg.menubar.view.
menu entryconfigure
2 -command {
1225 update_registers all
1228 .reg.menubar.view.
menu entryconfigure
3 -command {
1232 update_registers all
1237 # Install the reg names
1242 # Convert regena into a list of the enabled $regnums
1244 proc recompute_reg_display_list
{num_regs
} {
1245 global reg_display_list
1249 catch {unset reg_display_list
}
1252 for {set regnum
0} {$regnum < $num_regs} {incr regnum
} {
1254 if {[set regena
($regnum)] != 0} {
1255 lappend reg_display_list
$regnum
1256 set regmap
($regnum) $line
1262 # Fill out the register window with the names of the regs specified in
1265 proc populate_reg_window
{} {
1266 global max_regname_width
1267 global reg_display_list
1269 .reg.
text configure
-state normal
1271 .reg.
text delete
0.0 end
1273 set regnames
[eval gdb_regnames
$reg_display_list]
1275 # Figure out the longest register name
1277 set max_regname_width
0
1279 foreach reg
$regnames {
1280 set len
[string length
$reg]
1281 if {$len > $max_regname_width} {set max_regname_width
$len}
1284 set width
[expr $max_regname_width + 15]
1286 set height
[llength $regnames]
1288 if {$height > 60} {set height
60}
1290 .reg.
text configure
-height $height -width $width
1292 foreach reg
$regnames {
1293 .reg.
text insert end
[format "%-*s \n" $max_regname_width ${reg
}]
1297 .reg.
text configure
-state disabled
1303 # update_registers - Update the registers window.
1307 # This procedure updates the registers window.
1310 proc update_registers
{which
} {
1311 global max_regname_width
1313 global reg_display_list
1314 global changed_reg_list
1318 set margin
[expr $max_regname_width + 1]
1320 set winwidth
[lindex [$win configure
-width] 4]
1321 set valwidth
[expr $winwidth - $margin]
1323 $win configure
-state normal
1325 if {$which == "all"} {
1327 foreach regnum
$reg_display_list {
1328 set regval
[gdb_fetch_registers
$reg_format $regnum]
1329 set regval
[format "%-*s" $valwidth $regval]
1330 $win delete
$lineindex.
$margin "$lineindex.0 lineend"
1331 $win insert
$lineindex.
$margin $regval
1334 $win configure
-state disabled
1338 # Unhighlight the old values
1340 foreach regnum
$changed_reg_list {
1341 $win tag delete
$win.
$regnum
1344 # Now, highlight the changed values of the interesting registers
1346 set changed_reg_list
[eval gdb_changed_register_list
$reg_display_list]
1349 foreach regnum
$changed_reg_list {
1350 set regval
[gdb_fetch_registers
$reg_format $regnum]
1351 set regval
[format "%-*s" $valwidth $regval]
1353 set lineindex
$regmap($regnum)
1354 $win delete
$lineindex.
$margin "$lineindex.0 lineend"
1355 $win insert
$lineindex.
$margin $regval
1356 $win tag add
$win.
$regnum $lineindex.0 "$lineindex.0 lineend"
1357 eval $win tag configure
$win.
$regnum $highlight
1360 $win configure
-state disabled
1366 # update_assembly - Update the assembly window.
1370 # This procedure updates the assembly window.
1373 proc update_assembly
{linespec
} {
1375 global screen_height
1379 global current_label
1381 global file_to_debug_file
1382 global current_asm_label
1384 global asm_screen_height asm_screen_top asm_screen_bot
1387 # Rip the linespec apart
1389 set pc
[lindex $linespec 4]
1390 set line
[lindex $linespec 3]
1391 set filename [lindex $linespec 2]
1392 set funcname
[lindex $linespec 1]
1393 set debug_file
[lindex $linespec 0]
1395 set win
[asm_win_name
$cfunc]
1397 # Sometimes there's no source file for this location
1399 if {$filename == ""} {set filename Blank
}
1401 # If we want to switch funcs, we need to unpack the current text widget, and
1402 # stick in the new one.
1404 if {$funcname != $cfunc } {
1408 set win
[asm_win_name
$cfunc]
1410 # Create a text widget for this func if necessary
1412 if {![winfo exists
$win]} {
1413 create_asm_win
$cfunc $pc
1414 set asm_pointers
($cfunc) 1.1
1415 set current_asm_label NIL
1418 # Pack the text widget, and scroll to the right place
1420 pack $win -side left
-expand yes
-fill both
\
1422 .asm.scroll configure
-command "$win yview"
1423 set line
[pc_to_line
$pclist($cfunc) $pc]
1424 $win yview
[expr $line - $asm_screen_height / 2]
1427 # Update the label widget in case the filename or function name has changed
1429 if {$current_asm_label != "$pc $funcname"} then
{
1430 set .asm.
label "$pc $funcname"
1431 # .asm.label configure -text "$pc $funcname"
1432 set current_asm_label
"$pc $funcname"
1435 # Update the pointer, scrolling the text widget if necessary to keep the
1436 # pointer in an acceptable part of the screen.
1438 if [info exists asm_pointers
($cfunc)] then
{
1439 $win configure
-state normal
1440 set pointer_pos
$asm_pointers($cfunc)
1441 $win configure
-state normal
1442 $win delete
$pointer_pos "$pointer_pos + 2 char"
1443 $win insert
$pointer_pos " "
1445 # Map the PC back to a line in the window
1447 set line
[pc_to_line
$pclist($cfunc) $pc]
1450 echo
"Can't find PC $pc"
1454 set pointer_pos
[$win index
$line.1]
1455 set asm_pointers
($cfunc) $pointer_pos
1457 $win delete
$pointer_pos "$pointer_pos + 2 char"
1458 $win insert
$pointer_pos "->"
1460 if {$line < $asm_screen_top + 1
1461 ||
$line > $asm_screen_bot} then
{
1462 $win yview
[expr $line - $asm_screen_height / 2]
1465 # echo "Picking line $line"
1466 # $win yview -pickplace $line
1468 $win configure
-state disabled
1475 # update_ptr - Update the listing window.
1479 # This routine will update the listing window using the result of
1483 proc update_ptr
{} {
1484 update_listing
[gdb_loc
]
1485 if [winfo exists .asm
] {
1486 update_assembly
[gdb_loc
]
1488 if [winfo exists .reg
] {
1489 update_registers changed
1493 # Make toplevel window disappear
1497 proc files_command
{} {
1498 toplevel .files_window
1500 wm minsize .files_window
1 1
1501 # wm overrideredirect .files_window true
1502 listbox .files_window.
list -geometry 30x20
-setgrid true
1503 button .files_window.
close -text Close
-command {destroy .files_window
}
1504 tk_listboxSingleSelect .files_window.
list
1505 eval .files_window.
list insert
0 [lsort [gdb_listfiles
]]
1506 pack .files_window.
list -side top
-fill both
-expand yes
1507 pack .files_window.
close -side bottom
-fill x
-expand no
-anchor s
1508 bind .files_window.
list <Any-ButtonRelease-1
> {
1509 set file [%W get
[%W curselection
]]
1510 gdb_cmd
"list $file:1,0"
1511 update_listing
[gdb_loc
$file:1]
1512 destroy .files_window
}
1515 button .files
-text Files
-command files_command
1517 # Setup command window
1519 proc build_framework
{win
{title GDBtk
} {label {}}} {
1523 wm title
${win
} $title
1524 wm minsize
${win
} 1 1
1526 frame ${win
}.menubar
1528 menubutton ${win
}.menubar.
file -padx 12 -text File
\
1529 -menu ${win
}.menubar.
file.
menu -underline 0
1531 menu ${win
}.menubar.
file.
menu
1532 ${win
}.menubar.
file.
menu add command
-label Edit
\
1533 -command {exec $editor +[expr ($screen_top + $screen_bot)/2] $cfile &}
1534 ${win
}.menubar.
file.
menu add command
-label Close
\
1535 -command "destroy ${win}"
1536 ${win
}.menubar.
file.
menu add command
-label Quit
\
1537 -command {gdb_cmd quit
}
1539 menubutton ${win
}.menubar.view
-padx 12 -text View
\
1540 -menu ${win
}.menubar.view.
menu -underline 0
1542 menu ${win
}.menubar.view.
menu
1543 ${win
}.menubar.view.
menu add command
-label Hex
-command {echo Hex
}
1544 ${win
}.menubar.view.
menu add command
-label Decimal
\
1545 -command {echo Decimal
}
1546 ${win
}.menubar.view.
menu add command
-label Octal
-command {echo Octal
}
1548 menubutton ${win
}.menubar.window
-padx 12 -text Window
\
1549 -menu ${win
}.menubar.window.
menu -underline 0
1551 menu ${win
}.menubar.window.
menu
1552 ${win
}.menubar.window.
menu add command
-label Source
\
1553 -command {echo Source
}
1554 ${win
}.menubar.window.
menu add command
-label Command
\
1555 -command {echo Command
}
1556 ${win
}.menubar.window.
menu add command
-label Assembly
\
1557 -command {create_asm_window
; update_ptr
}
1558 ${win
}.menubar.window.
menu add command
-label Register
\
1559 -command {create_registers_window
; update_ptr
}
1561 menubutton ${win
}.menubar.help
-padx 12 -text Help
\
1562 -menu ${win
}.menubar.help.
menu -underline 0
1564 menu ${win
}.menubar.help.
menu
1565 ${win
}.menubar.help.
menu add command
-label "with GDBtk" \
1566 -command {echo
"with GDBtk"}
1567 ${win
}.menubar.help.
menu add command
-label "with this window" \
1568 -command {echo
"with this window"}
1569 ${win
}.menubar.help.
menu add command
-label "Report bug" \
1570 -command {exec send-pr
}
1572 tk_menuBar
${win
}.menubar
${win
}.menubar.
file ${win
}.menubar.view
\
1573 ${win
}.menubar.window
${win
}.menubar.help
1574 pack ${win
}.menubar.
file ${win
}.menubar.view
${win
}.menubar.window
\
1576 pack ${win
}.menubar.help
-side right
1579 text ${win
}.
text -height 25 -width 80 -relief raised
-borderwidth 2 \
1580 -setgrid true
-cursor hand2
-yscrollcommand "${win}.scroll set"
1582 set ${win
}.
label $label
1583 label ${win
}.
label -textvariable ${win
}.
label -borderwidth 2 -relief raised
1585 scrollbar ${win
}.scroll
-orient vertical
-command "${win}.text yview"
1587 pack ${win
}.
label -side bottom
-fill x
-in ${win
}.
info
1588 pack ${win
}.scroll
-side right
-fill y
-in ${win
}.
info
1589 pack ${win
}.
text -side left
-expand yes
-fill both
-in ${win
}.
info
1591 pack ${win
}.menubar
-side top
-fill x
1592 pack ${win
}.
info -side top
-fill both
-expand yes
1595 proc create_source_window
{} {
1599 build_framework .src Source
"*No file*"
1604 button .src.start
-width 6 -text Start
-command \
1605 {gdb_cmd
{break main
}
1606 gdb_cmd
{enable delete
$bpnum}
1609 button .src.stop
-width 6 -text Stop
-fg red
-activeforeground red
\
1610 -state disabled
-command gdb_stop
1611 button .src.step
-width 6 -text Step
\
1612 -command {gdb_cmd step
; update_ptr
}
1613 button .src.next
-width 6 -text Next
\
1614 -command {gdb_cmd next
; update_ptr
}
1615 button .src.
continue -width 6 -text Cont
\
1616 -command {gdb_cmd
continue ; update_ptr
}
1617 button .src.finish
-width 6 -text Finish
\
1618 -command {gdb_cmd finish
; update_ptr
}
1619 button .src.up
-width 6 -text Up
-command {gdb_cmd up
; update_ptr
}
1620 button .src.down
-width 6 -text Down
\
1621 -command {gdb_cmd down
; update_ptr
}
1622 button .src.bottom
-width 6 -text Bottom
\
1623 -command {gdb_cmd
{frame 0} ; update_ptr
}
1625 pack .src.start .src.step .src.
continue .src.up .src.bottom
\
1626 -side left
-padx 3 -pady 5 -in .src.row1
1627 pack .src.stop .src.next .src.finish .src.down
-side left
-padx 3 \
1628 -pady 5 -in .src.row2
1630 pack .src.row1 .src.row2
-side top
-anchor w
1632 $wins($cfile) insert
0.0 " This page intentionally left blank."
1633 $wins($cfile) configure
-width 88 -state disabled
\
1634 -yscrollcommand textscrollproc
1636 proc textscrollproc
{args
} {global screen_height screen_top screen_bot
1637 eval ".src.scroll set $args"
1638 set screen_height
[lindex $args 1]
1639 set screen_top
[lindex $args 2]
1640 set screen_bot
[lindex $args 3]}
1643 proc create_command_window
{} {
1646 build_framework .cmd Command
"* Command Buffer *"
1650 gdb_cmd
{set language c
}
1651 gdb_cmd
{set height
0}
1652 gdb_cmd
{set width
0}
1654 bind .cmd.
text <Enter
> {focus %W
}
1655 bind .cmd.
text <Delete
> {delete_char
%W
}
1656 bind .cmd.
text <BackSpace
> {delete_char
%W
}
1657 bind .cmd.
text <Control-u
> {delete_line
%W
}
1658 bind .cmd.
text <Any-Key
> {
1662 %W yview
-pickplace end
1663 append command_line
%A
1665 bind .cmd.
text <Key-Return
> {
1669 %W yview
-pickplace end
1670 gdb_cmd
$command_line
1673 %W insert end
"(gdb) "
1674 %W yview
-pickplace end
1677 proc delete_char
{win
} {
1680 tk_textBackspace
$win
1681 $win yview
-pickplace insert
1682 set tmp
[expr [string length
$command_line] - 2]
1683 set command_line
[string range
$command_line 0 $tmp]
1686 proc delete_line
{win
} {
1689 $win delete
{end linestart
+ 6 chars
} end
1690 $win yview
-pickplace insert
1695 # Setup the initial windows
1697 create_source_window
1699 if {[tk colormodel .src.
text] == "color"} {
1700 set highlight
"-background red2 -borderwidth 2 -relief sunk"
1702 set fg
[lindex [.src.
text config
-foreground] 4]
1703 set bg
[lindex [.src.
text config
-background] 4]
1704 set highlight
"-foreground $bg -background $fg -borderwidth 0"
1707 create_command_window