[deliverable/binutils-gdb.git] / gdb / gdbtk.c

/* TK interface routines.
   Copyright 1994 Free Software Foundation, Inc.

This file is part of GDB.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include "defs.h"
#include "symtab.h"
#include "inferior.h"
#include "command.h"
#include "bfd.h"
#include "symfile.h"
#include "objfiles.h"
#include "target.h"
#include <sys/types.h>
#include <sys/time.h>
#include <sys/param.h>
#include <varargs.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <sys/filio.h>
#include <setjmp.h>
#include <signal.h>
#include <sys/errno.h>
#include <termios.h>
#include <string.h>
#include <tcl.h>
#include <tk.h>
#include <unistd.h>

/* 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;

/* Handle for TK main window */
static Tk_Window mainWindow = NULL;

static void
null_routine(arg)
     int arg;
{
}

\f
/* This routine redirects the output of fputs_unfiltered so that
   the user can see what's going on in his debugger window. */

static char holdbuf[200];
static char *holdbufp = holdbuf;
static int holdfree = sizeof (holdbuf);

static void
flush_holdbuf ()
{
  if (holdbufp == holdbuf)
    return;

  Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", holdbuf, "}", NULL);
  holdbufp = holdbuf;
  holdfree = sizeof (holdbuf);
}

static void
gdbtk_flush (stream)
     FILE *stream;
{
  flush_holdbuf ();

  Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
}

static void
gdbtk_fputs (ptr)
     const char *ptr;
{
  int len;

  len = strlen (ptr) + 1;

  if (len > holdfree)
    {
      flush_holdbuf ();

      if (len > sizeof (holdbuf))
	{
	  Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", ptr, "}", NULL);
	  return;
	}
    }

  strncpy (holdbufp, ptr, len);
  holdbufp += len - 1;
  holdfree -= len - 1;
}

static int
gdbtk_query (args)
     va_list args;
{
  char *query;
  char buf[200];
  long val;

  query = va_arg (args, char *);

  vsprintf(buf, query, args);
  Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);

  val = atol (interp->result);
  return val;
}
\f
#if 0
static char *
full_filename(symtab)
     struct symtab *symtab;
{
  int pathlen;
  char *filename;

  if (!symtab)
    return NULL;

  if (symtab->fullname)
    return savestring(symtab->fullname, strlen(symtab->fullname));

  if (symtab->filename[0] == '/')
    return savestring(symtab->filename, strlen(symtab->filename));

  if (symtab->dirname)
    pathlen = strlen(symtab->dirname);
  else
    pathlen = 0;
  if (symtab->filename)
    pathlen += strlen(symtab->filename);

  filename = xmalloc(pathlen+1);

  if (symtab->dirname)
    strcpy(filename, symtab->dirname);
  else
    *filename = '\000';
  if (symtab->filename)
    strcat(filename, symtab->filename);

  return filename;
}
#endif
\f
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;
  int v;

  if (b->type != bp_breakpoint)
    return;

  sal = find_pc_line (b->address, 0);

  filename = symtab_to_filename (sal.symtab);

  sprintf (bpnum, "%d", b->number);
  sprintf (line, "%d", sal.line);
  sprintf (pc, "0x%x", b->address);
 
  v = Tcl_VarEval (interp,
		   "gdbtk_tcl_breakpoint ",
		   action,
		   " ", bpnum,
		   " ", filename,
		   " ", line,
		   " ", pc,
		   NULL);

  if (v != TCL_OK)
    {
      gdbtk_fputs (interp->result);
      gdbtk_fputs ("\n");
    }
}

static void
gdbtk_create_breakpoint(b)
     struct breakpoint *b;
{
  breakpoint_notify(b, "create");
}

static void
gdbtk_delete_breakpoint(b)
     struct breakpoint *b;
{
  breakpoint_notify(b, "delete");
}

static void
gdbtk_enable_breakpoint(b)
     struct breakpoint *b;
{
  breakpoint_notify(b, "enable");
}

