* 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.
This commit is contained in:
Stu Grossman 1995-02-15 01:45:39 +00:00
parent a8e27cc684
commit 6131622e34
4 changed files with 506 additions and 331 deletions

View File

@ -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;
}
}

View File

@ -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_DStringInit (&str);
Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
Tcl_DStringAppendElement (&str, ptr);
Tcl_Eval (interp, Tcl_DStringValue (&str));
Tcl_DStringFree (&str);
}
Tcl_DStringAppend (&stdout_buffer, ptr, -1);
if (saving_output)
return;
if (Tcl_DStringLength (&stdout_buffer) > 1000)
flush_holdbuf ();
}
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
breakpoint_notify(b, action)
struct breakpoint *b;
const char *action;
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 symbol *sym;
char bpnum[50], line[50], pc[50];
struct symtab_and_line sal;
char *filename;
int v;
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);
filename = symtab_to_filename (sal.symtab);
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);
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);
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;
{
char buf[100];
int v;
if (b->type != bp_breakpoint)
return;
sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number);
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,

View File

@ -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

View File

@ -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... */