gdb/gdbtk.c

   1 /* Startup code for gdbtk.
   2    Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
   3
   4    Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
   5
   6 This file is part of GDB.
   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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
  21
  22 #include "defs.h"
  23 #include "symtab.h"
  24 #include "inferior.h"
  25 #include "command.h"
  26 #include "bfd.h"
  27 #include "symfile.h"
  28 #include "objfiles.h"
  29 #include "target.h"
  30 #include "gdbcore.h"
  31 #include "tracepoint.h"
  32 #include "demangle.h"
  33
  34 #ifdef _WIN32
  35 #include <winuser.h>
  36 #endif
  37
  38 #include <sys/stat.h>
  39
  40 #include <tcl.h>
  41 #include <tk.h>
  42 #include <itcl.h>
  43 #include <tix.h>
  44 #include "guitcl.h"
  45 #include "gdbtk.h"
  46
  47 /* start-sanitize-ide */
  48 #ifdef IDE
  49 #include "event.h"
  50 #include "idetcl.h"
  51 #include "ilutk.h"
  52 #endif
  53 /* end-sanitize-ide */
  54
  55 #ifdef ANSI_PROTOTYPES
  56 #include <stdarg.h>
  57 #else
  58 #include <varargs.h>
  59 #endif
  60 #include <signal.h>
  61 #include <fcntl.h>
  62 #include <unistd.h>
  63 #include <setjmp.h>
  64 #include "top.h"
  65 #include <sys/ioctl.h>
  66 #include "gdb_string.h"
  67 #include "dis-asm.h"
  68 #include <stdio.h>
  69 #include "gdbcmd.h"
  70
  71 #include "annotate.h"
  72 #include <sys/time.h>
  73
  74 #ifdef __CYGWIN32__
  75 #include <sys/cygwin.h> /* for cygwin32_attach_handle_to_fd */
  76 #endif
  77
  78 /* For Cygwin, we use a timer to periodically check for Windows
  79    messages.  FIXME: It would be better to not poll, but to instead
  80    rewrite the target_wait routines to serve as input sources.
  81    Unfortunately, that will be a lot of work.  */
  82 static sigset_t nullsigmask;
  83 static struct sigaction act1, act2;
  84 static struct itimerval it_on, it_off;
  85
  86  /*
  87   * These two variables control the interaction with an external editor.
  88   * If enable_external_editor is set at startup, BEFORE Gdbtk_Init is run
  89   * then the Tcl variable of the same name will be set, and a command will
  90   * called external_editor_command will be invoked to call out to the
  91   * external editor.  We give a dummy version here to warn if it is not set.
  92   */
  93 int enable_external_editor = 0;
  94 char * external_editor_command = "tk_dialog .warn-external \\\n\
  95 \"No command is specified.\nUse --tclcommand <tcl/file> or --external-editor <cmd> to specify a new command\" 0 Ok";
  96
  97 extern int Tktable_Init PARAMS ((Tcl_Interp *interp));
  98
  99 static void gdbtk_init PARAMS ((char *));
 100 void gdbtk_interactive PARAMS ((void));
 101 static void cleanup_init PARAMS ((int));
 102 static void tk_command PARAMS ((char *, int));
 103
 104 void gdbtk_add_hooks PARAMS ((void));
 105 int gdbtk_test PARAMS ((char *));
 106
 107 /*
 108  * gdbtk_fputs is defined in the gdbtk_hooks.c, but we need it here
 109  * because we delay adding this hook till all the setup is done.  That
 110  * way errors will go to stdout.
 111  */
 112
 113 extern void   gdbtk_fputs PARAMS ((const char *, GDB_FILE *));
 114
 115 /* Handle for TCL interpreter */
 116 Tcl_Interp *gdbtk_interp = NULL;
 117
 118 static int gdbtk_timer_going = 0;
 119
 120 /* linked variable used to tell tcl what the current thread is */
 121 int gdb_context = 0;
 122
 123 /* This variable is true when the inferior is running.  See note in
 124  * gdbtk.h for details.
 125  */
 126 int running_now;
 127
 128 /* This variable holds the name of a Tcl file which should be sourced by the
 129    interpreter when it goes idle at startup. Used with the testsuite. */
 130 static char *gdbtk_source_filename = NULL;
 131 \f
 132 #ifndef _WIN32
 133
 134 /* Supply malloc calls for tcl/tk.  We do not want to do this on
 135    Windows, because Tcl_Alloc is probably in a DLL which will not call
 136    the mmalloc routines.  */
 137
 138 char *
 139 Tcl_Alloc (size)
 140      unsigned int size;
 141 {
 142   return xmalloc (size);
 143 }
 144
 145 char *
 146 Tcl_Realloc (ptr, size)
 147      char *ptr;
 148      unsigned int size;
 149 {
 150   return xrealloc (ptr, size);
 151 }
 152
 153 void
 154 Tcl_Free(ptr)
 155      char *ptr;
 156 {
 157   free (ptr);
 158 }
 159
 160 #endif /* ! _WIN32 */
 161
 162 #ifdef _WIN32
 163
 164 /* On Windows, if we hold a file open, other programs can't write to
 165  * it.  In particular, we don't want to hold the executable open,
 166  * because it will mean that people have to get out of the debugging
 167  * session in order to remake their program.  So we close it, although
 168  * this will cost us if and when we need to reopen it.
 169  */
 170
 171 void
 172 close_bfds ()
 173 {
 174   struct objfile *o;
 175
 176   ALL_OBJFILES (o)
 177     {
 178       if (o->obfd != NULL)
 179         bfd_cache_close (o->obfd);
 180     }
 181
 182   if (exec_bfd != NULL)
 183     bfd_cache_close (exec_bfd);
 184 }
 185
 186 #endif /* _WIN32 */
 187
 188 \f
 189 /* TclDebug (const char *fmt, ...) works just like printf() but
 190  * sends the output to the GDB TK debug window.
 191  * Not for normal use; just a convenient tool for debugging
 192  */
 193
 194 void
 195 #ifdef ANSI_PROTOTYPES
 196 TclDebug (const char *fmt, ...)
 197 #else
 198 TclDebug (va_alist)
 199      va_dcl
 200 #endif
 201 {
 202   va_list args;
 203   char buf[512], *v[2], *merge;
 204
 205 #ifdef ANSI_PROTOTYPES
 206   va_start (args, fmt);
 207 #else
 208   char *fmt;
 209   va_start (args);
 210   fmt = va_arg (args, char *);
 211 #endif
 212
 213   v[0] = "debug";
 214   v[1] = buf;
 215
 216   vsprintf (buf, fmt, args);
 217   va_end (args);
 218
 219   merge = Tcl_Merge (2, v);
 220   Tcl_Eval (gdbtk_interp, merge);
 221   Tcl_Free (merge);
 222 }
 223
 224 \f
 225 /*
 226  * The rest of this file contains the start-up, and event handling code for gdbtk.
 227  */
 228
 229 /*
 230  * This cleanup function is added to the cleanup list that surrounds the Tk
 231  * main in gdbtk_init.  It deletes the Tcl interpreter.
 232  */
 233
 234 static void
 235 cleanup_init (ignored)
 236      int ignored;
 237 {
 238   if (gdbtk_interp != NULL)
 239     Tcl_DeleteInterp (gdbtk_interp);
 240   gdbtk_interp = NULL;
 241 }
 242
 243 /* Come here during long calculations to check for GUI events.  Usually invoked
 244    via the QUIT macro.  */
 245
 246 void
 247 gdbtk_interactive ()
 248 {
 249   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
 250 }
 251
 252
 253 void
 254 gdbtk_start_timer ()
 255 {
 256   static int first = 1;
 257   /*TclDebug ("Starting timer....");*/
 258   if (first)
 259     {
 260       /* first time called, set up all the structs */
 261       first = 0;
 262       sigemptyset (&nullsigmask);
 263
 264       act1.sa_handler = x_event;
 265       act1.sa_mask = nullsigmask;
 266       act1.sa_flags = 0;
 267
 268       act2.sa_handler = SIG_IGN;
 269       act2.sa_mask = nullsigmask;
 270       act2.sa_flags = 0;
 271
 272       it_on.it_interval.tv_sec = 0;
 273       it_on.it_interval.tv_usec = 250000; /* .25 sec */
 274       it_on.it_value.tv_sec = 0;
 275       it_on.it_value.tv_usec = 250000;
 276
 277       it_off.it_interval.tv_sec = 0;
 278       it_off.it_interval.tv_usec = 0;
 279       it_off.it_value.tv_sec = 0;
 280       it_off.it_value.tv_usec = 0;
 281     }
 282
 283   if (!gdbtk_timer_going)
 284     {
 285       sigaction (SIGALRM, &act1, NULL);
 286       setitimer (ITIMER_REAL, &it_on, NULL);
 287       gdbtk_timer_going = 1;
 288     }
 289 }
 290
 291 void
 292 gdbtk_stop_timer ()
 293 {
 294   if (gdbtk_timer_going)
 295     {
 296       gdbtk_timer_going = 0;
 297       /*TclDebug ("Stopping timer.");*/
 298       setitimer (ITIMER_REAL, &it_off, NULL);
 299       sigaction (SIGALRM, &act2, NULL);
 300     }
 301 }
 302
 303 /* gdbtk_init installs this function as a final cleanup.  */
 304
 305 static void
 306 gdbtk_cleanup (dummy)
 307      PTR dummy;
 308 {
 309   Tcl_Eval (gdbtk_interp, "gdbtk_cleanup");
 310 #ifdef IDE
 311   {
 312     struct ide_event_handle *h = (struct ide_event_handle *) dummy;
 313     ide_interface_deregister_all (h);
 314   }
 315 #endif
 316   Tcl_Finalize ();
 317 }
 318
 319 /* Initialize gdbtk.  This involves creating a Tcl interpreter,
 320  * defining all the Tcl commands that the GUI will use, pointing
 321  * all the gdb "hooks" to the correct functions,
 322  * and setting the Tcl auto loading environment so that we can find all
 323  * the Tcl based library files.
 324  */
 325
 326 static void
 327 gdbtk_init ( argv0 )
 328      char *argv0;
 329 {
 330   struct cleanup *old_chain;
 331   int found_main;
 332   char s[5];
 333   Tcl_Obj *auto_path_elem, *auto_path_name;
 334
 335   /* start-sanitize-ide */
 336 #ifdef IDE
 337   struct ide_event_handle *h;
 338   const char *errmsg;
 339   char *libexecdir;
 340 #endif
 341   /* end-sanitize-ide */
 342
 343   /* If there is no DISPLAY environment variable, Tk_Init below will fail,
 344      causing gdb to abort.  If instead we simply return here, gdb will
 345      gracefully degrade to using the command line interface. */
 346
 347 #ifndef _WIN32
 348   if (getenv ("DISPLAY") == NULL)
 349     return;
 350 #endif
 351
 352   old_chain = make_cleanup ((make_cleanup_func) cleanup_init, 0);
 353
 354   /* First init tcl and tk. */
 355   Tcl_FindExecutable (argv0);
 356   gdbtk_interp = Tcl_CreateInterp ();
 357
 358 #ifdef TCL_MEM_DEBUG
 359   Tcl_InitMemory (gdbtk_interp);
 360 #endif
 361
 362   if (!gdbtk_interp)
 363     error ("Tcl_CreateInterp failed");
 364
 365   if (Tcl_Init(gdbtk_interp) != TCL_OK)
 366     error ("Tcl_Init failed: %s", gdbtk_interp->result);
 367
 368   /* Set up some globals used by gdb to pass info to gdbtk
 369      for start up options and the like */
 370   sprintf (s, "%d", inhibit_gdbinit);
 371   Tcl_SetVar2 (gdbtk_interp, "GDBStartup", "inhibit_prefs", s, TCL_GLOBAL_ONLY);
 372
 373   /* start-sanitize-ide */
 374 #ifndef IDE
 375   /* end-sanitize-ide */
 376   /* For the IDE we register the cleanup later, after we've
 377      initialized events.  */
 378   make_final_cleanup (gdbtk_cleanup,  NULL);
 379   /* start-sanitize-ide */
 380 #endif /* IDE */
 381   /* end-sanitize-ide */
 382
 383   /* Initialize the Paths variable.  */
 384   if (ide_initialize_paths (gdbtk_interp, "") != TCL_OK)
 385     error ("ide_initialize_paths failed: %s", gdbtk_interp->result);
 386
 387   /* start-sanitize-ide */
 388 #ifdef IDE
 389   /* Find the directory where we expect to find idemanager.  We ignore
 390      errors since it doesn't really matter if this fails.  */
 391   libexecdir = Tcl_GetVar2 (gdbtk_interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
 392
 393   IluTk_Init ();
 394
 395   h = ide_event_init_from_environment (&errmsg, libexecdir);
 396   make_final_cleanup (gdbtk_cleanup, h);
 397   if (h == NULL)
 398     {
 399       Tcl_AppendResult (gdbtk_interp, "can't initialize event system: ", errmsg,
 400                         (char *) NULL);
 401       fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", gdbtk_interp->result);
 402
 403       Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0);
 404     }
 405   else
 406     {
 407       if (ide_create_tclevent_command (gdbtk_interp, h) != TCL_OK)
 408         error ("ide_create_tclevent_command failed: %s", gdbtk_interp->result);
 409
 410       if (ide_create_edit_command (gdbtk_interp, h) != TCL_OK)
 411         error ("ide_create_edit_command failed: %s", gdbtk_interp->result);
 412
 413       if (ide_create_property_command (gdbtk_interp, h) != TCL_OK)
 414         error ("ide_create_property_command failed: %s", gdbtk_interp->result);
 415
 416       if (ide_create_build_command (gdbtk_interp, h) != TCL_OK)
 417         error ("ide_create_build_command failed: %s", gdbtk_interp->result);
 418
 419       if (ide_create_window_register_command (gdbtk_interp, h, "gdb-restore")
 420           != TCL_OK)
 421         error ("ide_create_window_register_command failed: %s",
 422                gdbtk_interp->result);
 423
 424       if (ide_create_window_command (gdbtk_interp, h) != TCL_OK)
 425         error ("ide_create_window_command failed: %s", gdbtk_interp->result);
 426
 427       if (ide_create_exit_command (gdbtk_interp, h) != TCL_OK)
 428         error ("ide_create_exit_command failed: %s", gdbtk_interp->result);
 429
 430       if (ide_create_help_command (gdbtk_interp) != TCL_OK)
 431         error ("ide_create_help_command failed: %s", gdbtk_interp->result);
 432
 433       /*
 434         if (ide_initialize (gdbtk_interp, "gdb") != TCL_OK)
 435         error ("ide_initialize failed: %s", gdbtk_interp->result);
 436       */
 437
 438       Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "1", 0);
 439     }
 440 #else
 441   /* end-sanitize-ide */
 442   Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0);
 443   /* start-sanitize-ide */
 444 #endif /* IDE */
 445   /* end-sanitize-ide */
 446
 447   /* We don't want to open the X connection until we've done all the
 448      IDE initialization.  Otherwise, goofy looking unfinished windows
 449      pop up when ILU drops into the TCL event loop.  */
 450
 451   if (Tk_Init(gdbtk_interp) != TCL_OK)
 452     error ("Tk_Init failed: %s", gdbtk_interp->result);
 453
 454   if (Itcl_Init(gdbtk_interp) == TCL_ERROR)
 455     error ("Itcl_Init failed: %s", gdbtk_interp->result);
 456   Tcl_StaticPackage(gdbtk_interp, "Itcl", Itcl_Init,
 457                     (Tcl_PackageInitProc *) NULL);
 458
 459   if (Itk_Init(gdbtk_interp) == TCL_ERROR)
 460     error ("Itk_Init failed: %s", gdbtk_interp->result);
 461   Tcl_StaticPackage(gdbtk_interp, "Itk", Itk_Init,
 462                     (Tcl_PackageInitProc *) NULL);
 463
 464   if (Tix_Init(gdbtk_interp) != TCL_OK)
 465     error ("Tix_Init failed: %s", gdbtk_interp->result);
 466   Tcl_StaticPackage(gdbtk_interp, "Tix", Tix_Init,
 467                     (Tcl_PackageInitProc *) NULL);
 468
 469   if (Tktable_Init(gdbtk_interp) != TCL_OK)
 470     error ("Tktable_Init failed: %s", gdbtk_interp->result);
 471
 472   Tcl_StaticPackage(gdbtk_interp, "Tktable", Tktable_Init,
 473                     (Tcl_PackageInitProc *) NULL);
 474   /*
 475    * These are the commands to do some Windows Specific stuff...
 476    */
 477
 478 #ifdef __CYGWIN32__
 479   if (ide_create_messagebox_command (gdbtk_interp) != TCL_OK)
 480     error ("messagebox command initialization failed");
 481   /* On Windows, create a sizebox widget command */
 482   if (ide_create_sizebox_command (gdbtk_interp) != TCL_OK)
 483     error ("sizebox creation failed");
 484   if (ide_create_winprint_command (gdbtk_interp) != TCL_OK)
 485     error ("windows print code initialization failed");
 486   /* start-sanitize-ide */
 487   /* An interface to ShellExecute.  */
 488   if (ide_create_shell_execute_command (gdbtk_interp) != TCL_OK)
 489     error ("shell execute command initialization failed");
 490   /* end-sanitize-ide */
 491   if (ide_create_win_grab_command (gdbtk_interp) != TCL_OK)
 492     error ("grab support command initialization failed");
 493   /* Path conversion functions.  */
 494   if (ide_create_cygwin_path_command (gdbtk_interp) != TCL_OK)
 495     error ("cygwin path command initialization failed");
 496 #else
 497   /* for now, this testing function is Unix only */
 498   if (cyg_create_warp_pointer_command (gdbtk_interp) != TCL_OK)
 499     error ("warp_pointer command initialization failed");
 500 #endif
 501
 502   /*
 503    * This adds all the Gdbtk commands.
 504    */
 505
 506   if (Gdbtk_Init(gdbtk_interp) != TCL_OK)
 507     {
 508        error("Gdbtk_Init failed: %s", gdbtk_interp->result);
 509     }
 510
 511   Tcl_StaticPackage(gdbtk_interp, "Gdbtk", Gdbtk_Init, NULL);
 512
 513   /* This adds all the hooks that call up from the bowels of gdb
 514    *  back into Tcl-land...
 515    */
 516
 517   gdbtk_add_hooks();
 518
 519   /* Add a back door to Tk from the gdb console... */
 520
 521   add_com ("tk", class_obscure, tk_command,
 522            "Send a command directly into tk.");
 523
 524   /*
 525    * Set the variables for external editor:
 526    */
 527
 528   Tcl_SetVar (gdbtk_interp, "enable_external_editor", enable_external_editor ? "1" : "0", 0);
 529   Tcl_SetVar (gdbtk_interp, "external_editor_command", external_editor_command, 0);
 530
 531   /* find the gdb tcl library and source main.tcl */
 532
 533   {
 534 #ifdef NO_TCLPRO_DEBUGGER
 535     static const char script[] ="\
 536 proc gdbtk_find_main {} {\n\
 537     global Paths GDBTK_LIBRARY\n\
 538     rename gdbtk_find_main {}\n\
 539     tcl_findLibrary gdb 1.0 {} main.tcl GDBTK_LIBRARY GDBTK_LIBRARY gdbtcl2 gdbtcl {}\n\
 540     set Paths(appdir) $GDBTK_LIBRARY\n\
 541 }\n\
 542 gdbtk_find_main";
 543 #else
 544     static const char script[] ="\
 545 proc gdbtk_find_main {} {\n\
 546     global Paths GDBTK_LIBRARY env\n\
 547     rename gdbtk_find_main {}\n\
 548     if {[info exists env(DEBUG_STUB)]} {\n\
 549         source $env(DEBUG_STUB)\n\
 550         debugger_init\n\
 551         set debug_startup 1\n\
 552     } else {\n\
 553         set debug_startup 0\n\
 554     }\n\
 555     tcl_findLibrary gdb 1.0 {} main.tcl GDBTK_LIBRARY GDBTK_LIBRARY gdbtcl2 gdbtcl {} $debug_startup\n\
 556     set Paths(appdir) $GDBTK_LIBRARY\n\
 557 }\n\
 558 gdbtk_find_main";
 559 #endif /* NO_TCLPRO_DEBUGGER */
 560
 561     /* fputs_unfiltered_hook = NULL; */ /* Force errors to stdout/stderr */
 562
 563     /*
 564      * Set the variables for external editor, do this before eval'ing main.tcl
 565      * since the value is used there...
 566      */
 567
 568     Tcl_SetVar (gdbtk_interp, "enable_external_editor",
 569                 enable_external_editor ? "1" : "0", 0);
 570     Tcl_SetVar (gdbtk_interp, "external_editor_command",
 571                 external_editor_command, 0);
 572
 573   fputs_unfiltered_hook = gdbtk_fputs;
 574
 575   if (Tcl_GlobalEval (gdbtk_interp, (char *) script) != TCL_OK)
 576       {
 577         char *msg;
 578
 579         /* Force errorInfo to be set up propertly.  */
 580         Tcl_AddErrorInfo (gdbtk_interp, "");
 581
 582         msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
 583
 584         fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
 585
 586 #ifdef _WIN32
 587         MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
 588 #else
 589         fputs_unfiltered (msg, gdb_stderr);
 590 #endif
 591
 592         error ("");
 593
 594       }
 595   }
 596
 597
 598   /* start-sanitize-ide */
 599 #ifdef IDE
 600   /* Don't do this until we have initialized.  Otherwise, we may get a
 601      run command before we are ready for one.  */
 602   if (ide_run_server_init (gdbtk_interp, h) != TCL_OK)
 603     error ("ide_run_server_init failed: %s", gdbtk_interp->result);
 604 #endif
 605   /* end-sanitize-ide */
 606
 607   /* Now source in the filename provided by the --tclcommand option.
 608      This is mostly used for the gdbtk testsuite... */
 609
 610   if (gdbtk_source_filename != NULL)
 611     {
 612       char *s = "after idle source ";
 613       char *script = concat (s, gdbtk_source_filename, (char *) NULL);
 614       Tcl_Eval (gdbtk_interp, script);
 615       free (gdbtk_source_filename);
 616       free (script);
 617     }
 618
 619
 620   discard_cleanups (old_chain);
 621 }
 622
 623 /* gdbtk_test is used in main.c to validate the -tclcommand option to
 624    gdb, which sources in a file of tcl code after idle during the
 625    startup procedure. */
 626
 627 int
 628 gdbtk_test (filename)
 629      char *filename;
 630 {
 631   if (access (filename, R_OK) != 0)
 632     return 0;
 633   else
 634     gdbtk_source_filename = xstrdup (filename);
 635   return 1;
 636 }
 637
 638 /* Come here during initialize_all_files () */
 639
 640 void
 641 _initialize_gdbtk ()
 642 {
 643   if (use_windows)
 644     {
 645       /* Tell the rest of the world that Gdbtk is now set up. */
 646
 647       init_ui_hook = gdbtk_init;
 648 #ifdef __CYGWIN32__
 649       (void) FreeConsole ();
 650 #endif
 651     }
 652 #ifdef __CYGWIN32__
 653   else
 654     {
 655       DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE));
 656
 657       switch (ft)
 658         {
 659           case FILE_TYPE_DISK:
 660           case FILE_TYPE_CHAR:
 661           case FILE_TYPE_PIPE:
 662             break;
 663           default:
 664             AllocConsole();
 665             cygwin32_attach_handle_to_fd ("/dev/conin", 0,
 666                                           GetStdHandle (STD_INPUT_HANDLE),
 667                                           1, GENERIC_READ);
 668             cygwin32_attach_handle_to_fd ("/dev/conout", 1,
 669                                           GetStdHandle (STD_OUTPUT_HANDLE),
 670                                           0, GENERIC_WRITE);
 671             cygwin32_attach_handle_to_fd ("/dev/conout", 2,
 672                                           GetStdHandle (STD_ERROR_HANDLE),
 673                                           0, GENERIC_WRITE);
 674             break;
 675         }
 676     }
 677 #endif
 678 }
 679
 680 static void
 681 tk_command (cmd, from_tty)
 682      char *cmd;
 683      int from_tty;
 684 {
 685   int retval;
 686   char *result;
 687   struct cleanup *old_chain;
 688
 689   /* Catch case of no argument, since this will make the tcl interpreter dump core. */
 690   if (cmd == NULL)
 691     error_no_arg ("tcl command to interpret");
 692
 693   retval = Tcl_Eval (gdbtk_interp, cmd);
 694
 695   result = strdup (gdbtk_interp->result);
 696
 697   old_chain = make_cleanup (free, result);
 698
 699   if (retval != TCL_OK)
 700     error (result);
 701
 702   printf_unfiltered ("%s\n", result);
 703
 704   do_cleanups (old_chain);
 705 }
 706 \f
 707 /* Local variables: */
 708 /* change-log-default-name: "ChangeLog-gdbtk" */
 709 /* End: */
 710