From 746d1df4a9f64da38da324be849beb5fd389135b Mon Sep 17 00:00:00 2001 From: Stu Grossman Date: Mon, 12 Dec 1994 20:50:08 +0000 Subject: [PATCH] * gdbtk.c: New tcl commands: gdb_fetch_registers, gdb_changed_register_list, and gdb_regnames. * gdbtk.tcl: Use monochrome color model for now. * (delete_breakpoint_tag create_file_win): Add breakdot support. * (create_file_win create_asm_win update_listing build_framework create_source_window create_command_window): Re-org window creation to give all windows consistent look and feel. * (update_listing update_asm): Change pc pointer to '->'. * (registers_command reg_config_menu create_registers_window populate_reg_window update_registers): Revamp register window. Allow selection of registers to be displayed. Highlight changed registers. --- gdb/ChangeLog | 15 ++ gdb/gdbtk.c | 196 ++++++++++++++++++- gdb/gdbtk.tcl | 510 ++++++++++++++++++++++++++++++++++++-------------- 3 files changed, 572 insertions(+), 149 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 4f04e8384b9..6a157f631d5 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,18 @@ +Mon Dec 12 12:22:21 1994 Stu Grossman (grossman@cygnus.com) + + * gdbtk.c: New tcl commands: gdb_fetch_registers, + gdb_changed_register_list, and gdb_regnames. + * gdbtk.tcl: Use monochrome color model for now. + * (delete_breakpoint_tag create_file_win): Add breakdot support. + * (create_file_win create_asm_win update_listing build_framework + create_source_window create_command_window): Re-org window + creation to give all windows consistent look and feel. + * (update_listing update_asm): Change pc pointer to '->'. + * (registers_command reg_config_menu create_registers_window + populate_reg_window update_registers): Revamp register window. + Allow selection of registers to be displayed. Highlight changed + registers. + Fri Dec 9 15:50:05 1994 Stan Shebs * remote.c (remote_wait): Pass string instead of char to strcpy. diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index c2a1e383aa6..290ed644f18 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -348,6 +348,62 @@ gdb_sourcelines (clientData, interp, argc, argv) return TCL_OK; } +static int +map_arg_registers (argc, argv, func, argp) + int argc; + char *argv[]; + int (*func) PARAMS ((int regnum, void *argp)); + void *argp; +{ + int regnum; + + /* Note that the test for a valid register must include checking the + reg_names array because NUM_REGS may be allocated for the union of the + register sets within a family of related processors. In this case, the + trailing entries of reg_names will change depending upon the particular + processor being debugged. */ + + if (argc == 0) /* No args, just do all the regs */ + { + for (regnum = 0; + regnum < NUM_REGS + && reg_names[regnum] != NULL + && *reg_names[regnum] != '\000'; + regnum++) + func (regnum, argp); + + return TCL_OK; + } + + /* Else, list of register #s, just do listed regs */ + for (; argc > 0; argc--, argv++) + { + regnum = atoi (*argv); + + if (regnum >= 0 + && regnum < NUM_REGS + && reg_names[regnum] != NULL + && *reg_names[regnum] != '\000') + func (regnum, argp); + else + { + Tcl_SetResult (interp, "bad register number", TCL_STATIC); + + return TCL_ERROR; + } + } + + return TCL_OK; +} + +static int +get_register_name (regnum, argp) + int regnum; + void *argp; /* Ignored */ +{ + Tcl_AppendElement (interp, reg_names[regnum]); +} + /* This implements the TCL command `gdb_regnames', which returns a list of all of the register names. */ @@ -358,18 +414,142 @@ gdb_regnames (clientData, interp, argc, argv) int argc; char *argv[]; { - int i; + argc--; + argv++; + + return map_arg_registers (argc, argv, get_register_name, 0); +} + +static char reg_value[200]; +static char *reg_valp = reg_value; + +static void +save_reg_value (ptr) + const char *ptr; +{ + int len; + + len = strlen (ptr); + + strncpy (reg_valp, ptr, len + 1); + + reg_valp += len; +} + +#ifndef REGISTER_CONVERTIBLE +#define REGISTER_CONVERTIBLE(x) (0 != 0) +#endif + +#ifndef REGISTER_CONVERT_TO_VIRTUAL +#define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a) +#endif + +#ifndef INVALID_FLOAT +#define INVALID_FLOAT(x, y) (0 != 0) +#endif + +static int +get_register (regnum, fp) + void *fp; +{ + char raw_buffer[MAX_REGISTER_RAW_SIZE]; + char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE]; + int format = (int)fp; - if (argc != 1) + if (read_relative_register_raw_bytes (regnum, raw_buffer)) + { + Tcl_AppendElement (interp, "Optimized out"); + return; + } + + fputs_unfiltered_hook = save_reg_value; + flush_hook = 0; + reg_valp = reg_value; + + /* Convert raw data to virtual format if necessary. */ + + if (REGISTER_CONVERTIBLE (regnum)) + { + REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum), + raw_buffer, virtual_buffer); + } + else + memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum)); + + val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, + gdb_stdout, format, 1, 0, Val_pretty_default); + + fputs_unfiltered_hook = gdbtk_fputs; + flush_hook = gdbtk_flush; + + Tcl_AppendElement (interp, reg_value); +} + +static int +gdb_fetch_registers (clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char *argv[]; +{ + int format; + + if (argc < 2) { Tcl_SetResult (interp, "wrong # args", TCL_STATIC); return TCL_ERROR; } - for (i = 0; i < NUM_REGS; i++) - Tcl_AppendElement (interp, reg_names[i]); + argc--; + argv++; - return TCL_OK; + argc--; + format = **argv++; + + return map_arg_registers (argc, argv, get_register, format); +} + +/* This contains the previous values of the registers, since the last call to + gdb_changed_register_list. */ + +static char old_regs[REGISTER_BYTES]; + +static int +register_changed_p (regnum, argp) + void *argp; /* Ignored */ +{ + char raw_buffer[MAX_REGISTER_RAW_SIZE]; + char buf[100]; + + if (read_relative_register_raw_bytes (regnum, raw_buffer)) + return; + + if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer, + REGISTER_RAW_SIZE (regnum)) == 0) + return; + + /* Found a changed register. Save new value and return it's number. */ + + memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer, + REGISTER_RAW_SIZE (regnum)); + + sprintf (buf, "%d", regnum); + Tcl_AppendElement (interp, buf); +} + +static int +gdb_changed_register_list (clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char *argv[]; +{ + int format; + + argc--; + argv++; + + return map_arg_registers (argc, argv, register_changed_p, NULL); } static int @@ -563,9 +743,13 @@ gdbtk_init () Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL); Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL); Tcl_CreateCommand (interp, "gdb_sourcelines", gdb_sourcelines, NULL, NULL); - Tcl_CreateCommand (interp, "gdb_regnames", gdb_regnames, NULL, NULL); Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL); Tcl_CreateCommand (interp, "gdb_stop", gdb_stop, NULL, NULL); + Tcl_CreateCommand (interp, "gdb_regnames", gdb_regnames, NULL, NULL); + Tcl_CreateCommand (interp, "gdb_fetch_registers", gdb_fetch_registers, NULL, + NULL); + Tcl_CreateCommand (interp, "gdb_changed_register_list", + gdb_changed_register_list, NULL, NULL); gdbtk_filename = getenv ("GDBTK_FILENAME"); if (!gdbtk_filename) diff --git a/gdb/gdbtk.tcl b/gdb/gdbtk.tcl index 6ad1735e55d..12f1ee35c17 100644 --- a/gdb/gdbtk.tcl +++ b/gdb/gdbtk.tcl @@ -11,6 +11,7 @@ set cfunc NIL #option add *Foreground Black #option add *Background White #option add *Font -*-*-medium-r-normal--18-*-*-*-m-*-*-1 +tk colormodel . monochrome proc echo string {puts stdout $string} @@ -341,7 +342,11 @@ proc insert_breakpoint_tag {win line} { proc delete_breakpoint_tag {win line} { $win configure -state normal $win delete $line.0 - $win insert $line.0 " " + if {[string range $win 0 3] == ".src"} then { + $win insert $line.0 "\xa4" + } else { + $win insert $line.0 " " + } $win tag delete $line $win tag add delete $line.0 "$line.0 lineend" $win tag add margin $line.0 "$line.0 lineend" @@ -631,7 +636,7 @@ proc asm_window_button_1 {win x y xrel yrel} { # If we're in the margin, then toggle the breakpoint - if {$selected_col < 8} { + if {$selected_col < 11} { set tmp pos_to_breakpoint($pc) if [info exists $tmp] { set bpnum [set $tmp] @@ -724,33 +729,36 @@ proc display_expression {expression} { # numbers are added. # -proc create_file_win {filename} { +proc create_file_win {filename debug_file} { global breakpoint_file global breakpoint_line # Replace all the dirty characters in $filename with clean ones, and generate # a unique name for the text widget. - regsub -all {\.|/} $filename {} temp + regsub -all {\.} $filename {} temp set win .src.text$temp # Open the file, and read it into the text widget if [catch "open $filename" fh] { -# File can't be read. Put error message into .nofile window and return. - - catch {destroy .nofile} - text .nofile -height 25 -width 88 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 - .nofile insert 0.0 $fh - .nofile configure -state disabled - bind .nofile <1> do_nothing - bind .nofile do_nothing - return .nofile +# File can't be read. Put error message into .src.nofile window and return. + + catch {destroy .src.nofile} + text .src.nofile -height 25 -width 88 -relief raised \ + -borderwidth 2 -yscrollcommand textscrollproc \ + -setgrid true -cursor hand2 + .src.nofile insert 0.0 $fh + .src.nofile configure -state disabled + bind .src.nofile <1> do_nothing + bind .src.nofile do_nothing + return .src.nofile } # Actually create and do basic configuration on the text widget. - text $win -height 25 -width 88 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 + text $win -height 25 -width 88 -relief raised -borderwidth 2 \ + -yscrollcommand textscrollproc -setgrid true -cursor hand2 # Setup all the bindings @@ -776,10 +784,17 @@ proc create_file_win {filename} { set numlines [lindex [split $numlines .] 0] for {set i 1} {$i <= $numlines} {incr i} { $win insert $i.0 [format " %4d " $i] - $win tag add margin $i.0 $i.8 $win tag add source $i.8 "$i.0 lineend" } +# Add the breakdots + + foreach i [gdb_sourcelines $debug_file] { + $win delete $i.0 + $win insert $i.0 "\xa4" + $win tag add margin $i.0 $i.8 + } + $win tag bind margin <1> {listing_window_button_1 %W %X %Y %x %y} $win tag bind source <1> { %W mark set anchor "@%x,%y wordstart" @@ -973,6 +988,7 @@ proc update_listing {linespec} { global current_label global win_to_file global file_to_debug_file + global .src.label # Rip the linespec apart @@ -995,8 +1011,8 @@ proc update_listing {linespec} { # Create a text widget for this file if necessary if ![info exists wins($cfile)] then { - set wins($cfile) [create_file_win $cfile] - if {$wins($cfile) != ".nofile"} { + set wins($cfile) [create_file_win $cfile $debug_file] + if {$wins($cfile) != ".src.nofile"} { set win_to_file($wins($cfile)) $cfile set file_to_debug_file($cfile) $debug_file set pointers($cfile) 1.1 @@ -1005,7 +1021,13 @@ proc update_listing {linespec} { # Pack the text widget into the listing widget, and scroll to the right place - pack $wins($cfile) -side left -expand yes -in .src.info -fill both -after .src.scroll + pack $wins($cfile) -side left -expand yes -in .src.info \ + -fill both -after .src.scroll + +# Make the scrollbar point at the new text widget + + .src.scroll configure -command "$wins($cfile) yview" + $wins($cfile) yview [expr $line - $screen_height / 2] } @@ -1013,7 +1035,8 @@ proc update_listing {linespec} { if {$current_label != "$filename.$funcname"} then { set tail [expr [string last / $filename] + 1] - .src.label configure -text "[string range $filename $tail end] : ${funcname}()" + set .src.label "[string range $filename $tail end] : ${funcname}()" +# .src.label configure -text "[string range $filename $tail end] : ${funcname}()" set current_label $filename.$funcname } @@ -1024,14 +1047,14 @@ proc update_listing {linespec} { $wins($cfile) configure -state normal set pointer_pos $pointers($cfile) $wins($cfile) configure -state normal - $wins($cfile) delete $pointer_pos - $wins($cfile) insert $pointer_pos " " + $wins($cfile) delete $pointer_pos "$pointer_pos + 2 char" + $wins($cfile) insert $pointer_pos " " set pointer_pos [$wins($cfile) index $line.1] set pointers($cfile) $pointer_pos - $wins($cfile) delete $pointer_pos - $wins($cfile) insert $pointer_pos "\xbb" + $wins($cfile) delete $pointer_pos "$pointer_pos + 2 char" + $wins($cfile) insert $pointer_pos "->" if {$line < $screen_top + 1 || $line > $screen_bot} then { @@ -1045,14 +1068,14 @@ proc update_listing {linespec} { # # Local procedure: # -# asm_command - Open up the assembly window. +# create_asm_window - Open up the assembly window. # # Description: # # Create an assembly window if it doesn't exist. # -proc asm_command {} { +proc create_asm_window {} { global cfunc if ![winfo exists .asm] { @@ -1093,26 +1116,180 @@ proc asm_command {} { } } +proc reg_config_menu {} { + global reg_format + + catch {destroy .reg.config} + toplevel .reg.config + wm geometry .reg.config +300+300 + wm title .reg.config "Register configuration" + wm iconname .reg.config "Reg config" + set regnames [gdb_regnames] + set num_regs [llength $regnames] + + button .reg.config.done -text Done -command {destroy .reg.config} + + pack .reg.config.done -side bottom -fill x + +# Since there can be lots of registers, we build the window with no more than +# 32 rows, and as many columns as needed. + +# First, figure out how many columns we need and create that many column frame +# widgets + + set ncols [expr ($num_regs + 31) / 32] + + for {set col 0} {$col < $ncols} {incr col} { + frame .reg.config.col$col + pack .reg.config.col$col -side left -anchor n + } + +# Now, create the checkbutton widgets and pack them in the appropriate columns + + set col 0 + set row 0 + for {set regnum 0} {$regnum < $num_regs} {incr regnum} { + set regname [lindex $regnames $regnum] + checkbutton .reg.config.col$col.$row -text $regname -pady 0 \ + -variable regena.$regnum -relief flat -anchor w -bd 1 \ + -command "recompute_reg_display_list $num_regs + populate_reg_window + update_registers all" + + pack .reg.config.col$col.$row -side top -fill both + + incr row + if {$row >= 32} { + incr col + set row 0 + } + } +} + # # Local procedure: # -# registers_command - Open up the register display window. +# create_registers_window - Open up the register display window. # # Description: # # Create the register display window, with automatic updates. # -proc registers_command {} { - global cfunc +proc create_registers_window {} { + global reg_format + + if [winfo exists .reg] return + +# Create an initial register display list consisting of all registers + + if ![info exists reg_format] { + global reg_display_list + global changed_reg_list + + set reg_format {} + set num_regs [llength [gdb_regnames]] + for {set regnum 0} {$regnum < $num_regs} {incr regnum} { + global regena.$regnum + set regena.$regnum 1 + } + recompute_reg_display_list $num_regs + set changed_reg_list $reg_display_list + } + + build_framework .reg Registers + + .reg.menubar.view.menu add command -label Natural + .reg.menubar.view.menu add command -label Config -command { + reg_config_menu } + +# Hex menu item + .reg.menubar.view.menu entryconfigure 0 -command { + global reg_format + + set reg_format x + update_registers all + } +# Decimal menu item + .reg.menubar.view.menu entryconfigure 1 -command { + global reg_format + + set reg_format d + update_registers all + } +# Octal menu item + .reg.menubar.view.menu entryconfigure 2 -command { + global reg_format + + set reg_format o + update_registers all + } +# Natural menu item + .reg.menubar.view.menu entryconfigure 3 -command { + global reg_format + + set reg_format {} + update_registers all + } + + destroy .reg.label + +# Install the reg names + + populate_reg_window +} + +# Convert all of the regena.$regnums into a list of the enabled $regnums + +proc recompute_reg_display_list {num_regs} { + global reg_display_list + + catch {unset reg_display_list} + for {set regnum 0} {$regnum < $num_regs} {incr regnum} { + global regena.$regnum + + if {[set regena.$regnum] != 0} { + lappend reg_display_list $regnum + } + } +} + +# Fill out the register window with the names of the regs specified in +# reg_display_list. + +proc populate_reg_window {} { + global max_regname_width + global reg_display_list + + .reg.text configure -state normal + + .reg.text delete 0.0 end + + set regnames [eval gdb_regnames $reg_display_list] + +# Figure out the longest register name - if ![winfo exists .reg] { - build_framework .reg Registers + set max_regname_width 0 - .reg.text configure -height 40 -width 45 + foreach reg $regnames { + set len [string length $reg] + if {$len > $max_regname_width} {set max_regname_width $len} + } + + set width [expr $max_regname_width + 15] + + set height [llength $regnames] + + if {$height > 60} {set height 60} - destroy .reg.label + .reg.text configure -height $height -width $width + + foreach reg $regnames { + .reg.text insert end [format "%-*s \n" $max_regname_width ${reg}] } + + .reg.text yview 0 + .reg.text configure -state disabled } # @@ -1125,21 +1302,54 @@ proc registers_command {} { # This procedure updates the registers window. # -proc update_registers {} { - global current_output_win +proc update_registers {which} { + global max_regname_width + global reg_format + global reg_display_list + global changed_reg_list + global highlight + set margin [expr $max_regname_width + 1] set win .reg.text + set winwidth [lindex [$win configure -width] 4] + set valwidth [expr $winwidth - $margin] $win configure -state normal - $win delete 0.0 end + if {$which == "all"} { + set row 1 + foreach regnum $reg_display_list { + set regval [gdb_fetch_registers $reg_format $regnum] + set regval [format "%-*s" $valwidth $regval] + $win delete $row.$margin "$row.0 lineend" + $win insert $row.$margin $regval + incr row + } + $win configure -state disabled + return + } - set temp $current_output_win - set current_output_win $win - gdb_cmd "info registers" - set current_output_win $temp +# Unhighlight the old values + + foreach regnum $changed_reg_list { + $win tag delete $win.$regnum + } + +# Now, highlight the changed values of the interesting registers + + set changed_reg_list [eval gdb_changed_register_list $reg_display_list] + + foreach regnum $changed_reg_list { + set regval [gdb_fetch_registers $reg_format $regnum] + set regval [format "%-*s" $valwidth $regval] + set lineindex $regnum + incr lineindex + $win delete $lineindex.$margin "$lineindex.0 lineend" + $win insert $lineindex.$margin $regval + $win tag add $win.$regnum $lineindex.0 "$lineindex.0 lineend" + eval $win tag configure $win.$regnum $highlight + } - $win yview 0 $win configure -state disabled } @@ -1165,6 +1375,7 @@ proc update_assembly {linespec} { global current_asm_label global pclist global asm_screen_height asm_screen_top asm_screen_bot + global .asm.label # Rip the linespec apart @@ -1201,6 +1412,7 @@ proc update_assembly {linespec} { pack $win -side left -expand yes -fill both \ -after .asm.scroll + .asm.scroll configure -command "$win yview" set line [pc_to_line $pclist($cfunc) $pc] $win yview [expr $line - $asm_screen_height / 2] } @@ -1208,7 +1420,8 @@ proc update_assembly {linespec} { # Update the label widget in case the filename or function name has changed if {$current_asm_label != "$pc $funcname"} then { - .asm.label configure -text "$pc $funcname" + set .asm.label "$pc $funcname" +# .asm.label configure -text "$pc $funcname" set current_asm_label "$pc $funcname" } @@ -1219,8 +1432,8 @@ proc update_assembly {linespec} { $win configure -state normal set pointer_pos $asm_pointers($cfunc) $win configure -state normal - $win delete $pointer_pos - $win insert $pointer_pos " " + $win delete $pointer_pos "$pointer_pos + 2 char" + $win insert $pointer_pos " " # Map the PC back to a line in the window @@ -1234,8 +1447,8 @@ proc update_assembly {linespec} { set pointer_pos [$win index $line.1] set asm_pointers($cfunc) $pointer_pos - $win delete $pointer_pos - $win insert $pointer_pos "\xbb" + $win delete $pointer_pos "$pointer_pos + 2 char" + $win insert $pointer_pos "->" if {$line < $asm_screen_top + 1 || $line > $asm_screen_bot} then { @@ -1266,33 +1479,14 @@ proc update_ptr {} { update_assembly [gdb_loc] } if [winfo exists .reg] { - update_registers + update_registers changed } } -# -# Window: -# -# listing window - Define the listing window. -# -# Description: -# -# - # Make toplevel window disappear wm withdraw . -# Setup listing window - -#if {[tk colormodel .text] == "color"} { -# set highlight "-background red2 -borderwidth 2 -relief sunk" -#} else { -# set fg [lindex [.text config -foreground] 4] -# set bg [lindex [.text config -background] 4] -# set highlight "-foreground $bg -background $fg -borderwidth 0" -#} - proc files_command {} { toplevel .files_window @@ -1316,6 +1510,7 @@ button .files -text Files -command files_command # Setup command window proc build_framework {win {title GDBtk} {label {}}} { + global ${win}.label toplevel ${win} wm title ${win} $title @@ -1352,9 +1547,9 @@ proc build_framework {win {title GDBtk} {label {}}} { ${win}.menubar.window.menu add command -label Command \ -command {echo Command} ${win}.menubar.window.menu add command -label Assembly \ - -command {asm_command ; update_ptr} + -command {create_asm_window ; update_ptr} ${win}.menubar.window.menu add command -label Register \ - -command {registers_command ; update_ptr} + -command {create_registers_window ; update_ptr} menubutton ${win}.menubar.help -padx 12 -text Help \ -menu ${win}.menubar.help.menu -underline 0 @@ -1377,7 +1572,8 @@ proc build_framework {win {title GDBtk} {label {}}} { text ${win}.text -height 25 -width 80 -relief raised -borderwidth 2 \ -setgrid true -cursor hand2 -yscrollcommand "${win}.scroll set" - label ${win}.label -text $label -borderwidth 2 -relief raised + set ${win}.label $label + label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief raised scrollbar ${win}.scroll -orient vertical -command "${win}.text yview" @@ -1389,89 +1585,117 @@ proc build_framework {win {title GDBtk} {label {}}} { pack ${win}.info -side top -fill both -expand yes } -build_framework .src Source "*No file*" - -frame .src.row1 -frame .src.row2 - -button .src.start -width 6 -text Start -command \ - {gdb_cmd {break main} - gdb_cmd {enable delete $bpnum} - gdb_cmd run - update_ptr } -button .src.stop -width 6 -text Stop -fg red -activeforeground red \ - -state disabled -command gdb_stop -button .src.step -width 6 -text Step -command {gdb_cmd step ; update_ptr} -button .src.next -width 6 -text Next -command {gdb_cmd next ; update_ptr} -button .src.continue -width 6 -text Cont \ - -command {gdb_cmd continue ; update_ptr} -button .src.finish -width 6 -text Finish -command {gdb_cmd finish ; update_ptr} -button .src.up -width 6 -text Up -command {gdb_cmd up ; update_ptr} -button .src.down -width 6 -text Down -command {gdb_cmd down ; update_ptr} -button .src.bottom -width 6 -text Bottom \ - -command {gdb_cmd {frame 0} ; update_ptr} - -pack .src.start .src.step .src.continue .src.up .src.bottom -side left \ - -padx 3 -pady 5 -in .src.row1 -pack .src.stop .src.next .src.finish .src.down -side left -padx 3 -pady 5 -in .src.row2 - -pack .src.row1 .src.row2 -side top -anchor w - -$wins($cfile) insert 0.0 " This page intentionally left blank." -$wins($cfile) configure -width 88 -state disabled -yscrollcommand textscrollproc - -proc textscrollproc {args} {global screen_height screen_top screen_bot - eval ".src.scroll set $args" - set screen_height [lindex $args 1] - set screen_top [lindex $args 2] - set screen_bot [lindex $args 3]} - -#.src.label configure -text "*No file*" -borderwidth 2 -relief raised - -build_framework .cmd Command "* Command Buffer *" - -set command_line {} - -gdb_cmd {set language c} -gdb_cmd {set height 0} -gdb_cmd {set width 0} - -bind .cmd.text {focus %W} -bind .cmd.text {delete_char %W} -bind .cmd.text {delete_char %W} -bind .cmd.text {delete_line %W} -bind .cmd.text { - global command_line +proc create_source_window {} { + global wins + global cfile + + build_framework .src Source "*No file*" + + frame .src.row1 + frame .src.row2 + + button .src.start -width 6 -text Start -command \ + {gdb_cmd {break main} + gdb_cmd {enable delete $bpnum} + gdb_cmd run + update_ptr } + button .src.stop -width 6 -text Stop -fg red -activeforeground red \ + -state disabled -command gdb_stop + button .src.step -width 6 -text Step \ + -command {gdb_cmd step ; update_ptr} + button .src.next -width 6 -text Next \ + -command {gdb_cmd next ; update_ptr} + button .src.continue -width 6 -text Cont \ + -command {gdb_cmd continue ; update_ptr} + button .src.finish -width 6 -text Finish \ + -command {gdb_cmd finish ; update_ptr} + button .src.up -width 6 -text Up -command {gdb_cmd up ; update_ptr} + button .src.down -width 6 -text Down \ + -command {gdb_cmd down ; update_ptr} + button .src.bottom -width 6 -text Bottom \ + -command {gdb_cmd {frame 0} ; update_ptr} + + pack .src.start .src.step .src.continue .src.up .src.bottom \ + -side left -padx 3 -pady 5 -in .src.row1 + pack .src.stop .src.next .src.finish .src.down -side left -padx 3 \ + -pady 5 -in .src.row2 + + pack .src.row1 .src.row2 -side top -anchor w + + $wins($cfile) insert 0.0 " This page intentionally left blank." + $wins($cfile) configure -width 88 -state disabled \ + -yscrollcommand textscrollproc + + proc textscrollproc {args} {global screen_height screen_top screen_bot + eval ".src.scroll set $args" + set screen_height [lindex $args 1] + set screen_top [lindex $args 2] + set screen_bot [lindex $args 3]} +} - %W insert end %A - %W yview -pickplace end - append command_line %A - } -bind .cmd.text { +proc create_command_window {} { global command_line - %W insert end \n - %W yview -pickplace end - gdb_cmd $command_line + build_framework .cmd Command "* Command Buffer *" + set command_line {} - update_ptr - %W insert end "(gdb) " - %W yview -pickplace end + + gdb_cmd {set language c} + gdb_cmd {set height 0} + gdb_cmd {set width 0} + + bind .cmd.text {focus %W} + bind .cmd.text {delete_char %W} + bind .cmd.text {delete_char %W} + bind .cmd.text {delete_line %W} + bind .cmd.text { + global command_line + + %W insert end %A + %W yview -pickplace end + append command_line %A + } + bind .cmd.text { + global command_line + + %W insert end \n + %W yview -pickplace end + gdb_cmd $command_line + set command_line {} + update_ptr + %W insert end "(gdb) " + %W yview -pickplace end + } + + proc delete_char {win} { + global command_line + + tk_textBackspace $win + $win yview -pickplace insert + set tmp [expr [string length $command_line] - 2] + set command_line [string range $command_line 0 $tmp] } -proc delete_char {win} { - global command_line + proc delete_line {win} { + global command_line - tk_textBackspace $win - $win yview -pickplace insert - set tmp [expr [string length $command_line] - 2] - set command_line [string range $command_line 0 $tmp] + $win delete {end linestart + 6 chars} end + $win yview -pickplace insert + set command_line {} + } } -proc delete_line {win} { - global command_line +# Setup the initial windows - $win delete {end linestart + 6 chars} end - $win yview -pickplace insert - set command_line {} +create_source_window + +if {[tk colormodel .src.text] == "color"} { + set highlight "-background red2 -borderwidth 2 -relief sunk" +} else { + set fg [lindex [.src.text config -foreground] 4] + set bg [lindex [.src.text config -background] 4] + set highlight "-foreground $bg -background $fg -borderwidth 0" } + +create_command_window +update -- 2.30.2