diff options
author | Stu Grossman <grossman@cygnus> | 1995-02-15 01:45:39 +0000 |
---|---|---|
committer | Stu Grossman <grossman@cygnus> | 1995-02-15 01:45:39 +0000 |
commit | 6131622e34fdce69f8f42172a0c2a4e460b2325b (patch) | |
tree | 2d95c6727935796842d7b6cd5d8cbf4f3bdfcc7b | |
parent | a8e27cc68433cfce8b3c22fd378e30df0505b530 (diff) | |
download | gdb-6131622e34fdce69f8f42172a0c2a4e460b2325b.zip gdb-6131622e34fdce69f8f42172a0c2a4e460b2325b.tar.gz gdb-6131622e34fdce69f8f42172a0c2a4e460b2325b.tar.bz2 |
* annotate.c, breakpoint.c, defs.h, gdbtk.c, top.c: Replace
enable/disable_breakpoint_hook with modify_breakpoint_hook.
* gdbtk.c: General cleanups, get rid of unused variables. Redo
handling of stdout/stderr to just return output as the result of
the tcl command that caused the output. Cleanup -Wall stuff.
* (breakpoint_notify): Now returns just action and breakpoint
number.
* (gdb_get_breakpoint_list): New routine. Does the obvious.
* (gdb_get_breakpoint_info): Mostly derived from the old
breakpoint_notify, but returns lots more info.
* (dsprintf_append_element): Helper routine, works like printf,
but appends a tcl element onto the specified DString. Good for
building up lists as return values.
* (gdbtk_enable/disable_breakpoint): Go away. Replaced with
gdbtk_modify_breakpoint.
* (*many routines*): Use new result protocol.
* (call_wrapper): Make sure that recursive calls don't trash results.
* gdbtk.tcl: New windows, autocmd, and breakpoints.
* (gdbtk_tcl_fputs): Don't use $current_output_win redirection
anymore. It's not needed (in fact, this routine may not be needed
anymore).
* (gdbtk_tcl_breakpoint): Change to reflect new breakpoint
notification protocol.
* (gdbtk_tcl_busy gdbtk_tcl_idle): Straighten out buttons, remove
catches.
* (interactive_cmd): Use this wrapper around button invocations
of many commands. This will catch errors and put the results into
the command window. It also updates all the other windows.
* Also, change reliefs of most things to sunken. This actually
looks better.
* (create_file_win): Fix margin binding to allow breakpoints to
work again.
* (create_asm_win): Use return value of gdb_disassemble instead
of implicit I/O to the command window.
* (create_command_window): Use new result protocol to get output
from commands.
-rw-r--r-- | gdb/annotate.c | 3 | ||||
-rw-r--r-- | gdb/gdbtk.c | 368 | ||||
-rw-r--r-- | gdb/gdbtk.tcl | 457 | ||||
-rw-r--r-- | gdb/top.c | 3 |
4 files changed, 503 insertions, 328 deletions
diff --git a/gdb/annotate.c b/gdb/annotate.c index 026ef4c..470a486 100644 --- a/gdb/annotate.c +++ b/gdb/annotate.c @@ -535,7 +535,6 @@ _initialize_annotate () if (annotation_level > 1) { delete_breakpoint_hook = breakpoint_changed; - enable_breakpoint_hook = breakpoint_changed; - disable_breakpoint_hook = breakpoint_changed; + modify_breakpoint_hook = breakpoint_changed; } } diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index 751e2b9..97e3b83 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -38,18 +38,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include <sys/ioctl.h> #include <string.h> #include "dis-asm.h" +#include <stdio.h> +#include "gdbcmd.h" #ifndef FIOASYNC #include <sys/stropts.h> #endif -/* Non-zero means that we're doing the gdbtk interface. */ -int gdbtk = 0; - -/* Non-zero means we are reloading breakpoints, etc from the - Gdbtk kernel, and we should suppress various messages */ -static int gdbtk_reloading = 0; - /* Handle for TCL interpreter */ static Tcl_Interp *interp = NULL; @@ -91,66 +86,17 @@ null_routine(arg) /* Dynamic string header for stdout. */ -static Tcl_DString stdout_buffer; - -/* Use this to collect stdout output that will be returned as the result of a - tcl command. */ - -static int saving_output = 0; - -static void -start_saving_output () -{ - saving_output = 1; -} - -#define get_saved_output() (Tcl_DStringValue (&stdout_buffer)) - -static void -finish_saving_output () -{ - if (!saving_output) - return; - - saving_output = 0; - - Tcl_DStringFree (&stdout_buffer); -} +static Tcl_DString *result_ptr; -/* This routine redirects the output of fputs_unfiltered so that - the user can see what's going on in his debugger window. */ - -static void -flush_holdbuf () -{ - char *s, *argv[1]; - - /* We use Tcl_Merge to quote braces and funny characters as necessary. */ - - argv[0] = Tcl_DStringValue (&stdout_buffer); - s = Tcl_Merge (1, argv); - - Tcl_DStringFree (&stdout_buffer); - - Tcl_VarEval (interp, "gdbtk_tcl_fputs ", s, NULL); - - free (s); -} - static void gdbtk_flush (stream) FILE *stream; { - if (stream != gdb_stdout || saving_output) - return; - - /* Flush output from C to tcl land. */ - - flush_holdbuf (); - +#if 0 /* Force immediate screen update */ Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL); +#endif } static void @@ -158,21 +104,20 @@ gdbtk_fputs (ptr, stream) const char *ptr; FILE *stream; { - int len; - - if (stream != gdb_stdout) + if (result_ptr) + Tcl_DStringAppend (result_ptr, ptr, -1); + else { - Tcl_VarEval (interp, "gdbtk_tcl_fputs_error ", "{", ptr, "}", NULL); - return; - } + Tcl_DString str; - Tcl_DStringAppend (&stdout_buffer, ptr, -1); + Tcl_DStringInit (&str); - if (saving_output) - return; + Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1); + Tcl_DStringAppendElement (&str, ptr); - if (Tcl_DStringLength (&stdout_buffer) > 1000) - flush_holdbuf (); + Tcl_Eval (interp, Tcl_DStringValue (&str)); + Tcl_DStringFree (&str); + } } static int @@ -185,7 +130,7 @@ gdbtk_query (args) query = va_arg (args, char *); - vsprintf(buf, query, args); + vsprintf (buf, query, args); Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL); val = atol (interp->result); @@ -193,35 +138,117 @@ gdbtk_query (args) } static void +dsprintf_append_element (va_alist) + va_dcl +{ + va_list args; + Tcl_DString *dsp; + char *format; + char buf[1024]; + + va_start (args); + + dsp = va_arg (args, Tcl_DString *); + format = va_arg (args, char *); + + vsprintf (buf, format, args); + + Tcl_DStringAppendElement (dsp, buf); +} + +static int +gdb_get_breakpoint_list (clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char *argv[]; +{ + struct breakpoint *b; + extern struct breakpoint *breakpoint_chain; + + if (argc != 1) + error ("wrong # args"); + + for (b = breakpoint_chain; b; b = b->next) + if (b->type == bp_breakpoint) + dsprintf_append_element (result_ptr, "%d", b->number); + + return TCL_OK; +} + +static int +gdb_get_breakpoint_info (clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char *argv[]; +{ + struct symtab_and_line sal; + static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until", + "finish", "watchpoint", "hardware watchpoint", + "read watchpoint", "access watchpoint", + "longjmp", "longjmp resume", "step resume", + "through sigtramp", "watchpoint scope", + "call dummy" }; + static char *bpdisp[] = {"delete", "disable", "donttouch"}; + struct command_line *cmd; + int bpnum; + struct breakpoint *b; + extern struct breakpoint *breakpoint_chain; + + if (argc != 2) + error ("wrong # args"); + + bpnum = atoi (argv[1]); + + for (b = breakpoint_chain; b; b = b->next) + if (b->number == bpnum) + break; + + if (!b) + error ("Breakpoint #%d does not exist", bpnum); + + if (b->type != bp_breakpoint) + return; + + sal = find_pc_line (b->address, 0); + + Tcl_DStringAppendElement (result_ptr, symtab_to_filename (sal.symtab)); + dsprintf_append_element (result_ptr, "%d", sal.line); + dsprintf_append_element (result_ptr, "0x%lx", b->address); + Tcl_DStringAppendElement (result_ptr, bptypes[b->type]); + Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0"); + Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]); + dsprintf_append_element (result_ptr, "%d", b->silent); + dsprintf_append_element (result_ptr, "%d", b->ignore_count); + + Tcl_DStringStartSublist (result_ptr); + for (cmd = b->commands; cmd; cmd = cmd->next) + Tcl_DStringAppendElement (result_ptr, cmd->line); + Tcl_DStringEndSublist (result_ptr); + + Tcl_DStringAppendElement (result_ptr, b->cond_string); + + dsprintf_append_element (result_ptr, "%d", b->thread); + dsprintf_append_element (result_ptr, "%d", b->hit_count); + + return TCL_OK; +} + +static void breakpoint_notify(b, action) struct breakpoint *b; const char *action; { - struct symbol *sym; - char bpnum[50], line[50], pc[50]; - struct symtab_and_line sal; - char *filename; + char buf[100]; int v; if (b->type != bp_breakpoint) return; - sal = find_pc_line (b->address, 0); + sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number); - filename = symtab_to_filename (sal.symtab); - - sprintf (bpnum, "%d", b->number); - sprintf (line, "%d", sal.line); - sprintf (pc, "0x%lx", b->address); - - v = Tcl_VarEval (interp, - "gdbtk_tcl_breakpoint ", - action, - " ", bpnum, - " ", filename ? filename : "{}", - " ", line, - " ", pc, - NULL); + v = Tcl_Eval (interp, buf); if (v != TCL_OK) { @@ -234,28 +261,21 @@ static void gdbtk_create_breakpoint(b) struct breakpoint *b; { - breakpoint_notify(b, "create"); + breakpoint_notify (b, "create"); } static void gdbtk_delete_breakpoint(b) struct breakpoint *b; { - breakpoint_notify(b, "delete"); + breakpoint_notify (b, "delete"); } static void -gdbtk_enable_breakpoint(b) +gdbtk_modify_breakpoint(b) struct breakpoint *b; { - breakpoint_notify(b, "enable"); -} - -static void -gdbtk_disable_breakpoint(b) - struct breakpoint *b; -{ - breakpoint_notify(b, "disable"); + breakpoint_notify (b, "modify"); } /* This implements the TCL command `gdb_loc', which returns a list consisting @@ -291,35 +311,29 @@ gdb_loc (clientData, interp, argc, argv) free (sals.sals); if (sals.nelts != 1) - { - Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC); - return TCL_ERROR; - } + error ("Ambiguous line spec"); pc = sal.pc; } else - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); if (sal.symtab) - Tcl_AppendElement (interp, sal.symtab->filename); + Tcl_DStringAppendElement (result_ptr, sal.symtab->filename); else - Tcl_AppendElement (interp, ""); + Tcl_DStringAppendElement (result_ptr, ""); find_pc_partial_function (pc, &funcname, NULL, NULL); - Tcl_AppendElement (interp, funcname); + Tcl_DStringAppendElement (result_ptr, funcname); filename = symtab_to_filename (sal.symtab); - Tcl_AppendElement (interp, filename); + Tcl_DStringAppendElement (result_ptr, filename); sprintf (buf, "%d", sal.line); - Tcl_AppendElement (interp, buf); /* line number */ + Tcl_DStringAppendElement (result_ptr, buf); /* line number */ sprintf (buf, "0x%lx", pc); - Tcl_AppendElement (interp, buf); /* PC */ + Tcl_DStringAppendElement (result_ptr, buf); /* PC */ return TCL_OK; } @@ -338,10 +352,7 @@ gdb_eval (clientData, interp, argc, argv) value_ptr val; if (argc != 2) - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); expr = parse_expression (argv[1]); @@ -349,17 +360,8 @@ gdb_eval (clientData, interp, argc, argv) val = evaluate_expression (expr); - start_saving_output (); /* Start collecting stdout */ - val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val), gdb_stdout, 0, 0, 0, 0); -#if 0 - value_print (val, gdb_stdout, 0, 0); -#endif - - Tcl_AppendElement (interp, get_saved_output ()); - - finish_saving_output (); /* Set stdout back to normal */ do_cleanups (old_chain); @@ -383,25 +385,19 @@ gdb_sourcelines (clientData, interp, argc, argv) char buf[100]; if (argc != 2) - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); symtab = lookup_symtab (argv[1]); if (!symtab) - { - Tcl_SetResult (interp, "No such file", TCL_STATIC); - return TCL_ERROR; - } + error ("No such file"); /* If there's no linetable, or no entries, then we are done. */ if (!symtab->linetable || symtab->linetable->nitems == 0) { - Tcl_AppendElement (interp, ""); + Tcl_DStringAppendElement (result_ptr, ""); return TCL_OK; } @@ -417,7 +413,7 @@ gdb_sourcelines (clientData, interp, argc, argv) continue; sprintf (buf, "%d", le->line); - Tcl_AppendElement (interp, buf); + Tcl_DStringAppendElement (result_ptr, buf); } return TCL_OK; @@ -427,7 +423,7 @@ static int map_arg_registers (argc, argv, func, argp) int argc; char *argv[]; - int (*func) PARAMS ((int regnum, void *argp)); + void (*func) PARAMS ((int regnum, void *argp)); void *argp; { int regnum; @@ -461,22 +457,18 @@ map_arg_registers (argc, argv, func, argp) && *reg_names[regnum] != '\000') func (regnum, argp); else - { - Tcl_SetResult (interp, "bad register number", TCL_STATIC); - - return TCL_ERROR; - } + error ("bad register number"); } return TCL_OK; } -static int +static void get_register_name (regnum, argp) int regnum; void *argp; /* Ignored */ { - Tcl_AppendElement (interp, reg_names[regnum]); + Tcl_DStringAppendElement (result_ptr, reg_names[regnum]); } /* This implements the TCL command `gdb_regnames', which returns a list of @@ -507,8 +499,9 @@ gdb_regnames (clientData, interp, argc, argv) #define INVALID_FLOAT(x, y) (0 != 0) #endif -static int +static void get_register (regnum, fp) + int regnum; void *fp; { char raw_buffer[MAX_REGISTER_RAW_SIZE]; @@ -517,12 +510,10 @@ get_register (regnum, fp) if (read_relative_register_raw_bytes (regnum, raw_buffer)) { - Tcl_AppendElement (interp, "Optimized out"); + Tcl_DStringAppendElement (result_ptr, "Optimized out"); return; } - start_saving_output (); /* Start collecting stdout */ - /* Convert raw data to virtual format if necessary. */ if (REGISTER_CONVERTIBLE (regnum)) @@ -536,9 +527,7 @@ get_register (regnum, fp) val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, gdb_stdout, format, 1, 0, Val_pretty_default); - Tcl_AppendElement (interp, get_saved_output ()); - - finish_saving_output (); /* Set stdout back to normal */ + Tcl_DStringAppend (result_ptr, " ", -1); } static int @@ -551,10 +540,7 @@ gdb_fetch_registers (clientData, interp, argc, argv) int format; if (argc < 2) - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); argc--; argv++; @@ -570,8 +556,9 @@ gdb_fetch_registers (clientData, interp, argc, argv) static char old_regs[REGISTER_BYTES]; -static int +static void register_changed_p (regnum, argp) + int regnum; void *argp; /* Ignored */ { char raw_buffer[MAX_REGISTER_RAW_SIZE]; @@ -590,7 +577,7 @@ register_changed_p (regnum, argp) REGISTER_RAW_SIZE (regnum)); sprintf (buf, "%d", regnum); - Tcl_AppendElement (interp, buf); + Tcl_DStringAppendElement (result_ptr, buf); } static int @@ -600,8 +587,6 @@ gdb_changed_register_list (clientData, interp, argc, argv) int argc; char *argv[]; { - int format; - argc--; argv++; @@ -619,19 +604,12 @@ gdb_cmd (clientData, interp, argc, argv) char *argv[]; { if (argc != 2) - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); execute_command (argv[1], 1); bpstat_do_actions (&stop_bpstat); - /* Drain all buffered command output */ - - gdb_flush (gdb_stdout); - return TCL_OK; } @@ -653,6 +631,11 @@ call_wrapper (clientData, interp, argc, argv) struct cleanup *saved_cleanup_chain; Tcl_CmdProc *func; jmp_buf saved_error_return; + Tcl_DString result, *old_result_ptr; + + Tcl_DStringInit (&result); + old_result_ptr = result_ptr; + result_ptr = &result; func = (Tcl_CmdProc *)clientData; memcpy (saved_error_return, error_return, sizeof (jmp_buf)); @@ -665,8 +648,6 @@ call_wrapper (clientData, interp, argc, argv) { val = TCL_ERROR; /* Flag an error for TCL */ - finish_saving_output (); /* Restore stdout to normal */ - gdb_flush (gdb_stderr); /* Flush error output */ gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */ @@ -683,6 +664,9 @@ call_wrapper (clientData, interp, argc, argv) memcpy (error_return, saved_error_return, sizeof (jmp_buf)); + Tcl_DStringResult (interp, &result); + result_ptr = old_result_ptr; + return val; } @@ -693,16 +677,15 @@ gdb_listfiles (clientData, interp, argc, argv) int argc; char *argv[]; { - int val; struct objfile *objfile; struct partial_symtab *psymtab; struct symtab *symtab; ALL_PSYMTABS (objfile, psymtab) - Tcl_AppendElement (interp, psymtab->filename); + Tcl_DStringAppendElement (result_ptr, psymtab->filename); ALL_SYMTABS (objfile, symtab) - Tcl_AppendElement (interp, symtab->filename); + Tcl_DStringAppendElement (result_ptr, symtab->filename); return TCL_OK; } @@ -793,32 +776,21 @@ gdb_disassemble (clientData, interp, argc, argv) }; if (argc != 3 && argc != 4) - { - Tcl_SetResult (interp, "wrong # args", TCL_STATIC); - return TCL_ERROR; - } + error ("wrong # args"); if (strcmp (argv[1], "source") == 0) mixed_source_and_assembly = 1; else if (strcmp (argv[1], "nosource") == 0) mixed_source_and_assembly = 0; else - { - Tcl_SetResult (interp, "First arg must be 'source' or 'nosource'", - TCL_STATIC); - return TCL_ERROR; - } + error ("First arg must be 'source' or 'nosource'"); low = parse_and_eval_address (argv[2]); if (argc == 3) { if (find_pc_partial_function (low, NULL, &low, &high) == 0) - { - Tcl_SetResult (interp, "No function contains specified address", - TCL_STATIC); - return TCL_ERROR; - } + error ("No function contains specified address"); } else high = parse_and_eval_address (argv[3]); @@ -1086,8 +1058,6 @@ gdbtk_init () int i; struct sigaction action; static sigset_t nullsigmask = {0}; - extern struct cmd_list_element *setlist; - extern struct cmd_list_element *showlist; old_chain = make_cleanup (cleanup_init, 0); @@ -1098,8 +1068,6 @@ gdbtk_init () if (!interp) error ("Tcl_CreateInterp failed"); - Tcl_DStringInit (&stdout_buffer); /* Setup stdout buffer */ - mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb"); if (!mainWindow) @@ -1126,6 +1094,10 @@ gdbtk_init () Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper, gdb_disassemble, NULL); Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL); + Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper, + gdb_get_breakpoint_list, NULL); + Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper, + gdb_get_breakpoint_info, NULL); command_loop_hook = Tk_MainLoop; print_frame_info_listing_hook = null_routine; @@ -1133,8 +1105,7 @@ gdbtk_init () flush_hook = gdbtk_flush; create_breakpoint_hook = gdbtk_create_breakpoint; delete_breakpoint_hook = gdbtk_delete_breakpoint; - enable_breakpoint_hook = gdbtk_enable_breakpoint; - disable_breakpoint_hook = gdbtk_disable_breakpoint; + modify_breakpoint_hook = gdbtk_modify_breakpoint; interactive_hook = gdbtk_interactive; target_wait_hook = gdbtk_wait; call_command_hook = gdbtk_call_command; @@ -1166,13 +1137,6 @@ gdbtk_init () add_com ("tk", class_obscure, tk_command, "Send a command directly into tk."); -#if 0 - add_show_from_set (add_set_cmd ("disassemble-from-exec", class_support, - var_boolean, (char *)&disassemble_from_exec, - "Set ", &setlist), - &showlist); -#endif - Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec, TCL_LINK_INT); @@ -1192,8 +1156,6 @@ gdbtk_init () if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK) { - char *err; - fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */ fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename, diff --git a/gdb/gdbtk.tcl b/gdb/gdbtk.tcl index 9af60a6..15839d4 100644 --- a/gdb/gdbtk.tcl +++ b/gdb/gdbtk.tcl @@ -26,7 +26,6 @@ set current_label {} set screen_height 0 set screen_top 0 set screen_bot 0 -set current_output_win .cmd.text set cfunc NIL set line_numbers 1 set breakpoint_file(-1) {[garbage]} @@ -65,10 +64,8 @@ if [info exists env(EDITOR)] then { # proc gdbtk_tcl_fputs {arg} { - global current_output_win - - $current_output_win insert end "$arg" - $current_output_win yview -pickplace end + .cmd.text insert end "$arg" + .cmd.text yview -pickplace end } proc gdbtk_tcl_fputs_error {arg} { @@ -87,9 +84,7 @@ proc gdbtk_tcl_fputs_error {arg} { # proc gdbtk_tcl_flush {} { - global current_output_win - - $current_output_win yview -pickplace end + .cmd.text yview -pickplace end update idletasks } @@ -149,18 +144,179 @@ proc gdbtk_tcl_end_variable_annotation {} { # of: # create - Notify of breakpoint creation # delete - Notify of breakpoint deletion -# enable - Notify of breakpoint enabling -# disable - Notify of breakpoint disabling -# -# All actions take the same set of arguments: BPNUM is the breakpoint -# number, FILE is the source file and LINE is the line number, and PC is -# the pc of the affected breakpoint. +# modify - Notify of breakpoint modification # -proc gdbtk_tcl_breakpoint {action bpnum file line pc} { +# file line pc type enabled disposition silent ignore_count commands cond_string thread hit_count + +proc gdbtk_tcl_breakpoint {action bpnum} { + set bpinfo [gdb_get_breakpoint_info $bpnum] + set file [lindex $bpinfo 0] + set line [lindex $bpinfo 1] + set pc [lindex $bpinfo 2] + set enable [lindex $bpinfo 4] + + if {$action == "modify"} { + if {$enable == "enabled"} { + set action enable + } else { + set action disable + } + } + ${action}_breakpoint $bpnum $file $line $pc } +proc create_breakpoints_window {} { + global bpframe_lasty + + if [winfo exists .breakpoints] {raise .breakpoints ; return} + + build_framework .breakpoints "Breakpoints" "" + +# First, delete all the old view menu entries + + .breakpoints.menubar.view.menu delete 0 last + +# Get rid of label + + destroy .breakpoints.label + +# Replace text with a canvas and fix the scrollbars + + destroy .breakpoints.text + canvas .breakpoints.c -relief sunken -bd 2 \ + -cursor hand2 -yscrollcommand {.breakpoints.scroll set} + .breakpoints.scroll configure -command {.breakpoints.c yview} + scrollbar .breakpoints.scrollx -orient horizontal \ + -command {.breakpoints.c xview} -relief sunken + + pack .breakpoints.scrollx -side bottom -fill x -in .breakpoints.info + pack .breakpoints.c -side left -expand yes -fill both \ + -in .breakpoints.info + + set bpframe_lasty 0 + +# Create a frame for each breakpoint + + foreach bpnum [gdb_get_breakpoint_list] { + add_breakpoint_frame $bpnum + } +} + +# Create a frame for bpnum in the .breakpoints canvas + +proc add_breakpoint_frame bpnum { + global bpframe_lasty + + if ![winfo exists .breakpoints] return + + set bpinfo [gdb_get_breakpoint_info $bpnum] + + set file [lindex $bpinfo 0] + set line [lindex $bpinfo 1] + set pc [lindex $bpinfo 2] + set type [lindex $bpinfo 3] + set enabled [lindex $bpinfo 4] + set disposition [lindex $bpinfo 5] + set silent [lindex $bpinfo 6] + set ignore_count [lindex $bpinfo 7] + set commands [lindex $bpinfo 8] + set cond [lindex $bpinfo 9] + set thread [lindex $bpinfo 10] + set hit_count [lindex $bpinfo 11] + + set f .breakpoints.c.$bpnum + + if ![winfo exists $f] { + frame $f -relief sunken -bd 2 + + label $f.id -text "#$bpnum $file:$line ($pc)" \ + -relief flat -bd 2 -anchor w + label $f.hit_count -text "Hit count: $hit_count" -relief flat \ + -bd 2 -anchor w + + frame $f.thread + label $f.thread.label -text "Thread: " -relief flat -bd 2 \ + -width 11 -anchor w + entry $f.thread.entry -bd 2 -relief sunken -width 10 + $f.thread.entry insert end $thread + pack $f.thread.label -side left + pack $f.thread.entry -side left -fill x + + frame $f.cond + label $f.cond.label -text "Condition: " -relief flat -bd 2 \ + -width 11 -anchor w + entry $f.cond.entry -bd 2 -relief sunken + $f.cond.entry insert end $cond + pack $f.cond.label -side left + pack $f.cond.entry -side left -fill x -expand yes + + frame $f.ignore_count + label $f.ignore_count.label -text "Ignore count: " \ + -relief flat -bd 2 -width 11 -anchor w + entry $f.ignore_count.entry -bd 2 -relief sunken -width 10 + $f.ignore_count.entry insert end $ignore_count + pack $f.ignore_count.label -side left + pack $f.ignore_count.entry -side left -fill x + + frame $f.disps + + checkbutton $f.disps.enabled -text "Enabled " \ + -variable enabled -anchor w -relief flat + + radiobutton $f.disps.delete -text Delete \ + -variable disposition -anchor w -relief flat + + radiobutton $f.disps.disable -text Disable \ + -variable disposition -anchor w -relief flat + + radiobutton $f.disps.donttouch -text "Leave alone" \ + -variable disposition -anchor w -relief flat + + pack $f.disps.delete $f.disps.disable $f.disps.donttouch \ + -side left -anchor w + pack $f.disps.enabled -side right -anchor e + text $f.commands -relief sunken -bd 2 -setgrid true \ + -cursor hand2 -height 3 -width 30 + + foreach line $commands { + $f.commands insert end "${line}\n" + } + + pack $f.id -side top -anchor nw -fill x + pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \ + $f.commands -side top -fill x -anchor nw + } + + set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw] + update + set bbox [.breakpoints.c bbox $tag] + + set bpframe_lasty [lindex $bbox 3] +} + +# Delete a breakpoint frame + +proc delete_breakpoint_frame bpnum { + global bpframe_lasty + + if ![winfo exists .breakpoints] return + +# First, clear the canvas + + .breakpoints.c delete all + +# Now, repopulate it with all but the doomed breakpoint + + set bpframe_lasty 0 + foreach bp [gdb_get_breakpoint_list] { + if {$bp != $bpnum} { + add_breakpoint_frame $bp + } + } +} + proc asm_win_name {funcname} { if {$funcname == "*None*"} {return .asm.text} @@ -219,6 +375,10 @@ proc create_breakpoint {bpnum file line pc} { if [winfo exists $win] { insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc] } + +# Update the breakpoints window + + add_breakpoint_frame $bpnum } # @@ -282,6 +442,8 @@ proc delete_breakpoint {bpnum file line pc} { } } } + + delete_breakpoint_frame $bpnum } # @@ -389,51 +551,51 @@ proc delete_breakpoint_tag {win line} { proc gdbtk_tcl_busy {} { if [winfo exists .src] { - catch {.src.start configure -state disabled} - catch {.src.stop configure -state normal} - catch {.src.step configure -state disabled} - catch {.src.next configure -state disabled} - catch {.src.continue configure -state disabled} - catch {.src.finish configure -state disabled} - catch {.src.up configure -state disabled} - catch {.src.down configure -state disabled} - catch {.src.bottom configure -state disabled} + .src.start configure -state disabled + .src.stop configure -state normal + .src.step configure -state disabled + .src.next configure -state disabled + .src.continue configure -state disabled + .src.finish configure -state disabled + .src.up configure -state disabled + .src.down configure -state disabled + .src.bottom configure -state disabled } if [winfo exists .asm] { - catch {.asm.stepi configure -state disabled} - catch {.asm.nexti configure -state disabled} - catch {.asm.continue configure -state disabled} - catch {.asm.finish configure -state disabled} - catch {.asm.up configure -state disabled} - catch {.asm.down configure -state disabled} - catch {.asm.bottom configure -state disabled} - catch {.asm.close configure -state disabled} + .asm.stepi configure -state disabled + .asm.nexti configure -state disabled + .asm.continue configure -state disabled + .asm.finish configure -state disabled + .asm.up configure -state disabled + .asm.down configure -state disabled + .asm.bottom configure -state disabled } + return } proc gdbtk_tcl_idle {} { if [winfo exists .src] { - catch {.src.start configure -state normal} - catch {.src.stop configure -state disabled} - catch {.src.step configure -state normal} - catch {.src.next configure -state normal} - catch {.src.continue configure -state normal} - catch {.src.finish configure -state normal} - catch {.src.up configure -state normal} - catch {.src.down configure -state normal} - catch {.src.bottom configure -state normal} + .src.start configure -state normal + .src.stop configure -state disabled + .src.step configure -state normal + .src.next configure -state normal + .src.continue configure -state normal + .src.finish configure -state normal + .src.up configure -state normal + .src.down configure -state normal + .src.bottom configure -state normal } if [winfo exists .asm] { - catch {.asm.stepi configure -state normal} - catch {.asm.nexti configure -state normal} - catch {.asm.continue configure -state normal} - catch {.asm.finish configure -state normal} - catch {.asm.up configure -state normal} - catch {.asm.down configure -state normal} - catch {.asm.bottom configure -state normal} - catch {.asm.close configure -state normal} + .asm.stepi configure -state normal + .asm.nexti configure -state normal + .asm.continue configure -state normal + .asm.finish configure -state normal + .asm.up configure -state normal + .asm.down configure -state normal + .asm.bottom configure -state normal } + return } # @@ -499,6 +661,17 @@ menu .file_popup -cursor hand2 .file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &} .file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"} +# Use this procedure to get the GDB core to execute the string `cmd'. This is +# a wrapper around gdb_cmd, which will catch errors, and send output to the +# command window. It will also cause all of the other windows to be updated. + +proc interactive_cmd {cmd} { + catch {gdb_cmd "$cmd"} result + .cmd.text insert end $result + .cmd.text yview -pickplace end + update_ptr +} + # # Bindings: # @@ -730,7 +903,7 @@ proc not_implemented_yet {message} { ## # Local procedure: # -# create_expr_win - Create expression display window +# create_expr_window - Create expression display window # # Description: # @@ -818,7 +991,7 @@ proc update_exprs {} { } } -proc create_expr_win {} { +proc create_expr_window {} { if [winfo exists .expr] {raise .expr ; return} @@ -875,7 +1048,7 @@ proc create_expr_win {} { # proc display_expression {expression} { - create_expr_win + create_expr_window add_expr $expression } @@ -915,7 +1088,7 @@ proc create_file_win {filename debug_file} { # 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 \ + text .src.nofile -height 25 -width 88 -relief sunken \ -borderwidth 2 -yscrollcommand textscrollproc \ -setgrid true -cursor hand2 .src.nofile insert 0.0 $fh @@ -927,22 +1100,21 @@ proc create_file_win {filename debug_file} { # Actually create and do basic configuration on the text widget. - text $win -height 25 -width 88 -relief raised -borderwidth 2 \ + text $win -height 25 -width 88 -relief sunken -borderwidth 2 \ -yscrollcommand textscrollproc -setgrid true -cursor hand2 # Setup all the bindings bind $win <Enter> {focus %W} -# bind $win <1> {listing_window_button_1 %W %X %Y %x %y} bind $win <1> do_nothing bind $win <B1-Motion> do_nothing - bind $win n {catch {gdb_cmd next} ; update_ptr} - bind $win s {catch {gdb_cmd step} ; update_ptr} - bind $win c {catch {gdb_cmd continue} ; update_ptr} - bind $win f {catch {gdb_cmd finish} ; update_ptr} - bind $win u {catch {gdb_cmd up} ; update_ptr} - bind $win d {catch {gdb_cmd down} ; update_ptr} + bind $win n {interactive_cmd next} + bind $win s {interactive_cmd step} + bind $win c {interactive_cmd continue} + bind $win f {interactive_cmd finish} + bind $win u {interactive_cmd up} + bind $win d {interactive_cmd down} $win delete 0.0 end $win insert 0.0 [read $fh] @@ -972,7 +1144,7 @@ proc create_file_win {filename debug_file} { $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 margin <1> {listing_window_button_1 %W %X %Y %x %y} $win tag bind source <1> { %W mark set anchor "@%x,%y wordstart" set last [%W index "@%x,%y wordend"] @@ -1032,7 +1204,6 @@ proc create_file_win {filename debug_file} { proc create_asm_win {funcname pc} { global breakpoint_file global breakpoint_line - global current_output_win global pclist global disassemble_with_source @@ -1043,7 +1214,7 @@ proc create_asm_win {funcname pc} { # Actually create and do basic configuration on the text widget. - text $win -height 25 -width 80 -relief raised -borderwidth 2 \ + text $win -height 25 -width 80 -relief sunken -borderwidth 2 \ -setgrid true -cursor hand2 -yscrollcommand asmscrollproc # Setup all the bindings @@ -1051,19 +1222,16 @@ proc create_asm_win {funcname pc} { bind $win <Enter> {focus %W} bind $win <1> {asm_window_button_1 %W %X %Y %x %y} bind $win <B1-Motion> do_nothing - bind $win n {catch {gdb_cmd nexti} ; update_ptr} - bind $win s {catch {gdb_cmd stepi} ; update_ptr} - bind $win c {catch {gdb_cmd continue} ; update_ptr} - bind $win f {catch {gdb_cmd finish} ; update_ptr} - bind $win u {catch {gdb_cmd up} ; update_ptr} - bind $win d {catch {gdb_cmd down} ; update_ptr} + bind $win n {interactive_cmd nexti} + bind $win s {interactive_cmd stepi} + bind $win c {interactive_cmd continue} + bind $win f {interactive_cmd finish} + bind $win u {interactive_cmd up} + bind $win d {interactive_cmd down} # Disassemble the code, and read it into the new text widget - set temp $current_output_win - set current_output_win $win - catch "gdb_disassemble $disassemble_with_source $pc" - set current_output_win $temp + $win insert end [gdb_disassemble $disassemble_with_source $pc] set numlines [$win index end] set numlines [lindex [split $numlines .] 0] @@ -1272,18 +1440,18 @@ proc create_asm_window {} { frame .asm.row2 button .asm.stepi -width 6 -text Stepi \ - -command {catch {gdb_cmd stepi} ; update_ptr} + -command {interactive_cmd stepi} button .asm.nexti -width 6 -text Nexti \ - -command {catch {gdb_cmd nexti} ; update_ptr} + -command {interactive_cmd nexti} button .asm.continue -width 6 -text Cont \ - -command {catch {gdb_cmd continue} ; update_ptr} + -command {interactive_cmd continue} button .asm.finish -width 6 -text Finish \ - -command {catch {gdb_cmd finish} ; update_ptr} - button .asm.up -width 6 -text Up -command {catch {gdb_cmd up} ; update_ptr} + -command {interactive_cmd finish} + button .asm.up -width 6 -text Up -command {interactive_cmd up} button .asm.down -width 6 -text Down \ - -command {catch {gdb_cmd down} ; update_ptr} + -command {interactive_cmd down} button .asm.bottom -width 6 -text Bottom \ - -command {catch {gdb_cmd {frame 0}} ; update_ptr} + -command {interactive_cmd {frame 0}} pack .asm.stepi .asm.continue .asm.up .asm.bottom -side left -padx 3 -pady 5 -in .asm.row1 pack .asm.nexti .asm.finish .asm.down -side left -padx 3 -pady 5 -in .asm.row2 @@ -1691,6 +1859,9 @@ proc update_ptr {} { if [winfo exists .expr] { update_exprs } + if [winfo exists .autocmd] { + update_autocmd + } } # Make toplevel window disappear @@ -1703,10 +1874,10 @@ proc files_command {} { wm minsize .files_window 1 1 # wm overrideredirect .files_window true listbox .files_window.list -geometry 30x20 -setgrid true \ - -yscrollcommand {.files_window.scroll set} -relief raised \ + -yscrollcommand {.files_window.scroll set} -relief sunken \ -borderwidth 2 scrollbar .files_window.scroll -orient vertical \ - -command {.files_window.list yview} + -command {.files_window.list yview} -relief sunken button .files_window.close -text Close -command {destroy .files_window} tk_listboxSingleSelect .files_window.list @@ -1789,25 +1960,25 @@ proc build_framework {win {title GDBtk} {label {}}} { -command "destroy ${win}" ${win}.menubar.file.menu add separator ${win}.menubar.file.menu add command -label Quit \ - -command { catch { gdb_cmd quit } } + -command {interactive_cmd quit} menubutton ${win}.menubar.commands -padx 12 -text Commands \ -menu ${win}.menubar.commands.menu -underline 0 menu ${win}.menubar.commands.menu ${win}.menubar.commands.menu add command -label Run \ - -command { catch {gdb_cmd run } ; update_ptr } + -command {interactive_cmd run} ${win}.menubar.commands.menu add command -label Step \ - -command { catch { gdb_cmd step } ; update_ptr } + -command {interactive_cmd step} ${win}.menubar.commands.menu add command -label Next \ - -command { catch { gdb_cmd next } ; update_ptr } + -command {interactive_cmd next} ${win}.menubar.commands.menu add command -label Continue \ - -command { catch { gdb_cmd continue } ; update_ptr } + -command {interactive_cmd continue} ${win}.menubar.commands.menu add separator ${win}.menubar.commands.menu add command -label Stepi \ - -command { catch { gdb_cmd stepi } ; update_ptr } + -command {interactive_cmd stepi} ${win}.menubar.commands.menu add command -label Nexti \ - -command { catch { gdb_cmd nexti } ; update_ptr } + -command {interactive_cmd nexti} menubutton ${win}.menubar.view -padx 12 -text Options \ -menu ${win}.menubar.view.menu -underline 0 @@ -1828,14 +1999,18 @@ proc build_framework {win {title GDBtk} {label {}}} { -command create_command_window ${win}.menubar.window.menu add separator ${win}.menubar.window.menu add command -label Source \ - -command {create_source_window ; update_ptr} + -command create_source_window ${win}.menubar.window.menu add command -label Assembly \ - -command {create_asm_window ; update_ptr} + -command create_asm_window ${win}.menubar.window.menu add separator ${win}.menubar.window.menu add command -label Registers \ - -command {create_registers_window ; update_ptr} + -command create_registers_window ${win}.menubar.window.menu add command -label Expressions \ - -command {create_expr_win ; update_ptr} + -command create_expr_window + ${win}.menubar.window.menu add command -label "Auto Command" \ + -command create_autocmd_window +# ${win}.menubar.window.menu add command -label Breakpoints \ +# -command create_breakpoints_window # ${win}.menubar.window.menu add separator # ${win}.menubar.window.menu add command -label Files \ @@ -1863,13 +2038,14 @@ proc build_framework {win {title GDBtk} {label {}}} { pack ${win}.menubar.help -side right frame ${win}.info - text ${win}.text -height 25 -width 80 -relief raised -borderwidth 2 \ + text ${win}.text -height 25 -width 80 -relief sunken -borderwidth 2 \ -setgrid true -cursor hand2 -yscrollcommand "${win}.scroll set" set ${win}.label $label - label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief raised + label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief sunken - scrollbar ${win}.scroll -orient vertical -command "${win}.text yview" + scrollbar ${win}.scroll -orient vertical -command "${win}.text yview" \ + -relief sunken pack ${win}.label -side bottom -fill x -in ${win}.info pack ${win}.scroll -side right -fill y -in ${win}.info @@ -1911,26 +2087,25 @@ proc create_source_window {} { frame .src.row2 button .src.start -width 6 -text Start -command \ - {catch {gdb_cmd {break main}} - catch {gdb_cmd {enable delete $bpnum}} - catch {gdb_cmd run} - update_ptr } + {interactive_cmd {break main} + interactive_cmd {enable delete $bpnum} + interactive_cmd run } button .src.stop -width 6 -text Stop -fg red -activeforeground red \ -state disabled -command gdb_stop button .src.step -width 6 -text Step \ - -command {catch {gdb_cmd step} ; update_ptr} + -command {interactive_cmd step} button .src.next -width 6 -text Next \ - -command {catch {gdb_cmd next} ; update_ptr} + -command {interactive_cmd next} button .src.continue -width 6 -text Cont \ - -command {catch {gdb_cmd continue} ; update_ptr} + -command {interactive_cmd continue} button .src.finish -width 6 -text Finish \ - -command {catch {gdb_cmd finish} ; update_ptr} + -command {interactive_cmd finish} button .src.up -width 6 -text Up \ - -command {catch {gdb_cmd up} ; update_ptr} + -command {interactive_cmd up} button .src.down -width 6 -text Down \ - -command {catch {gdb_cmd down} ; update_ptr} + -command {interactive_cmd down} button .src.bottom -width 6 -text Bottom \ - -command {catch {gdb_cmd {frame 0}} ; update_ptr} + -command {interactive_cmd {frame 0}} pack .src.start .src.step .src.continue .src.up .src.bottom \ -side left -padx 3 -pady 5 -in .src.row1 @@ -1950,6 +2125,50 @@ proc create_source_window {} { set screen_bot [lindex $args 3]} } +proc update_autocmd {} { + global .autocmd.label + global accumulate_output + + catch {gdb_cmd "${.autocmd.label}"} result + if !$accumulate_output { .autocmd.text delete 0.0 end } + .autocmd.text insert end $result + .autocmd.text yview -pickplace end +} + +proc create_autocmd_window {} { + global .autocmd.label + + if [winfo exists .autocmd] {raise .autocmd ; return} + + build_framework .autocmd "Auto Command" "" + +# First, delete all the old view menu entries + + .autocmd.menubar.view.menu delete 0 last + +# Accumulate output option + + .autocmd.menubar.view.menu add checkbutton \ + -variable accumulate_output \ + -label "Accumulate output" -onvalue 1 -offvalue 0 + +# Now, create entry widget with label + + frame .autocmd.entryframe + + entry .autocmd.entry -borderwidth 2 -relief sunken + bind .autocmd <Enter> {focus .autocmd.entry} + bind .autocmd.entry <Key-Return> {set .autocmd.label [.autocmd.entry get] + .autocmd.entry delete 0 end } + + label .autocmd.entrylab -text "Command: " + + pack .autocmd.entrylab -in .autocmd.entryframe -side left + pack .autocmd.entry -in .autocmd.entryframe -side left -fill x -expand yes + + pack .autocmd.entryframe -side bottom -fill x -before .autocmd.info +} + proc create_command_window {} { global command_line @@ -1978,10 +2197,13 @@ proc create_command_window {} { global command_line %W insert end \n - %W yview -pickplace end - catch "gdb_cmd [list $command_line]" + interactive_cmd $command_line + +# %W yview -pickplace end +# catch "gdb_cmd [list $command_line]" result +# %W insert end $result set command_line {} - update_ptr +# update_ptr %W insert end "(gdb) " %W yview -pickplace end } @@ -2682,23 +2904,16 @@ create_command_window # Create a copyright window +update toplevel .c wm geometry .c +300+300 wm overrideredirect .c true -text .t -set temp $current_output_win -set current_output_win .t -gdb_cmd "show version" -set current_output_win $temp - -message .c.m -text [.t get 0.0 end] -aspect 500 -relief raised -destroy .t +message .c.m -text [gdb_cmd "show version"] -aspect 500 -relief raised pack .c.m bind .c.m <Leave> {destroy .c} +update if [file exists ~/.gdbtkinit] { source ~/.gdbtkinit } - -update @@ -395,8 +395,7 @@ void (*flush_hook) PARAMS ((FILE *stream)); void (*create_breakpoint_hook) PARAMS ((struct breakpoint *bpt)); void (*delete_breakpoint_hook) PARAMS ((struct breakpoint *bpt)); -void (*enable_breakpoint_hook) PARAMS ((struct breakpoint *bpt)); -void (*disable_breakpoint_hook) PARAMS ((struct breakpoint *bpt)); +void (*modify_breakpoint_hook) PARAMS ((struct breakpoint *bpt)); /* Called during long calculations to allow GUI to repair window damage, and to check for stop buttons, etc... */ |