static void
gdbtk_disable_breakpoint(b)
     struct breakpoint *b;
{
  breakpoint_notify(b, "disable");
}
\f
/* This implements the TCL command `gdb_loc', which returns a list consisting
   of the source and line number associated with the current pc. */

static int
gdb_loc (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char *argv[];
{
  char *filename;
  char buf[100];
  struct symtab_and_line sal;
  char *funcname;
  CORE_ADDR pc;

  if (argc == 1)
    {
      struct frame_info *frame;
      struct symbol *func;

      frame = get_frame_info (selected_frame);

      pc = frame ? frame->pc : stop_pc;

      sal = find_pc_line (pc, 0);
    }
  else if (argc == 2)
    {
      struct symtabs_and_lines sals;
      int nelts;

      sals = decode_line_spec (argv[1], 1);

      nelts = sals.nelts;
      sal = sals.sals[0];
      free (sals.sals);

      if (sals.nelts != 1)
	{
	  Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC);
	  return TCL_ERROR;
	}

      pc = sal.pc;
    }
  else
    {
      Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
      return TCL_ERROR;
    }

  if (sal.symtab)
    Tcl_AppendElement (interp, sal.symtab->filename);
  else
    Tcl_AppendElement (interp, "");

  find_pc_partial_function (pc, &funcname, NULL, NULL);
  Tcl_AppendElement (interp, funcname);

  filename = symtab_to_filename (sal.symtab);
  Tcl_AppendElement (interp, filename);

  sprintf (buf, "%d", sal.line);
  Tcl_AppendElement (interp, buf); /* line number */

  sprintf (buf, "0x%x", pc);
  Tcl_AppendElement (interp, buf); /* PC */

  return TCL_OK;
}
\f
static int
gdb_cmd_stub (cmd)
     char *cmd;
{
  execute_command (cmd, 1);

  return 1;			/* Indicate success */
}

/* This implements the TCL command `gdb_cmd', which sends it's argument into
   the GDB command scanner.  */

static int
gdb_cmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char *argv[];
{
  int val;
  struct cleanup *old_chain;

  if (argc != 2)
    {
      Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
      return TCL_ERROR;
    }

  old_chain = make_cleanup (null_routine, 0);

  val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR);

  bpstat_do_actions (&stop_bpstat);
  do_cleanups (old_chain);

  /* Drain all buffered command output */

  gdb_flush (gdb_stderr);
  gdb_flush (gdb_stdout);

  /* We could base the return value on val, but that would require most users
     to use catch.  Since GDB errors are already being handled elsewhere, I
     see no reason to pass them up to the caller. */

  return TCL_OK;
}

static int
gdb_listfiles (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char *argv[];
{
  int val;
  struct objfile *objfile;
  struct partial_symtab *psymtab;

  ALL_PSYMTABS (objfile, psymtab)
    Tcl_AppendElement (interp, psymtab->filename);

  return TCL_OK;
}
\f
static void
tk_command (cmd, from_tty)
     char *cmd;
     int from_tty;
{
  Tcl_VarEval (interp, cmd, NULL);

  gdbtk_fputs (interp->result);
  gdbtk_fputs ("\n");
}

static void
cleanup_init (ignored)
     int ignored;
{
  if (mainWindow != NULL)
    Tk_DestroyWindow (mainWindow);
  mainWindow = NULL;

  if (interp != NULL)
    Tcl_DeleteInterp (interp);
  interp = NULL;
}

/* Come here during long calculations to check for GUI events.  Usually invoked
   via the QUIT macro.  */

static void
gdbtk_interactive ()
{
  /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
}

static void
gdbtk_init ()
{
  struct cleanup *old_chain;
  char *gdbtk_filename;

  old_chain = make_cleanup (cleanup_init, 0);

  /* First init tcl and tk. */

  interp = Tcl_CreateInterp ();

  if (!interp)
    error ("Tcl_CreateInterp failed");

  mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");

  if (!mainWindow)
    return;			/* DISPLAY probably not set */

  if (Tcl_Init(interp) != TCL_OK)
    error ("Tcl_Init failed: %s", interp->result);

  if (Tk_Init(interp) != TCL_OK)
    error ("Tk_Init failed: %s", interp->result);

  Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL);
  Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL);
  Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);

  gdbtk_filename = getenv ("GDBTK_FILENAME");
  if (!gdbtk_filename)
    if (access ("gdbtk.tcl", R_OK) == 0)
      gdbtk_filename = "gdbtk.tcl";
    else
      gdbtk_filename = GDBTK_FILENAME;

  if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
    error ("Failure reading %s: %s", gdbtk_filename, interp->result);

  command_loop_hook = Tk_MainLoop;
  fputs_unfiltered_hook = gdbtk_fputs;
  print_frame_info_listing_hook = null_routine;
  query_hook = gdbtk_query;
  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;
  interactive_hook = gdbtk_interactive;

  discard_cleanups (old_chain);

  add_com ("tk", class_obscure, tk_command,
	   "Send a command directly into tk.");
}

