Commit | Line | Data |
---|---|---|
754e5da2 SG |
1 | # GDB GUI setup |
2 | ||
3 | set cfile Blank | |
4 | set wins($cfile) .text | |
5 | set current_label {} | |
6 | set screen_height 0 | |
7 | set screen_top 0 | |
8 | set screen_bot 0 | |
8532893d SG |
9 | set current_output_win .command.text |
10 | set cfunc NIL | |
754e5da2 SG |
11 | |
12 | proc test {} { | |
13 | update_listing {termcap.c foo /etc/termcap 200} | |
14 | } | |
15 | ||
16 | proc echo string {puts stdout $string} | |
17 | ||
8532893d SG |
18 | if [info exists env(EDITOR)] then { |
19 | set editor $env(EDITOR) | |
20 | } else { | |
21 | set editor emacs | |
22 | } | |
23 | ||
24 | # GDB callbacks | |
25 | # | |
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. | |
28 | # | |
29 | ||
30 | # | |
31 | # GDB Callback: | |
32 | # | |
33 | # gdbtk_tcl_fputs (text) - Output text to the command window | |
34 | # | |
35 | # Description: | |
36 | # | |
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. | |
40 | # | |
41 | ||
754e5da2 | 42 | proc gdbtk_tcl_fputs {arg} { |
8532893d SG |
43 | global current_output_win |
44 | ||
45 | $current_output_win insert end "$arg" | |
46 | $current_output_win yview -pickplace end | |
47 | } | |
48 | ||
49 | # | |
50 | # GDB Callback: | |
51 | # | |
52 | # gdbtk_tcl_flush () - Flush output to the command window | |
53 | # | |
54 | # Description: | |
55 | # | |
56 | # GDB calls this to force all buffered text to the GDB command window. | |
57 | # | |
58 | ||
59 | proc gdbtk_tcl_flush {} { | |
60 | $current_output_win yview -pickplace end | |
61 | update idletasks | |
754e5da2 SG |
62 | } |
63 | ||
8532893d SG |
64 | # |
65 | # GDB Callback: | |
66 | # | |
67 | # gdbtk_tcl_query (message) - Create a yes/no query dialog box | |
68 | # | |
69 | # Description: | |
70 | # | |
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. | |
74 | # | |
754e5da2 SG |
75 | |
76 | proc gdbtk_tcl_query {message} { | |
77 | tk_dialog .query "gdb : query" "$message" {} 1 "No" "Yes" | |
78 | } | |
79 | ||
8532893d SG |
80 | # |
81 | # GDB Callback: | |
82 | # | |
83 | # gdbtk_start_variable_annotation (args ...) - | |
84 | # | |
85 | # Description: | |
86 | # | |
87 | # Not yet implemented. | |
88 | # | |
754e5da2 SG |
89 | |
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" | |
92 | } | |
93 | ||
8532893d SG |
94 | # |
95 | # GDB Callback: | |
96 | # | |
97 | # gdbtk_end_variable_annotation (args ...) - | |
98 | # | |
99 | # Description: | |
100 | # | |
101 | # Not yet implemented. | |
102 | # | |
103 | ||
754e5da2 SG |
104 | proc gdbtk_tcl_end_variable_annotation {} { |
105 | echo gdbtk_tcl_end_variable_annotation | |
106 | } | |
107 | ||
8532893d SG |
108 | # |
109 | # GDB Callback: | |
110 | # | |
111 | # gdbtk_tcl_breakpoint (action bpnum file line) - Notify the TK | |
112 | # interface of changes to breakpoints. | |
113 | # | |
114 | # Description: | |
115 | # | |
116 | # GDB calls this to notify TK of changes to breakpoints. ACTION is one | |
117 | # of: | |
118 | # create - Notify of breakpoint creation | |
119 | # delete - Notify of breakpoint deletion | |
120 | # enable - Notify of breakpoint enabling | |
121 | # disable - Notify of breakpoint disabling | |
122 | # | |
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. | |
126 | # | |
127 | ||
128 | proc gdbtk_tcl_breakpoint {action bpnum file line pc} { | |
129 | ${action}_breakpoint $bpnum $file $line $pc | |
754e5da2 SG |
130 | } |
131 | ||
335129a9 SG |
132 | proc asm_win_name {funcname} { |
133 | regsub -all {\.} $funcname _ temp | |
134 | ||
135 | return .asm.func_${temp} | |
136 | } | |
137 | ||
8532893d SG |
138 | # |
139 | # Local procedure: | |
140 | # | |
141 | # create_breakpoint (bpnum file line pc) - Record breakpoint info in TK land | |
142 | # | |
143 | # Description: | |
144 | # | |
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 | |
149 | # a breakpoint tag. | |
150 | # | |
151 | ||
152 | proc create_breakpoint {bpnum file line pc} { | |
754e5da2 SG |
153 | global wins |
154 | global breakpoint_file | |
155 | global breakpoint_line | |
8532893d | 156 | global pos_to_breakpoint |
335129a9 | 157 | global pos_to_bpcount |
8532893d SG |
158 | global cfunc |
159 | global pclist | |
754e5da2 SG |
160 | |
161 | # Record breakpoint locations | |
162 | ||
163 | set breakpoint_file($bpnum) $file | |
164 | set breakpoint_line($bpnum) $line | |
8532893d | 165 | set pos_to_breakpoint($file:$line) $bpnum |
335129a9 SG |
166 | if ![info exists pos_to_bpcount($file:$line)] { |
167 | set pos_to_bpcount($file:$line) 0 | |
168 | } | |
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 | |
173 | } | |
174 | incr pos_to_bpcount($pc) | |
754e5da2 | 175 | |
8532893d | 176 | # If there's a window for this file, update it |
754e5da2 SG |
177 | |
178 | if [info exists wins($file)] { | |
179 | insert_breakpoint_tag $wins($file) $line | |
180 | } | |
8532893d SG |
181 | |
182 | # If there's an assembly window, update that too | |
183 | ||
335129a9 | 184 | set win [asm_win_name $cfunc] |
8532893d | 185 | if [winfo exists $win] { |
637b1661 | 186 | insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc] |
8532893d | 187 | } |
754e5da2 SG |
188 | } |
189 | ||
8532893d SG |
190 | # |
191 | # Local procedure: | |
192 | # | |
193 | # delete_breakpoint (bpnum file line pc) - Delete breakpoint info from TK land | |
194 | # | |
195 | # Description: | |
196 | # | |
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 | |
201 | # from it. | |
202 | # | |
203 | ||
204 | proc delete_breakpoint {bpnum file line pc} { | |
754e5da2 SG |
205 | global wins |
206 | global breakpoint_file | |
207 | global breakpoint_line | |
8532893d | 208 | global pos_to_breakpoint |
335129a9 SG |
209 | global pos_to_bpcount |
210 | global cfunc pclist | |
754e5da2 | 211 | |
8532893d | 212 | # Save line number and file for later |
754e5da2 SG |
213 | |
214 | set line $breakpoint_line($bpnum) | |
215 | ||
8532893d SG |
216 | set file $breakpoint_file($bpnum) |
217 | ||
754e5da2 SG |
218 | # Reset breakpoint annotation info |
219 | ||
335129a9 | 220 | if {$pos_to_bpcount($file:$line) > 0} { |
637b1661 | 221 | decr pos_to_bpcount($file:$line) |
335129a9 SG |
222 | |
223 | if {$pos_to_bpcount($file:$line) == 0} { | |
637b1661 SG |
224 | catch "unset pos_to_breakpoint($file:$line)" |
225 | ||
335129a9 SG |
226 | unset breakpoint_file($bpnum) |
227 | unset breakpoint_line($bpnum) | |
754e5da2 | 228 | |
8532893d | 229 | # If there's a window for this file, update it |
754e5da2 | 230 | |
335129a9 SG |
231 | if [info exists wins($file)] { |
232 | delete_breakpoint_tag $wins($file) $line | |
233 | } | |
234 | } | |
235 | } | |
236 | ||
237 | # If there's an assembly window, update that too | |
238 | ||
239 | if {$pos_to_bpcount($pc) > 0} { | |
637b1661 | 240 | decr pos_to_bpcount($pc) |
335129a9 SG |
241 | |
242 | if {$pos_to_bpcount($pc) == 0} { | |
637b1661 SG |
243 | catch "unset pos_to_breakpoint($pc)" |
244 | ||
335129a9 SG |
245 | set win [asm_win_name $cfunc] |
246 | if [winfo exists $win] { | |
637b1661 | 247 | delete_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc] |
335129a9 SG |
248 | } |
249 | } | |
754e5da2 SG |
250 | } |
251 | } | |
252 | ||
8532893d SG |
253 | # |
254 | # Local procedure: | |
255 | # | |
256 | # enable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land | |
257 | # | |
258 | # Description: | |
259 | # | |
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. | |
263 | # | |
264 | ||
265 | proc enable_breakpoint {bpnum file line pc} { | |
266 | global wins | |
335129a9 SG |
267 | global cfunc pclist |
268 | ||
269 | if [info exists wins($file)] { | |
270 | $wins($file) tag configure $line -fgstipple {} | |
271 | } | |
754e5da2 | 272 | |
335129a9 SG |
273 | # If there's an assembly window, update that too |
274 | ||
275 | set win [asm_win_name $cfunc] | |
276 | if [winfo exists $win] { | |
637b1661 | 277 | $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple {} |
335129a9 | 278 | } |
754e5da2 SG |
279 | } |
280 | ||
8532893d SG |
281 | # |
282 | # Local procedure: | |
283 | # | |
284 | # disable_breakpoint (bpnum file line pc) - Record breakpoint info in TK land | |
285 | # | |
286 | # Description: | |
287 | # | |
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. | |
291 | # | |
292 | ||
293 | proc disable_breakpoint {bpnum file line pc} { | |
294 | global wins | |
335129a9 SG |
295 | global cfunc pclist |
296 | ||
297 | if [info exists wins($file)] { | |
298 | $wins($file) tag configure $line -fgstipple gray50 | |
299 | } | |
754e5da2 | 300 | |
335129a9 SG |
301 | # If there's an assembly window, update that too |
302 | ||
303 | set win [asm_win_name $cfunc] | |
304 | if [winfo exists $win] { | |
637b1661 | 305 | $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple gray50 |
335129a9 | 306 | } |
8532893d SG |
307 | } |
308 | ||
309 | # | |
310 | # Local procedure: | |
311 | # | |
312 | # insert_breakpoint_tag (win line) - Insert a breakpoint tag in WIN. | |
313 | # | |
314 | # Description: | |
315 | # | |
316 | # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to insert a | |
317 | # breakpoint tag into window WIN at line LINE. | |
318 | # | |
754e5da2 | 319 | |
8532893d SG |
320 | proc insert_breakpoint_tag {win line} { |
321 | $win configure -state normal | |
322 | $win delete $line.0 | |
323 | $win insert $line.0 "B" | |
324 | $win tag add $line $line.0 | |
325 | ||
326 | $win configure -state disabled | |
327 | } | |
328 | ||
329 | # | |
330 | # Local procedure: | |
331 | # | |
332 | # delete_breakpoint_tag (win line) - Remove a breakpoint tag from WIN. | |
333 | # | |
334 | # Description: | |
335 | # | |
336 | # GDB calls this indirectly (through gdbtk_tcl_breakpoint) to remove a | |
337 | # breakpoint tag from window WIN at line LINE. | |
338 | # | |
339 | ||
340 | proc delete_breakpoint_tag {win line} { | |
341 | $win configure -state normal | |
342 | $win delete $line.0 | |
343 | $win insert $line.0 " " | |
344 | $win tag delete $line | |
345 | $win configure -state disabled | |
346 | } | |
754e5da2 | 347 | |
637b1661 SG |
348 | # |
349 | # Local procedure: | |
350 | # | |
351 | # decr (var val) - compliment to incr | |
352 | # | |
353 | # Description: | |
354 | # | |
355 | # | |
356 | proc decr {var {val 1}} { | |
357 | upvar $var num | |
358 | set num [expr $num - $val] | |
359 | return $num | |
360 | } | |
361 | ||
362 | # | |
363 | # Local procedure: | |
364 | # | |
365 | # pc_to_line (pclist pc) - convert PC to a line number. | |
366 | # | |
367 | # Description: | |
368 | # | |
369 | # Convert PC to a line number from PCLIST. If exact line isn't found, | |
370 | # we return the first line that starts before PC. | |
371 | # | |
372 | proc pc_to_line {pclist pc} { | |
373 | set line [lsearch -exact $pclist $pc] | |
374 | ||
375 | if {$line >= 1} { return $line } | |
376 | ||
377 | set line 1 | |
378 | foreach linepc [lrange $pclist 1 end] { | |
379 | if {$pc < $linepc} { decr line ; return $line } | |
380 | incr line | |
381 | } | |
382 | return [expr $line - 1] | |
383 | } | |
384 | ||
8532893d SG |
385 | # |
386 | # Menu: | |
387 | # | |
388 | # file popup menu - Define the file popup menu. | |
389 | # | |
390 | # Description: | |
391 | # | |
392 | # This menu just contains a bunch of buttons that do various things to | |
393 | # the line under the cursor. | |
394 | # | |
395 | # Items: | |
396 | # | |
397 | # Edit - Run the editor (specified by the environment variable EDITOR) on | |
398 | # this file, at the current line. | |
399 | # Breakpoint - Set a breakpoint at the current line. This just shoves | |
400 | # a `break' command at GDB with the appropriate file and line | |
401 | # number. Eventually, GDB calls us back (at gdbtk_tcl_breakpoint) | |
402 | # to notify us of where the breakpoint needs to show up. | |
403 | # | |
404 | ||
405 | menu .file_popup -cursor hand2 | |
406 | .file_popup add command -label "Not yet set" -state disabled | |
407 | .file_popup add separator | |
408 | .file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &} | |
409 | .file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"} | |
410 | ||
411 | # | |
412 | # Bindings: | |
413 | # | |
414 | # file popup menu - Define the file popup menu bindings. | |
415 | # | |
416 | # Description: | |
417 | # | |
418 | # This defines the binding for the file popup menu. Currently, there is | |
419 | # only one, which is activated when Button-1 is released. This causes | |
420 | # the menu to be unposted, releases the grab for the menu, and then | |
421 | # unhighlights the line under the cursor. After that, the selected menu | |
422 | # item is invoked. | |
423 | # | |
424 | ||
425 | bind .file_popup <Any-ButtonRelease-1> { | |
754e5da2 SG |
426 | global selected_win |
427 | ||
428 | # First, remove the menu, and release the pointer | |
429 | ||
8532893d SG |
430 | .file_popup unpost |
431 | grab release .file_popup | |
754e5da2 SG |
432 | |
433 | # Unhighlight the selected line | |
434 | ||
435 | $selected_win tag delete breaktag | |
754e5da2 SG |
436 | |
437 | # Actually invoke the menubutton here! | |
438 | ||
439 | tk_invokeMenu %W | |
754e5da2 SG |
440 | } |
441 | ||
8532893d SG |
442 | # |
443 | # Local procedure: | |
444 | # | |
445 | # file_popup_menu (win x y xrel yrel) - Popup the file popup menu. | |
446 | # | |
447 | # Description: | |
448 | # | |
449 | # This procedure is invoked as a result of a command binding in the | |
450 | # listing window. It does several things: | |
451 | # o - It highlights the line under the cursor. | |
452 | # o - It pops up the file popup menu which is intended to do | |
453 | # various things to the aforementioned line. | |
454 | # o - Grabs the mouse for the file popup menu. | |
455 | # | |
456 | ||
754e5da2 SG |
457 | # Button 1 has been pressed in a listing window. Pop up a menu. |
458 | ||
8532893d | 459 | proc file_popup_menu {win x y xrel yrel} { |
754e5da2 SG |
460 | global wins |
461 | global win_to_file | |
462 | global file_to_debug_file | |
463 | global highlight | |
464 | global selected_line | |
465 | global selected_file | |
466 | global selected_win | |
467 | ||
754e5da2 SG |
468 | # Map TK window name back to file name. |
469 | ||
470 | set file $win_to_file($win) | |
471 | ||
472 | set pos [$win index @$xrel,$yrel] | |
473 | ||
474 | # Record selected file and line for menu button actions | |
475 | ||
476 | set selected_file $file_to_debug_file($file) | |
477 | set selected_line [lindex [split $pos .] 0] | |
478 | set selected_win $win | |
479 | ||
480 | # Highlight the selected line | |
481 | ||
482 | eval $win tag config breaktag $highlight | |
483 | $win tag add breaktag "$pos linestart" "$pos linestart + 1l" | |
484 | ||
485 | # Post the menu near the pointer, (and grab it) | |
486 | ||
8532893d SG |
487 | .file_popup entryconfigure 0 -label "$selected_file:$selected_line" |
488 | .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10] | |
489 | grab .file_popup | |
754e5da2 SG |
490 | } |
491 | ||
8532893d SG |
492 | # |
493 | # Local procedure: | |
494 | # | |
495 | # listing_window_button_1 (win x y xrel yrel) - Handle button 1 in listing window | |
496 | # | |
497 | # Description: | |
498 | # | |
499 | # This procedure is invoked as a result of holding down button 1 in the | |
500 | # listing window. The action taken depends upon where the button was | |
501 | # pressed. If it was in the left margin (the breakpoint column), it | |
502 | # sets or clears a breakpoint. In the main text area, it will pop up a | |
503 | # menu. | |
504 | # | |
505 | ||
506 | proc listing_window_button_1 {win x y xrel yrel} { | |
507 | global wins | |
508 | global win_to_file | |
509 | global file_to_debug_file | |
510 | global highlight | |
511 | global selected_line | |
512 | global selected_file | |
513 | global selected_win | |
514 | global pos_to_breakpoint | |
515 | ||
516 | # Map TK window name back to file name. | |
517 | ||
518 | set file $win_to_file($win) | |
519 | ||
520 | set pos [split [$win index @$xrel,$yrel] .] | |
521 | ||
522 | # Record selected file and line for menu button actions | |
523 | ||
524 | set selected_file $file_to_debug_file($file) | |
525 | set selected_line [lindex $pos 0] | |
526 | set selected_col [lindex $pos 1] | |
527 | set selected_win $win | |
528 | ||
529 | # If we're in the margin, then toggle the breakpoint | |
530 | ||
531 | if {$selected_col < 8} { | |
532 | set pos_break $selected_file:$selected_line | |
533 | set pos $file:$selected_line | |
534 | set tmp pos_to_breakpoint($pos) | |
535 | if [info exists $tmp] { | |
536 | set bpnum [set $tmp] | |
537 | gdb_cmd "delete $bpnum" | |
538 | } else { | |
539 | gdb_cmd "break $pos_break" | |
540 | } | |
541 | return | |
542 | } | |
543 | ||
544 | # Post the menu near the pointer, (and grab it) | |
545 | ||
546 | .file_popup entryconfigure 0 -label "$selected_file:$selected_line" | |
547 | .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10] | |
548 | grab .file_popup | |
549 | } | |
550 | ||
551 | # | |
552 | # Local procedure: | |
553 | # | |
554 | # asm_window_button_1 (win x y xrel yrel) - Handle button 1 in asm window | |
555 | # | |
556 | # Description: | |
557 | # | |
558 | # This procedure is invoked as a result of holding down button 1 in the | |
559 | # assembly window. The action taken depends upon where the button was | |
560 | # pressed. If it was in the left margin (the breakpoint column), it | |
561 | # sets or clears a breakpoint. In the main text area, it will pop up a | |
562 | # menu. | |
563 | # | |
564 | ||
565 | proc asm_window_button_1 {win x y xrel yrel} { | |
566 | global wins | |
567 | global win_to_file | |
568 | global file_to_debug_file | |
569 | global highlight | |
570 | global selected_line | |
571 | global selected_file | |
572 | global selected_win | |
573 | global pos_to_breakpoint | |
574 | global pclist | |
575 | global cfunc | |
576 | ||
577 | set pos [split [$win index @$xrel,$yrel] .] | |
578 | ||
579 | # Record selected file and line for menu button actions | |
580 | ||
581 | set selected_line [lindex $pos 0] | |
582 | set selected_col [lindex $pos 1] | |
583 | set selected_win $win | |
584 | ||
585 | # Figure out the PC | |
586 | ||
587 | set pc [lindex $pclist($cfunc) $selected_line] | |
588 | ||
589 | # If we're in the margin, then toggle the breakpoint | |
590 | ||
591 | if {$selected_col < 8} { | |
592 | set tmp pos_to_breakpoint($pc) | |
593 | if [info exists $tmp] { | |
594 | set bpnum [set $tmp] | |
595 | gdb_cmd "delete $bpnum" | |
596 | } else { | |
597 | gdb_cmd "break *$pc" | |
598 | } | |
599 | return | |
600 | } | |
601 | ||
602 | # Post the menu near the pointer, (and grab it) | |
603 | ||
604 | # .file_popup entryconfigure 0 -label "$selected_file:$selected_line" | |
605 | # .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10] | |
606 | # grab .file_popup | |
607 | } | |
608 | ||
609 | # | |
610 | # Local procedure: | |
611 | # | |
612 | # do_nothing - Does absoultely nothing. | |
613 | # | |
614 | # Description: | |
615 | # | |
616 | # This procedure does nothing. It is used as a placeholder to allow | |
617 | # the disabling of bindings that would normally be inherited from the | |
618 | # parent widget. I can't think of any other way to do this. | |
619 | # | |
620 | ||
754e5da2 SG |
621 | proc do_nothing {} {} |
622 | ||
8532893d SG |
623 | # |
624 | # Local procedure: | |
625 | # | |
626 | # create_file_win (filename) - Create a win for FILENAME. | |
627 | # | |
628 | # Return value: | |
629 | # | |
630 | # The new text widget. | |
631 | # | |
632 | # Description: | |
633 | # | |
634 | # This procedure creates a text widget for FILENAME. It returns the | |
635 | # newly created widget. First, a text widget is created, and given basic | |
636 | # configuration info. Second, all the bindings are setup. Third, the | |
637 | # file FILENAME is read into the text widget. Fourth, margins and line | |
638 | # numbers are added. | |
639 | # | |
640 | ||
754e5da2 SG |
641 | proc create_file_win {filename} { |
642 | global breakpoint_file | |
643 | global breakpoint_line | |
644 | ||
8532893d SG |
645 | # Replace all the dirty characters in $filename with clean ones, and generate |
646 | # a unique name for the text widget. | |
647 | ||
754e5da2 SG |
648 | regsub -all {\.|/} $filename {} temp |
649 | set win .text$temp | |
8532893d | 650 | |
637b1661 SG |
651 | # Open the file, and read it into the text widget |
652 | ||
653 | if [catch "open $filename" fh] { | |
654 | # File can't be read. Put error message into .nofile window and return. | |
655 | ||
656 | catch {destroy .nofile} | |
657 | text .nofile -height 25 -width 80 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 | |
658 | .nofile insert 0.0 $fh | |
659 | .nofile configure -state disabled | |
660 | bind .nofile <1> do_nothing | |
661 | bind .nofile <B1-Motion> do_nothing | |
662 | return .nofile | |
663 | } | |
664 | ||
8532893d SG |
665 | # Actually create and do basic configuration on the text widget. |
666 | ||
754e5da2 | 667 | text $win -height 25 -width 80 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 |
8532893d SG |
668 | |
669 | # Setup all the bindings | |
670 | ||
754e5da2 | 671 | bind $win <Enter> {focus %W} |
8532893d | 672 | bind $win <1> {listing_window_button_1 %W %X %Y %x %y} |
754e5da2 SG |
673 | bind $win <B1-Motion> do_nothing |
674 | bind $win n {gdb_cmd next ; update_ptr} | |
675 | bind $win s {gdb_cmd step ; update_ptr} | |
676 | bind $win c {gdb_cmd continue ; update_ptr} | |
677 | bind $win f {gdb_cmd finish ; update_ptr} | |
678 | bind $win u {gdb_cmd up ; update_ptr} | |
679 | bind $win d {gdb_cmd down ; update_ptr} | |
8532893d | 680 | |
754e5da2 SG |
681 | $win delete 0.0 end |
682 | $win insert 0.0 [read $fh] | |
683 | close $fh | |
8532893d SG |
684 | |
685 | # Add margins (for annotations) and a line number to each line | |
686 | ||
754e5da2 SG |
687 | set numlines [$win index end] |
688 | set numlines [lindex [split $numlines .] 0] | |
689 | for {set i 1} {$i <= $numlines} {incr i} { | |
690 | $win insert $i.0 [format " %4d " $i] | |
691 | } | |
692 | ||
8532893d SG |
693 | # Scan though the breakpoint data base and install any destined for this file |
694 | ||
754e5da2 SG |
695 | foreach bpnum [array names breakpoint_file] { |
696 | if {$breakpoint_file($bpnum) == $filename} { | |
697 | insert_breakpoint_tag $win $breakpoint_line($bpnum) | |
698 | } | |
699 | } | |
700 | ||
8532893d SG |
701 | # Disable the text widget to prevent user modifications |
702 | ||
754e5da2 SG |
703 | $win configure -state disabled |
704 | return $win | |
705 | } | |
706 | ||
8532893d SG |
707 | # |
708 | # Local procedure: | |
709 | # | |
637b1661 | 710 | # create_asm_win (funcname pc) - Create an assembly win for FUNCNAME. |
8532893d SG |
711 | # |
712 | # Return value: | |
713 | # | |
714 | # The new text widget. | |
715 | # | |
716 | # Description: | |
717 | # | |
718 | # This procedure creates a text widget for FUNCNAME. It returns the | |
719 | # newly created widget. First, a text widget is created, and given basic | |
720 | # configuration info. Second, all the bindings are setup. Third, the | |
721 | # function FUNCNAME is read into the text widget. | |
722 | # | |
723 | ||
637b1661 | 724 | proc create_asm_win {funcname pc} { |
8532893d SG |
725 | global breakpoint_file |
726 | global breakpoint_line | |
727 | global current_output_win | |
728 | global pclist | |
729 | ||
730 | # Replace all the dirty characters in $filename with clean ones, and generate | |
731 | # a unique name for the text widget. | |
732 | ||
335129a9 | 733 | set win [asm_win_name $funcname] |
8532893d SG |
734 | |
735 | # Actually create and do basic configuration on the text widget. | |
736 | ||
737 | text $win -height 25 -width 80 -relief raised -borderwidth 2 \ | |
738 | -setgrid true -cursor hand2 -yscrollcommand asmscrollproc | |
739 | ||
740 | # Setup all the bindings | |
741 | ||
742 | bind $win <Enter> {focus %W} | |
743 | bind $win <1> {asm_window_button_1 %W %X %Y %x %y} | |
744 | bind $win <B1-Motion> do_nothing | |
745 | bind $win n {gdb_cmd nexti ; update_ptr} | |
746 | bind $win s {gdb_cmd stepi ; update_ptr} | |
747 | bind $win c {gdb_cmd continue ; update_ptr} | |
748 | bind $win f {gdb_cmd finish ; update_ptr} | |
749 | bind $win u {gdb_cmd up ; update_ptr} | |
750 | bind $win d {gdb_cmd down ; update_ptr} | |
751 | ||
752 | # Disassemble the code, and read it into the new text widget | |
753 | ||
754 | set current_output_win $win | |
637b1661 | 755 | gdb_cmd "disassemble $pc" |
8532893d SG |
756 | set current_output_win .command.text |
757 | ||
758 | set numlines [$win index end] | |
759 | set numlines [lindex [split $numlines .] 0] | |
637b1661 | 760 | decr numlines |
8532893d SG |
761 | |
762 | # Delete the first and last lines, cuz these contain useless info | |
763 | ||
764 | $win delete 1.0 2.0 | |
765 | $win delete {end - 1 lines} end | |
637b1661 | 766 | decr numlines 2 |
8532893d SG |
767 | |
768 | # Add margins (for annotations) and note the PC for each line | |
769 | ||
637b1661 | 770 | catch "unset pclist($funcname)" |
335129a9 | 771 | lappend pclist($funcname) Unused |
8532893d SG |
772 | for {set i 1} {$i <= $numlines} {incr i} { |
773 | scan [$win get $i.0 "$i.0 lineend"] "%s " pc | |
774 | lappend pclist($funcname) $pc | |
775 | $win insert $i.0 " " | |
776 | } | |
777 | ||
778 | ||
779 | # Scan though the breakpoint data base and install any destined for this file | |
780 | ||
781 | # foreach bpnum [array names breakpoint_file] { | |
782 | # if {$breakpoint_file($bpnum) == $filename} { | |
783 | # insert_breakpoint_tag $win $breakpoint_line($bpnum) | |
784 | # } | |
785 | # } | |
786 | ||
787 | # Disable the text widget to prevent user modifications | |
788 | ||
789 | $win configure -state disabled | |
790 | return $win | |
791 | } | |
792 | ||
793 | # | |
794 | # Local procedure: | |
795 | # | |
796 | # asmscrollproc (WINHEIGHT SCREENHEIGHT SCREENTOP SCREENBOT) - Update the | |
797 | # asm window scrollbar. | |
798 | # | |
799 | # Description: | |
800 | # | |
801 | # This procedure is called to update the assembler window's scrollbar. | |
802 | # | |
803 | ||
804 | proc asmscrollproc {args} { | |
805 | global asm_screen_height asm_screen_top asm_screen_bot | |
806 | ||
807 | eval ".asm.scroll set $args" | |
808 | set asm_screen_height [lindex $args 1] | |
809 | set asm_screen_top [lindex $args 2] | |
810 | set asm_screen_bot [lindex $args 3] | |
811 | } | |
812 | ||
813 | # | |
814 | # Local procedure: | |
815 | # | |
816 | # update_listing (linespec) - Update the listing window according to | |
817 | # LINESPEC. | |
818 | # | |
819 | # Description: | |
820 | # | |
821 | # This procedure is called from various places to update the listing | |
822 | # window based on LINESPEC. It is usually invoked with the result of | |
823 | # gdb_loc. | |
824 | # | |
825 | # It will move the cursor, and scroll the text widget if necessary. | |
826 | # Also, it will switch to another text widget if necessary, and update | |
827 | # the label widget too. | |
828 | # | |
829 | # LINESPEC is a list of the form: | |
830 | # | |
831 | # { DEBUG_FILE FUNCNAME FILENAME LINE }, where: | |
832 | # | |
833 | # DEBUG_FILE - is the abbreviated form of the file name. This is usually | |
834 | # the file name string given to the cc command. This is | |
835 | # primarily needed for breakpoint commands, and when an | |
836 | # abbreviated for of the filename is desired. | |
837 | # FUNCNAME - is the name of the function. | |
838 | # FILENAME - is the fully qualified (absolute) file name. It is usually | |
839 | # the same as $PWD/$DEBUG_FILE, where PWD is the working dir | |
840 | # at the time the cc command was given. This is used to | |
841 | # actually locate the file to be displayed. | |
842 | # LINE - The line number to be displayed. | |
843 | # | |
844 | # Usually, this procedure will just move the cursor one line down to the | |
845 | # next line to be executed. However, if the cursor moves out of range | |
846 | # or into another file, it will scroll the text widget so that the line | |
847 | # of interest is in the middle of the viewable portion of the widget. | |
848 | # | |
849 | ||
754e5da2 SG |
850 | proc update_listing {linespec} { |
851 | global pointers | |
852 | global screen_height | |
853 | global screen_top | |
854 | global screen_bot | |
855 | global wins cfile | |
856 | global current_label | |
857 | global win_to_file | |
858 | global file_to_debug_file | |
859 | ||
8532893d SG |
860 | # Rip the linespec apart |
861 | ||
754e5da2 SG |
862 | set line [lindex $linespec 3] |
863 | set filename [lindex $linespec 2] | |
864 | set funcname [lindex $linespec 1] | |
865 | set debug_file [lindex $linespec 0] | |
866 | ||
8532893d SG |
867 | # Sometimes there's no source file for this location |
868 | ||
754e5da2 SG |
869 | if {$filename == ""} {set filename Blank} |
870 | ||
8532893d SG |
871 | # If we want to switch files, we need to unpack the current text widget, and |
872 | # stick in the new one. | |
873 | ||
754e5da2 SG |
874 | if {$filename != $cfile} then { |
875 | pack forget $wins($cfile) | |
876 | set cfile $filename | |
8532893d SG |
877 | |
878 | # Create a text widget for this file if necessary | |
879 | ||
754e5da2 SG |
880 | if ![info exists wins($cfile)] then { |
881 | set wins($cfile) [create_file_win $cfile] | |
637b1661 SG |
882 | if {$wins($cfile) != ".nofile"} { |
883 | set win_to_file($wins($cfile)) $cfile | |
884 | set file_to_debug_file($cfile) $debug_file | |
885 | set pointers($cfile) 1.1 | |
886 | } | |
754e5da2 SG |
887 | } |
888 | ||
8532893d SG |
889 | # Pack the text widget into the listing widget, and scroll to the right place |
890 | ||
754e5da2 SG |
891 | pack $wins($cfile) -side left -expand yes -in .listing -fill both -after .label |
892 | $wins($cfile) yview [expr $line - $screen_height / 2] | |
893 | } | |
894 | ||
8532893d SG |
895 | # Update the label widget in case the filename or function name has changed |
896 | ||
754e5da2 SG |
897 | if {$current_label != "$filename.$funcname"} then { |
898 | set tail [expr [string last / $filename] + 1] | |
899 | .label configure -text "[string range $filename $tail end] : ${funcname}()" | |
900 | set current_label $filename.$funcname | |
901 | } | |
902 | ||
8532893d SG |
903 | # Update the pointer, scrolling the text widget if necessary to keep the |
904 | # pointer in an acceptable part of the screen. | |
905 | ||
754e5da2 SG |
906 | if [info exists pointers($cfile)] then { |
907 | $wins($cfile) configure -state normal | |
908 | set pointer_pos $pointers($cfile) | |
909 | $wins($cfile) configure -state normal | |
910 | $wins($cfile) delete $pointer_pos | |
911 | $wins($cfile) insert $pointer_pos " " | |
912 | ||
913 | set pointer_pos [$wins($cfile) index $line.1] | |
914 | set pointers($cfile) $pointer_pos | |
915 | ||
916 | $wins($cfile) delete $pointer_pos | |
917 | $wins($cfile) insert $pointer_pos "\xbb" | |
918 | ||
919 | if {$line < $screen_top + 1 | |
920 | || $line > $screen_bot} then { | |
921 | $wins($cfile) yview [expr $line - $screen_height / 2] | |
922 | } | |
923 | ||
924 | $wins($cfile) configure -state disabled | |
925 | } | |
926 | } | |
927 | ||
8532893d SG |
928 | # |
929 | # Local procedure: | |
930 | # | |
931 | # update_ptr - Update the listing window. | |
932 | # | |
933 | # Description: | |
934 | # | |
935 | # This routine will update the listing window using the result of | |
936 | # gdb_loc. | |
937 | # | |
938 | ||
754e5da2 SG |
939 | proc update_ptr {} {update_listing [gdb_loc]} |
940 | ||
8532893d SG |
941 | # |
942 | # Local procedure: | |
943 | # | |
944 | # asm_command - Open up the assembly window. | |
945 | # | |
946 | # Description: | |
947 | # | |
948 | # Create an assembly window if it doesn't exist. | |
949 | # | |
950 | ||
951 | proc asm_command {} { | |
952 | global cfunc | |
953 | ||
954 | if ![winfo exists .asm] { | |
955 | set cfunc *None* | |
335129a9 SG |
956 | set win [asm_win_name $cfunc] |
957 | ||
8532893d SG |
958 | toplevel .asm |
959 | wm minsize .asm 1 1 | |
335129a9 | 960 | wm title .asm Assembly |
8532893d SG |
961 | |
962 | label .asm.label -text "*NIL*" -borderwidth 2 -relief raised | |
963 | text $win -height 25 -width 80 -relief raised -borderwidth 2 \ | |
964 | -setgrid true -cursor hand2 \ | |
965 | -yscrollcommand asmscrollproc | |
966 | scrollbar .asm.scroll -orient vertical -command {$win yview} | |
967 | frame .asm.buts | |
968 | ||
969 | button .asm.stepi -text Stepi \ | |
970 | -command {gdb_cmd stepi ; update_ptr} | |
971 | button .asm.nexti -text Nexti \ | |
972 | -command {gdb_cmd nexti ; update_ptr} | |
973 | button .asm.continue -text Continue \ | |
974 | -command {gdb_cmd continue ; update_ptr} | |
975 | button .asm.finish -text Finish \ | |
976 | -command {gdb_cmd finish ; update_ptr} | |
977 | button .asm.up -text Up -command {gdb_cmd up ; update_ptr} | |
978 | button .asm.down -text Down \ | |
979 | -command {gdb_cmd down ; update_ptr} | |
980 | button .asm.bottom -text Bottom \ | |
981 | -command {gdb_cmd {frame 0} ; update_ptr} | |
982 | button .asm.close -text Close -command {destroy .asm} | |
983 | ||
984 | pack .asm.label -side top -fill x | |
985 | pack .asm.stepi .asm.nexti .asm.continue .asm.finish .asm.up \ | |
986 | .asm.down .asm.bottom .asm.close -side left -in .asm.buts | |
987 | pack .asm.buts -side top -fill x | |
988 | pack $win -side left -expand yes -fill both | |
989 | pack .asm.scroll -side left -fill y | |
990 | ||
991 | update | |
992 | } | |
993 | } | |
994 | ||
335129a9 SG |
995 | # |
996 | # Local procedure: | |
997 | # | |
998 | # registers_command - Open up the register display window. | |
999 | # | |
1000 | # Description: | |
1001 | # | |
1002 | # Create the register display window, with automatic updates. | |
1003 | # | |
1004 | ||
1005 | proc registers_command {} { | |
1006 | global cfunc | |
1007 | ||
1008 | if ![winfo exists .reg] { | |
1009 | toplevel .reg | |
1010 | wm minsize .reg 1 1 | |
1011 | wm title .reg Registers | |
1012 | set win .reg.regs | |
1013 | ||
1014 | text $win -height 25 -width 80 -relief raised \ | |
1015 | -borderwidth 2 \ | |
1016 | -setgrid true -cursor hand2 | |
1017 | ||
1018 | pack $win -side left -expand yes -fill both | |
1019 | } else { | |
1020 | destroy .reg | |
1021 | } | |
1022 | } | |
1023 | ||
1024 | # | |
1025 | # Local procedure: | |
1026 | # | |
1027 | # update_registers - Update the registers window. | |
1028 | # | |
1029 | # Description: | |
1030 | # | |
1031 | # This procedure updates the registers window. | |
1032 | # | |
1033 | ||
1034 | proc update_registers {} { | |
1035 | global current_output_win | |
1036 | ||
1037 | set win .reg.regs | |
1038 | ||
1039 | $win configure -state normal | |
1040 | ||
1041 | $win delete 0.0 end | |
1042 | ||
1043 | set current_output_win $win | |
1044 | gdb_cmd "info registers" | |
1045 | set current_output_win .command.text | |
1046 | ||
1047 | $win yview 1 | |
1048 | $win configure -state disabled | |
1049 | } | |
1050 | ||
8532893d SG |
1051 | # |
1052 | # Local procedure: | |
1053 | # | |
1054 | # update_assembly - Update the assembly window. | |
1055 | # | |
1056 | # Description: | |
1057 | # | |
1058 | # This procedure updates the assembly window. | |
1059 | # | |
1060 | ||
1061 | proc update_assembly {linespec} { | |
1062 | global asm_pointers | |
1063 | global screen_height | |
1064 | global screen_top | |
1065 | global screen_bot | |
1066 | global wins cfunc | |
1067 | global current_label | |
1068 | global win_to_file | |
1069 | global file_to_debug_file | |
1070 | global current_asm_label | |
1071 | global pclist | |
1072 | global asm_screen_height asm_screen_top asm_screen_bot | |
1073 | ||
1074 | # Rip the linespec apart | |
1075 | ||
1076 | set pc [lindex $linespec 4] | |
1077 | set line [lindex $linespec 3] | |
1078 | set filename [lindex $linespec 2] | |
1079 | set funcname [lindex $linespec 1] | |
1080 | set debug_file [lindex $linespec 0] | |
1081 | ||
335129a9 | 1082 | set win [asm_win_name $cfunc] |
8532893d SG |
1083 | |
1084 | # Sometimes there's no source file for this location | |
1085 | ||
1086 | if {$filename == ""} {set filename Blank} | |
1087 | ||
1088 | # If we want to switch funcs, we need to unpack the current text widget, and | |
1089 | # stick in the new one. | |
1090 | ||
637b1661 | 1091 | if {$funcname != $cfunc } { |
8532893d SG |
1092 | pack forget $win |
1093 | set cfunc $funcname | |
1094 | ||
335129a9 | 1095 | set win [asm_win_name $cfunc] |
8532893d SG |
1096 | |
1097 | # Create a text widget for this func if necessary | |
1098 | ||
637b1661 SG |
1099 | if {![winfo exists $win]} { |
1100 | create_asm_win $cfunc $pc | |
8532893d SG |
1101 | set asm_pointers($cfunc) 1.1 |
1102 | set current_asm_label NIL | |
1103 | } | |
1104 | ||
1105 | # Pack the text widget, and scroll to the right place | |
1106 | ||
1107 | pack $win -side left -expand yes -fill both \ | |
1108 | -after .asm.buts | |
637b1661 | 1109 | set line [pc_to_line $pclist($cfunc) $pc] |
8532893d SG |
1110 | $win yview [expr $line - $asm_screen_height / 2] |
1111 | } | |
1112 | ||
1113 | # Update the label widget in case the filename or function name has changed | |
1114 | ||
335129a9 SG |
1115 | if {$current_asm_label != "$pc $funcname"} then { |
1116 | .asm.label configure -text "$pc $funcname" | |
1117 | set current_asm_label "$pc $funcname" | |
8532893d SG |
1118 | } |
1119 | ||
1120 | # Update the pointer, scrolling the text widget if necessary to keep the | |
1121 | # pointer in an acceptable part of the screen. | |
1122 | ||
1123 | if [info exists asm_pointers($cfunc)] then { | |
1124 | $win configure -state normal | |
1125 | set pointer_pos $asm_pointers($cfunc) | |
1126 | $win configure -state normal | |
1127 | $win delete $pointer_pos | |
1128 | $win insert $pointer_pos " " | |
1129 | ||
1130 | # Map the PC back to a line in the window | |
1131 | ||
637b1661 | 1132 | set line [pc_to_line $pclist($cfunc) $pc] |
8532893d SG |
1133 | |
1134 | if {$line == -1} { | |
1135 | echo "Can't find PC $pc" | |
1136 | return | |
1137 | } | |
1138 | ||
8532893d SG |
1139 | set pointer_pos [$win index $line.1] |
1140 | set asm_pointers($cfunc) $pointer_pos | |
1141 | ||
1142 | $win delete $pointer_pos | |
1143 | $win insert $pointer_pos "\xbb" | |
1144 | ||
1145 | if {$line < $asm_screen_top + 1 | |
1146 | || $line > $asm_screen_bot} then { | |
1147 | $win yview [expr $line - $asm_screen_height / 2] | |
1148 | } | |
1149 | ||
1150 | # echo "Picking line $line" | |
1151 | # $win yview -pickplace $line | |
1152 | ||
1153 | $win configure -state disabled | |
1154 | } | |
1155 | } | |
1156 | ||
1157 | proc update_ptr {} { | |
1158 | update_listing [gdb_loc] | |
1159 | if [winfo exists .asm] { | |
1160 | update_assembly [gdb_loc] | |
1161 | } | |
335129a9 SG |
1162 | if [winfo exists .reg] { |
1163 | update_registers | |
1164 | } | |
8532893d SG |
1165 | } |
1166 | ||
1167 | # | |
1168 | # Window: | |
1169 | # | |
1170 | # listing window - Define the listing window. | |
1171 | # | |
1172 | # Description: | |
1173 | # | |
1174 | # | |
1175 | ||
754e5da2 SG |
1176 | # Setup listing window |
1177 | ||
1178 | frame .listing | |
1179 | ||
1180 | wm minsize . 1 1 | |
1181 | ||
1182 | label .label -text "*No file*" -borderwidth 2 -relief raised | |
1183 | text $wins($cfile) -height 25 -width 80 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 | |
1184 | scrollbar .scroll -orient vertical -command {$wins($cfile) yview} | |
1185 | ||
1186 | if {[tk colormodel .text] == "color"} { | |
1187 | set highlight "-background red2 -borderwidth 2 -relief sunk" | |
1188 | } else { | |
1189 | set fg [lindex [.text config -foreground] 4] | |
1190 | set bg [lindex [.text config -background] 4] | |
1191 | set highlight "-foreground $bg -background $fg -borderwidth 0" | |
1192 | } | |
1193 | ||
1194 | proc textscrollproc {args} {global screen_height screen_top screen_bot | |
1195 | eval ".scroll set $args" | |
1196 | set screen_height [lindex $args 1] | |
1197 | set screen_top [lindex $args 2] | |
1198 | set screen_bot [lindex $args 3]} | |
1199 | ||
1200 | $wins($cfile) insert 0.0 " This page intentionally left blank." | |
1201 | $wins($cfile) configure -state disabled | |
1202 | ||
1203 | pack .label -side bottom -fill x -in .listing | |
1204 | pack $wins($cfile) -side left -expand yes -in .listing -fill both | |
1205 | pack .scroll -side left -fill y -in .listing | |
1206 | ||
1207 | button .start -text Start -command \ | |
1208 | {gdb_cmd {break main} | |
1209 | gdb_cmd {enable delete $bpnum} | |
1210 | gdb_cmd run | |
1211 | update_ptr } | |
1212 | button .step -text Step -command {gdb_cmd step ; update_ptr} | |
1213 | button .next -text Next -command {gdb_cmd next ; update_ptr} | |
1214 | button .continue -text Continue -command {gdb_cmd continue ; update_ptr} | |
1215 | button .finish -text Finish -command {gdb_cmd finish ; update_ptr} | |
1216 | #button .test -text Test -command {echo [info var]} | |
1217 | button .exit -text Exit -command {gdb_cmd quit} | |
1218 | button .up -text Up -command {gdb_cmd up ; update_ptr} | |
1219 | button .down -text Down -command {gdb_cmd down ; update_ptr} | |
335129a9 SG |
1220 | button .bottom -text Bottom -command {gdb_cmd {frame 0} ; update_ptr} |
1221 | button .asm_but -text Asm -command {asm_command ; update_ptr} | |
1222 | button .registers -text Regs -command {registers_command ; update_ptr} | |
754e5da2 SG |
1223 | |
1224 | proc files_command {} { | |
1225 | toplevel .files_window | |
1226 | ||
1227 | wm minsize .files_window 1 1 | |
1228 | # wm overrideredirect .files_window true | |
1229 | listbox .files_window.list -geometry 30x20 -setgrid true | |
1230 | button .files_window.close -text Close -command {destroy .files_window} | |
1231 | tk_listboxSingleSelect .files_window.list | |
1232 | eval .files_window.list insert 0 [lsort [gdb_listfiles]] | |
1233 | pack .files_window.list -side top -fill both -expand yes | |
1234 | pack .files_window.close -side bottom -fill x -expand no -anchor s | |
1235 | bind .files_window.list <Any-ButtonRelease-1> { | |
1236 | set file [%W get [%W curselection]] | |
1237 | gdb_cmd "list $file:1,0" | |
1238 | update_listing [gdb_loc $file:1] | |
1239 | destroy .files_window} | |
1240 | } | |
1241 | ||
1242 | button .files -text Files -command files_command | |
1243 | ||
1244 | pack .listing -side bottom -fill both -expand yes | |
1245 | #pack .test -side bottom -fill x | |
335129a9 SG |
1246 | pack .start .step .next .continue .finish .up .down .bottom .asm_but \ |
1247 | .registers .files .exit -side left | |
754e5da2 | 1248 | toplevel .command |
335129a9 | 1249 | wm title .command Command |
754e5da2 SG |
1250 | |
1251 | # Setup command window | |
1252 | ||
1253 | label .command.label -text "* Command Buffer *" -borderwidth 2 -relief raised | |
1254 | text .command.text -height 25 -width 80 -relief raised -borderwidth 2 -setgrid true -cursor hand2 | |
1255 | ||
1256 | pack .command.label -side top -fill x | |
1257 | pack .command.text -side top -expand yes -fill both | |
1258 | ||
1259 | set command_line {} | |
1260 | ||
1261 | gdb_cmd {set language c} | |
1262 | gdb_cmd {set height 0} | |
1263 | gdb_cmd {set width 0} | |
1264 | ||
1265 | bind .command.text <Any-Key> { | |
1266 | global command_line | |
1267 | ||
1268 | %W insert end %A | |
1269 | %W yview -pickplace end | |
1270 | append command_line %A | |
1271 | } | |
1272 | bind .command.text <Key-Return> { | |
1273 | global command_line | |
1274 | ||
1275 | %W insert end \n | |
1276 | %W yview -pickplace end | |
1277 | gdb_cmd $command_line | |
1278 | set command_line {} | |
1279 | update_ptr | |
1280 | %W insert end "(gdb) " | |
1281 | %W yview -pickplace end | |
1282 | } | |
1283 | bind .command.text <Enter> {focus %W} | |
1284 | bind .command.text <Delete> {delete_char %W} | |
1285 | bind .command.text <BackSpace> {delete_char %W} | |
1286 | proc delete_char {win} { | |
1287 | global command_line | |
1288 | ||
1289 | tk_textBackspace $win | |
1290 | $win yview -pickplace insert | |
1291 | set tmp [expr [string length $command_line] - 2] | |
1292 | set command_line [string range $command_line 0 $tmp] | |
1293 | } | |
1294 | ||
1295 | wm minsize .command 1 1 |