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