/* Come here during initialze_all_files () */

void
_initialize_gdbtk ()
{
  if (no_windows)
    return;

  /* Tell the rest of the world that Gdbtk is now set up. */

  init_ui_hook = gdbtk_init;
}
Commit	Line	Data
754e5da2 SG	1	/* TK interface routines.
	2	Copyright 1994 Free Software Foundation, Inc.
	3
	4	This file is part of GDB.
	5
	6	This program is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
	8	the Free Software Foundation; either version 2 of the License, or
	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with this program; if not, write to the Free Software
	18	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
	19
	20	#include "defs.h"
	21	#include "symtab.h"
	22	#include "inferior.h"
	23	#include "command.h"
	24	#include "bfd.h"
	25	#include "symfile.h"
	26	#include "objfiles.h"
	27	#include "target.h"
	28	#include <sys/types.h>
	29	#include <sys/time.h>
	30	#include <sys/param.h>
	31	#include <varargs.h>
	32	#include <sys/stat.h>
	33	#include <fcntl.h>
	34	#include <sys/filio.h>
	35	#include <setjmp.h>
	36	#include <signal.h>
	37	#include <sys/errno.h>
	38	#include <termios.h>
	39	#include <string.h>
	40	#include <tcl.h>
	41	#include <tk.h>
8532893d	42	#include <unistd.h>
754e5da2 SG	43
	44	/* Non-zero means that we're doing the gdbtk interface. */
	45	int gdbtk = 0;
	46
	47	/* Non-zero means we are reloading breakpoints, etc from the
	48	Gdbtk kernel, and we should suppress various messages */
	49	static int gdbtk_reloading = 0;
	50
	51	/* Handle for TCL interpreter */
	52	static Tcl_Interp *interp = NULL;
	53
	54	/* Handle for TK main window */
	55	static Tk_Window mainWindow = NULL;
	56
	57	static void
	58	null_routine(arg)
	59	int arg;
	60	{
	61	}
	62
	63	\f
	64	/* This routine redirects the output of fputs_unfiltered so that
	65	the user can see what's going on in his debugger window. */
	66
8532893d SG	67	static char holdbuf[200];
	68	static char *holdbufp = holdbuf;
	69	static int holdfree = sizeof (holdbuf);
	70
754e5da2	71	static void
8532893d	72	flush_holdbuf ()
754e5da2	73	{
8532893d SG	74	if (holdbufp == holdbuf)
	75	return;
	76
	77	Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", holdbuf, "}", NULL);
	78	holdbufp = holdbuf;
	79	holdfree = sizeof (holdbuf);
754e5da2 SG	80	}
	81
	82	static void
	83	gdbtk_flush (stream)
	84	FILE *stream;
	85	{
8532893d SG	86	flush_holdbuf ();
8532893d SG	87
754e5da2 SG	88	Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
	89	}
	90
