#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;
/* 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;
\f
-/* 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
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
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);
return val;
}
\f
+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)
{
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");
}
\f
/* This implements the TCL command `gdb_loc', which returns a list consisting
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;
}
value_ptr val;
if (argc != 2)
- {
- Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
- return TCL_ERROR;
- }
+ error ("wrong # args");
expr = parse_expression (argv[1]);
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);
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;
}
continue;
sprintf (buf, "%d", le->line);
- Tcl_AppendElement (interp, buf);
+ Tcl_DStringAppendElement (result_ptr, buf);
}
return TCL_OK;
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;
&& *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
#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];
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))
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
int format;
if (argc < 2)
- {
- Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
- return TCL_ERROR;
- }
+ error ("wrong # args");
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];
REGISTER_RAW_SIZE (regnum));
sprintf (buf, "%d", regnum);
- Tcl_AppendElement (interp, buf);
+ Tcl_DStringAppendElement (result_ptr, buf);
}
static int
int argc;
char *argv[];
{
- int format;
-
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;
}
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));
{
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 */
memcpy (error_return, saved_error_return, sizeof (jmp_buf));
+ Tcl_DStringResult (interp, &result);
+ result_ptr = old_result_ptr;
+
return val;
}
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;
}
};
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]);
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);
if (!interp)
error ("Tcl_CreateInterp failed");
- Tcl_DStringInit (&stdout_buffer); /* Setup stdout buffer */
-
mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
if (!mainWindow)
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;
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;
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);
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,
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]}
#
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} {
#
proc gdbtk_tcl_flush {} {
- global current_output_win
-
- $current_output_win yview -pickplace end
+ .cmd.text yview -pickplace end
update idletasks
}
# 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}
if [winfo exists $win] {
insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc]
}
+
+# Update the breakpoints window
+
+ add_breakpoint_frame $bpnum
}
#
}
}
}
+
+ delete_breakpoint_frame $bpnum
}
#
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
}
#
.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:
#
##
# Local procedure:
#
-# create_expr_win - Create expression display window
+# create_expr_window - Create expression display window
#
# Description:
#
}
}
-proc create_expr_win {} {
+proc create_expr_window {} {
if [winfo exists .expr] {raise .expr ; return}
#
proc display_expression {expression} {
- create_expr_win
+ create_expr_window
add_expr $expression
}
# 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
# 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]
$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"]
proc create_asm_win {funcname pc} {
global breakpoint_file
global breakpoint_line
- global current_output_win
global pclist
global disassemble_with_source
# 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
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]
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
if [winfo exists .expr] {
update_exprs
}
+ if [winfo exists .autocmd] {
+ update_autocmd
+ }
}
# Make toplevel window disappear
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
-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
-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 \
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
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
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
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
}
# 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
projects / binutils-gdb.git / commitdiff