gdb/gdbtk.tcl

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