8532893d SG	91	static void
	92	gdbtk_fputs (ptr)
	93	const char *ptr;
	94	{
	95	int len;
	96
	97	len = strlen (ptr) + 1;
	98
	99	if (len > holdfree)
	100	{
	101	flush_holdbuf ();
	102
	103	if (len > sizeof (holdbuf))
	104	{
	105	Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", ptr, "}", NULL);
	106	return;
	107	}
	108	}
	109
	110	strncpy (holdbufp, ptr, len);
	111	holdbufp += len - 1;
	112	holdfree -= len - 1;
	113	}
	114
754e5da2 SG	115	static int
	116	gdbtk_query (args)
	117	va_list args;
	118	{
	119	char *query;
	120	char buf[200];
	121	long val;
	122
	123	query = va_arg (args, char *);
	124
	125	vsprintf(buf, query, args);
	126	Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
	127
	128	val = atol (interp->result);
	129	return val;
	130	}
	131	\f
637b1661	132	#if 0
754e5da2 SG	133	static char *
	134	full_filename(symtab)
	135	struct symtab *symtab;
	136	{
	137	int pathlen;
	138	char *filename;
	139
	140	if (!symtab)
	141	return NULL;
	142
	143	if (symtab->fullname)
	144	return savestring(symtab->fullname, strlen(symtab->fullname));
	145
	146	if (symtab->filename[0] == '/')
	147	return savestring(symtab->filename, strlen(symtab->filename));
	148
	149	if (symtab->dirname)
	150	pathlen = strlen(symtab->dirname);
	151	else
	152	pathlen = 0;
	153	if (symtab->filename)
	154	pathlen += strlen(symtab->filename);
	155
	156	filename = xmalloc(pathlen+1);
	157
	158	if (symtab->dirname)
	159	strcpy(filename, symtab->dirname);
	160	else
	161	*filename = '\000';
	162	if (symtab->filename)
	163	strcat(filename, symtab->filename);
	164
	165	return filename;
	166	}
637b1661	167	#endif
754e5da2 SG	168	\f
	169	static void
	170	breakpoint_notify(b, action)
	171	struct breakpoint *b;
	172	const char *action;
	173	{
	174	struct symbol *sym;
8532893d	175	char bpnum[50], line[50], pc[50];
754e5da2 SG	176	struct symtab_and_line sal;
	177	char *filename;
	178	int v;
	179
	180	if (b->type != bp_breakpoint)
	181	return;
	182
	183	sal = find_pc_line (b->address, 0);
	184
637b1661	185	filename = symtab_to_filename (sal.symtab);
754e5da2 SG	186
	187	sprintf (bpnum, "%d", b->number);
	188	sprintf (line, "%d", sal.line);
8532893d	189	sprintf (pc, "0x%x", b->address);
754e5da2 SG	190
	191	v = Tcl_VarEval (interp,
	192	"gdbtk_tcl_breakpoint ",
	193	action,
	194	" ", bpnum,
	195	" ", filename,
	196	" ", line,
8532893d	197	" ", pc,
754e5da2 SG	198	NULL);
	199
	200	if (v != TCL_OK)
	201	{
	202	gdbtk_fputs (interp->result);
	203	gdbtk_fputs ("\n");
	204	}
754e5da2 SG	205	}
	206
	207	static void
	208	gdbtk_create_breakpoint(b)
	209	struct breakpoint *b;
	210	{
	211	breakpoint_notify(b, "create");
	212	}
	213
	214	static void
	215	gdbtk_delete_breakpoint(b)
	216	struct breakpoint *b;
	217	{
	218	breakpoint_notify(b, "delete");
	219	}
	220
	221	static void
	222	gdbtk_enable_breakpoint(b)
	223	struct breakpoint *b;
	224	{
	225	breakpoint_notify(b, "enable");
	226	}
	227
	228	static void
	229	gdbtk_disable_breakpoint(b)
	230	struct breakpoint *b;
	231	{
	232	breakpoint_notify(b, "disable");
	233	}
	234	\f
	235	/* This implements the TCL command `gdb_loc', which returns a list consisting
	236	of the source and line number associated with the current pc. */
	237
	238	static int
	239	gdb_loc (clientData, interp, argc, argv)
	240	ClientData clientData;
	241	Tcl_Interp *interp;
	242	int argc;
	243	char *argv[];
	244	{
	245	char *filename;
	246	char buf[100];
	247	struct symtab_and_line sal;
	248	char *funcname;
8532893d	249	CORE_ADDR pc;
754e5da2 SG	250
	251	if (argc == 1)
	252	{
	253	struct frame_info *frame;
	254	struct symbol *func;
754e5da2 SG	255
754e5da2 SG	256	frame = get_frame_info (selected_frame);
8532893d	257
754e5da2	258	pc = frame ? frame->pc : stop_pc;
8532893d	259
754e5da2 SG	260	sal = find_pc_line (pc, 0);
	261	}
	262	else if (argc == 2)
	263	{
754e5da2	264	struct symtabs_and_lines sals;
8532893d	265	int nelts;
754e5da2 SG	266
	267	sals = decode_line_spec (argv[1], 1);
	268
8532893d SG	269	nelts = sals.nelts;
	270	sal = sals.sals[0];
	271	free (sals.sals);
	272
754e5da2 SG	273	if (sals.nelts != 1)
	274	{
	275	Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC);
754e5da2 SG	276	return TCL_ERROR;
	277	}
	278
8532893d	279	pc = sal.pc;
754e5da2 SG	280	}
	281	else
	282	{
	283	Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
	284	return TCL_ERROR;
	285	}
	286
