11 update_listing
{termcap.c foo
/etc
/termcap
200}
14 proc echo
string {puts stdout
$string}
16 proc gdbtk_tcl_fputs
{arg
} {
17 .command.
text insert end
"$arg"
18 .command.
text yview
-pickplace end
21 proc gdbtk_tcl_flush
{} {update idletasks
}
23 proc gdbtk_tcl_query
{message} {
24 tk_dialog .query
"gdb : query" "$message" {} 1 "No" "Yes"
27 if [info exists env
(EDITOR
)] then
{
28 set editor
$env(EDITOR
)
33 proc gdbtk_tcl_start_variable_annotation
{valaddr ref_type stor_cl cum_expr field type_cast
} {
34 echo
"gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast"
37 proc gdbtk_tcl_end_variable_annotation
{} {
38 echo gdbtk_tcl_end_variable_annotation
41 proc insert_breakpoint_tag
{win line
} {
42 $win configure
-state normal
44 $win insert
$line.0 "B"
45 $win tag add
$line $line.0
46 $win tag
bind $line <1> {
47 # echo "tag %W %X %Y %x"
48 # echo "tag names [$wins($cfile) tag names]"
51 $win configure
-state disabled
54 proc delete_breakpoint_tag
{win line
} {
55 $win configure
-state normal
57 $win insert
$line.0 " "
59 $win configure
-state disabled
62 # Callback from GDB to notify us of breakpoint creation.
64 proc create_breakpoint
{bpnum
file line
} {
66 global breakpoint_file
67 global breakpoint_line
69 # Record breakpoint locations
71 set breakpoint_file
($bpnum) $file
72 set breakpoint_line
($bpnum) $line
74 # If there isn't a window for this file, don't try to update it
76 if [info exists wins
($file)] {
77 insert_breakpoint_tag
$wins($file) $line
81 proc delete_breakpoint
{bpnum
file line
} {
83 global breakpoint_file
84 global breakpoint_line
86 # Save line number for later
88 set line
$breakpoint_line($bpnum)
90 # Reset breakpoint annotation info
92 unset breakpoint_file
($bpnum)
93 unset breakpoint_line
($bpnum)
95 # If there isn't a window for this file, don't try to update it
97 if [info exists wins
($file)] {
98 delete_breakpoint_tag
$wins($file) $line
102 # This is a callback from C code to notify us of breakpoint changes. ACTION
103 # can be one of create, delete, enable, or disable.
105 proc gdbtk_tcl_breakpoint
{action bpnum
file line
} {
106 ${action
}_breakpoint
$bpnum $file $line
109 # Create the popup listing window menu
111 menu .breakpoint
-cursor hand2
112 .breakpoint add command
-label Break
113 .breakpoint add separator
114 .breakpoint add command
-label "Edit" -command {exec $editor +$selected_line $selected_file &}
115 .breakpoint add command
-label "Set breakpoint" -command {gdb_cmd
"break $selected_file:$selected_line"}
116 #.breakpoint add command -label "Clear breakpoint" -command {echo "Clear"}
117 #.breakpoint add command -label "Enable breakpoint" -command {echo "Enable"}
118 #.breakpoint add command -label "Disable breakpoint" -command {echo "Disable"}
120 # Come here when button is released in the popup menu
122 bind .breakpoint
<Any-ButtonRelease-1
> {
125 # First, remove the menu, and release the pointer
128 grab release .breakpoint
130 # Unhighlight the selected line
132 $selected_win tag delete breaktag
133 # echo "after deleting $selected_win [$selected_win tag names]"
134 # echo "grab [grab current]"
136 # Actually invoke the menubutton here!
139 # destroy .breakpoint
140 grab release
$selected_win
143 # Button 1 has been pressed in a listing window. Pop up a menu.
145 proc breakpoint_menu
{win x y xrel yrel
} {
148 global file_to_debug_file
156 # echo "bpm grab current [grab current]"
158 # Map TK window name back to file name.
160 set file $win_to_file($win)
162 set pos
[$win index
@$xrel,$yrel]
164 # Record selected file and line for menu button actions
166 set selected_file
$file_to_debug_file($file)
167 set selected_line
[lindex [split $pos .
] 0]
168 set selected_win
$win
170 # Highlight the selected line
172 eval $win tag config breaktag
$highlight
173 $win tag add breaktag
"$pos linestart" "$pos linestart + 1l"
175 # Post the menu near the pointer, (and grab it)
177 .breakpoint post
[expr $x-[winfo width .breakpoint
]/2] [expr $y-10]
179 # echo "after grab [grab current]"
182 proc do_nothing
{} {}
184 proc create_file_win
{filename} {
185 global breakpoint_file
186 global breakpoint_line
188 regsub -all {\.|
/} $filename {} temp
190 text $win -height 25 -width 80 -relief raised
-borderwidth 2 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
191 bind $win <Enter
> {focus %W
}
192 # bind $win <1> {breakpoint_menu %W %X %Y %x %y}
193 bind $win <B1-Motion
> do_nothing
194 bind $win n
{gdb_cmd next
; update_ptr
}
195 bind $win s
{gdb_cmd step
; update_ptr
}
196 bind $win c
{gdb_cmd
continue ; update_ptr
}
197 bind $win f
{gdb_cmd finish
; update_ptr
}
198 bind $win u
{gdb_cmd up
; update_ptr
}
199 bind $win d
{gdb_cmd down
; update_ptr
}
200 set fh
[open $filename]
202 $win insert
0.0 [read $fh]
204 set numlines
[$win index end
]
205 set numlines
[lindex [split $numlines .
] 0]
206 for {set i
1} {$i <= $numlines} {incr i
} {
207 $win insert
$i.0 [format " %4d " $i]
210 $win tag add wholebuf
0.0 end
211 $win tag
bind wholebuf
<1> {breakpoint_menu
%W
%X
%Y
%x
%y
}
212 foreach bpnum
[array names breakpoint_file
] {
213 if {$breakpoint_file($bpnum) == $filename} {
214 insert_breakpoint_tag
$win $breakpoint_line($bpnum)
218 $win configure
-state disabled
222 proc update_listing
{linespec
} {
230 global file_to_debug_file
232 set line
[lindex $linespec 3]
233 set filename [lindex $linespec 2]
234 set funcname
[lindex $linespec 1]
235 set debug_file
[lindex $linespec 0]
237 if {$filename == ""} {set filename Blank
}
239 if {$filename != $cfile} then
{
240 pack forget
$wins($cfile)
242 if ![info exists wins
($cfile)] then
{
243 set wins
($cfile) [create_file_win
$cfile]
244 set win_to_file
($wins($cfile)) $cfile
245 set file_to_debug_file
($cfile) $debug_file
246 set pointers
($cfile) 1.1
249 pack $wins($cfile) -side left
-expand yes
-in .listing
-fill both
-after .
label
250 $wins($cfile) yview
[expr $line - $screen_height / 2]
253 if {$current_label != "$filename.$funcname"} then
{
254 set tail
[expr [string last
/ $filename] + 1]
255 .
label configure
-text "[string range $filename $tail end] : ${funcname}()"
256 set current_label
$filename.
$funcname
259 if [info exists pointers
($cfile)] then
{
260 $wins($cfile) configure
-state normal
261 set pointer_pos
$pointers($cfile)
262 $wins($cfile) configure
-state normal
263 $wins($cfile) delete
$pointer_pos
264 $wins($cfile) insert
$pointer_pos " "
266 set pointer_pos
[$wins($cfile) index
$line.1]
267 set pointers
($cfile) $pointer_pos
269 $wins($cfile) delete
$pointer_pos
270 $wins($cfile) insert
$pointer_pos "\xbb"
272 if {$line < $screen_top + 1
273 ||
$line > $screen_bot} then
{
274 $wins($cfile) yview
[expr $line - $screen_height / 2]
277 $wins($cfile) configure
-state disabled
281 proc update_ptr
{} {update_listing
[gdb_loc
]}
283 # Setup listing window
289 label .
label -text "*No file*" -borderwidth 2 -relief raised
290 text $wins($cfile) -height 25 -width 80 -relief raised
-borderwidth 2 -yscrollcommand textscrollproc
-setgrid true
-cursor hand2
291 scrollbar .scroll
-orient vertical
-command {$wins($cfile) yview
}
293 if {[tk colormodel .
text] == "color"} {
294 set highlight
"-background red2 -borderwidth 2 -relief sunk"
296 set fg
[lindex [.
text config
-foreground] 4]
297 set bg
[lindex [.
text config
-background] 4]
298 set highlight
"-foreground $bg -background $fg -borderwidth 0"
301 proc textscrollproc
{args
} {global screen_height screen_top screen_bot
302 eval ".scroll set $args"
303 set screen_height
[lindex $args 1]
304 set screen_top
[lindex $args 2]
305 set screen_bot
[lindex $args 3]}
307 $wins($cfile) insert
0.0 " This page intentionally left blank."
308 $wins($cfile) configure
-state disabled
310 pack .
label -side bottom
-fill x
-in .listing
311 pack $wins($cfile) -side left
-expand yes
-in .listing
-fill both
312 pack .scroll
-side left
-fill y
-in .listing
314 button .start
-text Start
-command \
315 {gdb_cmd
{break main
}
316 gdb_cmd
{enable delete
$bpnum}
319 button .step
-text Step
-command {gdb_cmd step
; update_ptr
}
320 button .next
-text Next
-command {gdb_cmd next
; update_ptr
}
321 button .
continue -text Continue
-command {gdb_cmd
continue ; update_ptr
}
322 button .finish
-text Finish
-command {gdb_cmd finish
; update_ptr
}
323 #button .test -text Test -command {echo [info var]}
324 button .
exit -text Exit
-command {gdb_cmd quit
}
325 button .up
-text Up
-command {gdb_cmd up
; update_ptr
}
326 button .down
-text Down
-command {gdb_cmd down
; update_ptr
}
327 button .bottom
-text "Bottom" -command {gdb_cmd
{frame 0} ; update_ptr
}
329 proc files_command
{} {
330 toplevel .files_window
332 wm minsize .files_window
1 1
333 # wm overrideredirect .files_window true
334 listbox .files_window.
list -geometry 30x20
-setgrid true
335 button .files_window.
close -text Close
-command {destroy .files_window
}
336 tk_listboxSingleSelect .files_window.
list
337 eval .files_window.
list insert
0 [lsort [gdb_listfiles
]]
338 pack .files_window.
list -side top
-fill both
-expand yes
339 pack .files_window.
close -side bottom
-fill x
-expand no
-anchor s
340 bind .files_window.
list <Any-ButtonRelease-1
> {
341 set file [%W get
[%W curselection
]]
342 gdb_cmd
"list $file:1,0"
343 update_listing
[gdb_loc
$file:1]
344 destroy .files_window
}
347 button .files
-text Files
-command files_command
349 pack .listing
-side bottom
-fill both
-expand yes
350 #pack .test -side bottom -fill x
351 pack .start .step .next .
continue .finish .up .down .bottom .files .
exit -side left
354 # Setup command window
356 label .command.
label -text "* Command Buffer *" -borderwidth 2 -relief raised
357 text .command.
text -height 25 -width 80 -relief raised
-borderwidth 2 -setgrid true
-cursor hand2
359 pack .command.
label -side top
-fill x
360 pack .command.
text -side top
-expand yes
-fill both
364 gdb_cmd
{set language c
}
365 gdb_cmd
{set height
0}
366 gdb_cmd
{set width
0}
368 bind .command.
text <Any-Key
> {
372 %W yview
-pickplace end
373 append command_line
%A
375 bind .command.
text <Key-Return
> {
379 %W yview
-pickplace end
380 gdb_cmd
$command_line
383 %W insert end
"(gdb) "
384 %W yview
-pickplace end
386 bind .command.
text <Enter
> {focus %W
}
387 bind .command.
text <Delete
> {delete_char
%W
}
388 bind .command.
text <BackSpace
> {delete_char
%W
}
389 proc delete_char
{win
} {
392 tk_textBackspace
$win
393 $win yview
-pickplace insert
394 set tmp
[expr [string length
$command_line] - 2]
395 set command_line
[string range
$command_line 0 $tmp]
398 wm minsize .command
1 1