gdb/gdbtk/generic/gdbtk-interp.c

   1 /* Insight Definitions for GDB, the GNU debugger.
   2    Written by Keith Seitz <kseitz@sources.redhat.com>
   3
   4    Copyright (C) 2003, 2004, 2008 Free Software Foundation, Inc.
   5
   6    This file is part of Insight.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 2 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program; if not, write to the Free Software
  20    Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21    Boston, MA 02110-1301, USA.  */
  22
  23 #include "defs.h"
  24 #include "interps.h"
  25 #include "ui-file.h"
  26 #include "ui-out.h"
  27 #include "cli-out.h"
  28 #include "gdb_string.h"
  29 #include "cli/cli-cmds.h"
  30 #include "cli/cli-decode.h"
  31 #include "exceptions.h"
  32
  33 #include "tcl.h"
  34 #include "tk.h"
  35 #include "gdbtk.h"
  36
  37 #ifdef __MINGW32__
  38 # define WIN32_LEAN_AND_MEAN
  39 # include <windows.h>
  40 #endif
  41
  42
  43 static void gdbtk_command_loop (void);
  44 static void hack_disable_interpreter_exec (char *, int);
  45
  46 struct gdbtk_interp_data
  47 {
  48   struct ui_file *_stdout;
  49   struct ui_file *_stderr;
  50   struct ui_file *_stdlog;
  51   struct ui_file *_stdtarg;
  52   struct ui_file *_stdtargin;
  53 };
  54
  55 static struct gdbtk_interp_data *gdbtk_data;
  56
  57 /* See note in gdbtk_interpreter_init */
  58 static void
  59 hack_disable_interpreter_exec (char *args, int from_tty)
  60 {
  61   error ("interpreter-exec not available when running Insight");
  62 }
  63
  64 static void *
  65 gdbtk_interpreter_init (int top_level)
  66 {
  67   /* Disable interpreter-exec. It causes us big trouble right now. */
  68   struct cmd_list_element *cmd = NULL;
  69   struct cmd_list_element *alias = NULL;
  70   struct cmd_list_element *prefix = NULL;
  71
  72   gdbtk_init ();
  73
  74   if (lookup_cmd_composition ("interpreter-exec", &alias, &prefix, &cmd))
  75     {
  76       set_cmd_cfunc (cmd, hack_disable_interpreter_exec);
  77     }
  78
  79   return gdbtk_data;
  80 }
  81
  82 static int
  83 gdbtk_interpreter_resume (void *data)
  84 {
  85   static int started = 0;
  86   struct gdbtk_interp_data *d = (struct gdbtk_interp_data *) data;
  87   gdbtk_add_hooks ();
  88
  89   gdb_stdout = d->_stdout;
  90   gdb_stderr = d->_stderr;
  91   gdb_stdlog = d->_stdlog;
  92   gdb_stdtarg = d->_stdtarg;
  93   gdb_stdtargin = d->_stdtargin;
  94
  95   deprecated_command_loop_hook = gdbtk_command_loop;
  96
  97   /* 2003-02-11 keiths: We cannot actually source our main Tcl file in
  98      our interpreter's init function because any errors that may
  99      get generated will go to the wrong gdb_stderr. Instead of hacking
 100      our interpreter init function to force gdb_stderr to our ui_file,
 101      we defer sourcing the startup file until now, when gdb is ready
 102      to let our interpreter run. */
 103   if (!started)
 104     {
 105       started = 1;
 106       gdbtk_source_start_file ();
 107     }
 108
 109   return 1;
 110 }
 111
 112 static int
 113 gdbtk_interpreter_suspend (void *data)
 114 {
 115   return 1;
 116 }
 117
 118 static int
 119 gdbtk_interpreter_display_prompt_p (void *data)
 120 {
 121   return 1;
 122 }
 123
 124 static struct gdb_exception
 125 gdbtk_interpreter_exec (void *data, const char *command_str)
 126 {
 127   return exception_none;
 128 }
 129
 130 /* This function is called instead of gdb's internal command loop.  This is the
 131    last chance to do anything before entering the main Tk event loop.
 132    At the end of the command, we enter the main loop. */
 133
 134 static void
 135 gdbtk_command_loop (void)
 136 {
 137   extern FILE *instream;
 138
 139   /* We no longer want to use stdin as the command input stream */
 140   instream = NULL;
 141
 142   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
 143     {
 144       const char *msg;
 145
 146       /* Force errorInfo to be set up propertly.  */
 147       Tcl_AddErrorInfo (gdbtk_interp, "");
 148
 149       msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
 150 #ifdef _WIN32
 151       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
 152 #else
 153       fputs_unfiltered (msg, gdb_stderr);
 154 #endif
 155     }
 156
 157 #ifdef _WIN32
 158   close_bfds ();
 159 #endif
 160
 161   Tk_MainLoop ();
 162 }
 163
 164 void
 165 _initialize_gdbtk_interp (void)
 166 {
 167   static const struct interp_procs procs = {
 168     gdbtk_interpreter_init,             /* init_proc */
 169     gdbtk_interpreter_resume,           /* resume_proc */
 170     gdbtk_interpreter_suspend,          /* suspend_proc */
 171     gdbtk_interpreter_exec,             /* exec_proc */
 172     gdbtk_interpreter_display_prompt_p  /* prompt_proc_p */
 173   };
 174   struct interp *gdbtk_interp;
 175
 176   gdbtk_data =
 177     (struct gdbtk_interp_data *) xmalloc (sizeof (struct gdbtk_interp_data));
 178   memset (gdbtk_data, 0, sizeof (struct gdbtk_interp_data));
 179   gdbtk_data->_stdout = gdbtk_fileopen ();
 180   gdbtk_data->_stderr = gdbtk_fileopen ();
 181   gdbtk_data->_stdlog = gdbtk_fileopen ();
 182   gdbtk_data->_stdtarg = gdbtk_fileopen ();
 183   gdbtk_data->_stdtargin = gdbtk_fileopenin ();
 184   gdbtk_interp = interp_new ("insight", gdbtk_data, cli_out_new (gdbtk_data->_stdout),
 185                              &procs);
 186   interp_add (gdbtk_interp);
 187 }