754e5da2 SG	287	if (sal.symtab)
	288	Tcl_AppendElement (interp, sal.symtab->filename);
	289	else
	290	Tcl_AppendElement (interp, "");
8532893d SG	291
8532893d SG	292	find_pc_partial_function (pc, &funcname, NULL, NULL);
754e5da2	293	Tcl_AppendElement (interp, funcname);
8532893d	294
637b1661	295	filename = symtab_to_filename (sal.symtab);
754e5da2	296	Tcl_AppendElement (interp, filename);
8532893d SG	297
8532893d SG	298	sprintf (buf, "%d", sal.line);
754e5da2 SG	299	Tcl_AppendElement (interp, buf); /* line number */
754e5da2 SG	300
8532893d SG	301	sprintf (buf, "0x%x", pc);
	302	Tcl_AppendElement (interp, buf); /* PC */
	303
754e5da2 SG	304	return TCL_OK;
	305	}
	306	\f
	307	static int
	308	gdb_cmd_stub (cmd)
	309	char *cmd;
	310	{
	311	execute_command (cmd, 1);
	312
	313	return 1; /* Indicate success */
	314	}
	315
	316	/* This implements the TCL command `gdb_cmd', which sends it's argument into
	317	the GDB command scanner. */
	318
	319	static int
	320	gdb_cmd (clientData, interp, argc, argv)
	321	ClientData clientData;
	322	Tcl_Interp *interp;
	323	int argc;
	324	char *argv[];
	325	{
	326	int val;
	327	struct cleanup *old_chain;
	328
	329	if (argc != 2)
	330	{
	331	Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
	332	return TCL_ERROR;
	333	}
	334
	335	old_chain = make_cleanup (null_routine, 0);
	336
	337	val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR);
	338
	339	bpstat_do_actions (&stop_bpstat);
	340	do_cleanups (old_chain);
	341
8532893d SG	342	/* Drain all buffered command output */
	343
	344	gdb_flush (gdb_stderr);
	345	gdb_flush (gdb_stdout);
	346
