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