754e5da2 SG	347	/* We could base the return value on val, but that would require most users
	348	to use catch. Since GDB errors are already being handled elsewhere, I
	349	see no reason to pass them up to the caller. */
	350
	351	return TCL_OK;
	352	}
	353
	354	static int
	355	gdb_listfiles (clientData, interp, argc, argv)
	356	ClientData clientData;
	357	Tcl_Interp *interp;
	358	int argc;
	359	char *argv[];
	360	{
	361	int val;
	362	struct objfile *objfile;
	363	struct partial_symtab *psymtab;
	364
	365	ALL_PSYMTABS (objfile, psymtab)
	366	Tcl_AppendElement (interp, psymtab->filename);
	367
	368	return TCL_OK;
	369	}
	370	\f
	371	static void
	372	tk_command (cmd, from_tty)
	373	char *cmd;
	374	int from_tty;
	375	{
	376	Tcl_VarEval (interp, cmd, NULL);
	377
	378	gdbtk_fputs (interp->result);
	379	gdbtk_fputs ("\n");
	380	}
	381
	382	static void
	383	cleanup_init (ignored)
	384	int ignored;
	385	{
	386	if (mainWindow != NULL)
	387	Tk_DestroyWindow (mainWindow);
	388	mainWindow = NULL;
	389
	390	if (interp != NULL)
	391	Tcl_DeleteInterp (interp);
	392	interp = NULL;
	393	}
	394
637b1661 SG	395	/* Come here during long calculations to check for GUI events. Usually invoked
	396	via the QUIT macro. */
	397
	398	static void
	399	gdbtk_interactive ()
	400	{
	401	/* Tk_DoOneEvent (TK_DONT_WAIT\|TK_IDLE_EVENTS); */
	402	}
	403
754e5da2 SG	404	static void
	405	gdbtk_init ()
	406	{
	407	struct cleanup *old_chain;
	408	char *gdbtk_filename;
	409
	410	old_chain = make_cleanup (cleanup_init, 0);
	411
	412	/* First init tcl and tk. */
	413
	414	interp = Tcl_CreateInterp ();
	415
	416	if (!interp)
	417	error ("Tcl_CreateInterp failed");
	418
	419	mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
	420
	421	if (!mainWindow)
	422	return; /* DISPLAY probably not set */
	423
	424	if (Tcl_Init(interp) != TCL_OK)
	425	error ("Tcl_Init failed: %s", interp->result);
	426
	427	if (Tk_Init(interp) != TCL_OK)
	428	error ("Tk_Init failed: %s", interp->result);
	429
	430	Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL);
	431	Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL);
	432	Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
	433
	434	gdbtk_filename = getenv ("GDBTK_FILENAME");
8532893d SG	435	if (!gdbtk_filename)
	436	if (access ("gdbtk.tcl", R_OK) == 0)
	437	gdbtk_filename = "gdbtk.tcl";
	438	else
	439	gdbtk_filename = GDBTK_FILENAME;
	440
	441	if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
	442	error ("Failure reading %s: %s", gdbtk_filename, interp->result);
754e5da2 SG	443
	444	command_loop_hook = Tk_MainLoop;
	445	fputs_unfiltered_hook = gdbtk_fputs;
	446	print_frame_info_listing_hook = null_routine;
	447	query_hook = gdbtk_query;
	448	flush_hook = gdbtk_flush;
	449	create_breakpoint_hook = gdbtk_create_breakpoint;
	450	delete_breakpoint_hook = gdbtk_delete_breakpoint;
	451	enable_breakpoint_hook = gdbtk_enable_breakpoint;
	452	disable_breakpoint_hook = gdbtk_disable_breakpoint;
637b1661	453	interactive_hook = gdbtk_interactive;
754e5da2 SG	454
	455	discard_cleanups (old_chain);
	456
	457	add_com ("tk", class_obscure, tk_command,
	458	"Send a command directly into tk.");
	459	}
	460
	461	/* Come here during initialze_all_files () */
	462
	463	void
	464	_initialize_gdbtk ()
	465	{
	466	if (no_windows)
	467	return;
	468
	469	/* Tell the rest of the world that Gdbtk is now set up. */
	470
	471	init_ui_hook = gdbtk_init;
	472	}