Commit | Line | Data |
---|---|---|
ca4e7e14 | 1 | /* Startup code for gdbtk. |
a5f4fbff | 2 | Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. |
4604b34c SG |
3 | |
4 | Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support. | |
754e5da2 SG |
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 | |
6c9638b4 | 20 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ |
754e5da2 SG |
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" | |
018d76dd KS |
30 | #include "gdbcore.h" |
31 | #include "tracepoint.h" | |
929db6e5 | 32 | #include "demangle.h" |
018d76dd KS |
33 | |
34 | #ifdef _WIN32 | |
35 | #include <winuser.h> | |
36 | #endif | |
37 | ||
e6e9507d EZ |
38 | #include <sys/stat.h> |
39 | ||
754e5da2 SG |
40 | #include <tcl.h> |
41 | #include <tk.h> | |
2476848a MH |
42 | #include <itcl.h> |
43 | #include <tix.h> | |
dd3dd918 | 44 | #include "guitcl.h" |
ca4e7e14 | 45 | #include "gdbtk.h" |
2476848a | 46 | |
018d76dd | 47 | /* start-sanitize-ide */ |
c98fe0c1 | 48 | #ifdef IDE |
2476848a MH |
49 | #include "event.h" |
50 | #include "idetcl.h" | |
018d76dd | 51 | #include "ilutk.h" |
2476848a | 52 | #endif |
c98fe0c1 | 53 | /* end-sanitize-ide */ |
2476848a | 54 | |
73d3dbd4 | 55 | #ifdef ANSI_PROTOTYPES |
85c613aa C |
56 | #include <stdarg.h> |
57 | #else | |
cd2df226 | 58 | #include <varargs.h> |
85c613aa | 59 | #endif |
cd2df226 SG |
60 | #include <signal.h> |
61 | #include <fcntl.h> | |
8532893d | 62 | #include <unistd.h> |
86db943c SG |
63 | #include <setjmp.h> |
64 | #include "top.h" | |
736a82e7 | 65 | #include <sys/ioctl.h> |
2b576293 | 66 | #include "gdb_string.h" |
09722039 | 67 | #include "dis-asm.h" |
6131622e SG |
68 | #include <stdio.h> |
69 | #include "gdbcmd.h" | |
736a82e7 | 70 | |
929db6e5 | 71 | #include "annotate.h" |
018d76dd | 72 | #include <sys/time.h> |
018d76dd | 73 | |
c98fe0c1 | 74 | #ifdef __CYGWIN32__ |
1798621b GN |
75 | #include <sys/cygwin.h> /* for cygwin32_attach_handle_to_fd */ |
76 | #endif | |
77 | ||
d836385e | 78 | /* For Cygwin, we use a timer to periodically check for Windows |
ca4e7e14 JI |
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; | |
8b3f9ed6 | 85 | |
c98fe0c1 JI |
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 | ||
94a6f14f MH |
97 | extern int Tktable_Init PARAMS ((Tcl_Interp *interp)); |
98 | ||
2476848a | 99 | static void gdbtk_init PARAMS ((char *)); |
ca4e7e14 | 100 | void gdbtk_interactive PARAMS ((void)); |
b607efe7 FF |
101 | static void cleanup_init PARAMS ((int)); |
102 | static void tk_command PARAMS ((char *, int)); | |
ca4e7e14 | 103 | |
6f5af15b | 104 | void gdbtk_add_hooks PARAMS ((void)); |
ca4e7e14 JI |
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 | ||
65b07ddc | 113 | extern void gdbtk_fputs PARAMS ((const char *, GDB_FILE *)); |
b607efe7 | 114 | |
754e5da2 | 115 | /* Handle for TCL interpreter */ |
7f6cb62e | 116 | Tcl_Interp *gdbtk_interp = NULL; |
754e5da2 | 117 | |
0776b0b0 | 118 | static int gdbtk_timer_going = 0; |
0776b0b0 | 119 | |
4ff5d55a MH |
120 | /* linked variable used to tell tcl what the current thread is */ |
121 | int gdb_context = 0; | |
122 | ||
ca4e7e14 JI |
123 | /* This variable is true when the inferior is running. See note in |
124 | * gdbtk.h for details. | |
125 | */ | |
ca4e7e14 | 126 | int running_now; |
fda6fadc | 127 | |
7f6cb62e KS |
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. */ | |
ca4e7e14 JI |
130 | static char *gdbtk_source_filename = NULL; |
131 | \f | |
9b119644 ILT |
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. */ | |
8c19daa1 SG |
137 | |
138 | char * | |
a5a6e3bd | 139 | Tcl_Alloc (size) |
8c19daa1 SG |
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 | ||
018d76dd | 160 | #endif /* ! _WIN32 */ |
9b119644 | 161 | |
018d76dd KS |
162 | #ifdef _WIN32 |
163 | ||
164 | /* On Windows, if we hold a file open, other programs can't write to | |
ca4e7e14 JI |
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 | */ | |
018d76dd | 170 | |
ca4e7e14 | 171 | void |
018d76dd KS |
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 | ||
754e5da2 | 188 | \f |
ca4e7e14 JI |
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 | */ | |
41756e56 | 193 | |
ca4e7e14 | 194 | void |
41756e56 | 195 | #ifdef ANSI_PROTOTYPES |
ca4e7e14 | 196 | TclDebug (const char *fmt, ...) |
41756e56 | 197 | #else |
ca4e7e14 | 198 | TclDebug (va_alist) |
41756e56 FF |
199 | va_dcl |
200 | #endif | |
201 | { | |
202 | va_list args; | |
ca4e7e14 | 203 | char buf[512], *v[2], *merge; |
41756e56 FF |
204 | |
205 | #ifdef ANSI_PROTOTYPES | |
ca4e7e14 | 206 | va_start (args, fmt); |
41756e56 | 207 | #else |
ca4e7e14 | 208 | char *fmt; |
41756e56 | 209 | va_start (args); |
ca4e7e14 | 210 | fmt = va_arg (args, char *); |
41756e56 FF |
211 | #endif |
212 | ||
ca4e7e14 JI |
213 | v[0] = "debug"; |
214 | v[1] = buf; | |
41756e56 | 215 | |
ca4e7e14 JI |
216 | vsprintf (buf, fmt, args); |
217 | va_end (args); | |
018d76dd | 218 | |
ca4e7e14 JI |
219 | merge = Tcl_Merge (2, v); |
220 | Tcl_Eval (gdbtk_interp, merge); | |
221 | Tcl_Free (merge); | |
41756e56 FF |
222 | } |
223 | ||
ca4e7e14 JI |
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 | ||
41756e56 | 234 | static void |
ca4e7e14 JI |
235 | cleanup_init (ignored) |
236 | int ignored; | |
41756e56 | 237 | { |
ca4e7e14 JI |
238 | if (gdbtk_interp != NULL) |
239 | Tcl_DeleteInterp (gdbtk_interp); | |
240 | gdbtk_interp = NULL; | |
41756e56 FF |
241 | } |
242 | ||
ca4e7e14 JI |
243 | /* Come here during long calculations to check for GUI events. Usually invoked |
244 | via the QUIT macro. */ | |
245 | ||
246 | void | |
247 | gdbtk_interactive () | |
929db6e5 | 248 | { |
ca4e7e14 | 249 | /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */ |
929db6e5 EZ |
250 | } |
251 | ||
ca4e7e14 JI |
252 | |
253 | void | |
254 | gdbtk_start_timer () | |
6131622e | 255 | { |
ca4e7e14 JI |
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); | |
85c613aa | 263 | |
ca4e7e14 JI |
264 | act1.sa_handler = x_event; |
265 | act1.sa_mask = nullsigmask; | |
266 | act1.sa_flags = 0; | |
6131622e | 267 | |
ca4e7e14 JI |
268 | act2.sa_handler = SIG_IGN; |
269 | act2.sa_mask = nullsigmask; | |
270 | act2.sa_flags = 0; | |
6131622e | 271 | |
ca4e7e14 JI |
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; | |
6131622e | 276 | |
ca4e7e14 JI |
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 | } | |
6131622e SG |
289 | } |
290 | ||
ca4e7e14 JI |
291 | void |
292 | gdbtk_stop_timer () | |
8a19b35a | 293 | { |
ca4e7e14 | 294 | if (gdbtk_timer_going) |
8a19b35a | 295 | { |
ca4e7e14 JI |
296 | gdbtk_timer_going = 0; |
297 | /*TclDebug ("Stopping timer.");*/ | |
298 | setitimer (ITIMER_REAL, &it_off, NULL); | |
299 | sigaction (SIGALRM, &act2, NULL); | |
8a19b35a | 300 | } |
8a19b35a MH |
301 | } |
302 | ||
ca4e7e14 | 303 | /* gdbtk_init installs this function as a final cleanup. */ |
6131622e | 304 | |
ca4e7e14 JI |
305 | static void |
306 | gdbtk_cleanup (dummy) | |
307 | PTR dummy; | |
308 | { | |
4d14b252 | 309 | Tcl_Eval (gdbtk_interp, "gdbtk_cleanup"); |
ca4e7e14 | 310 | #ifdef IDE |
1dd251f9 DM |
311 | { |
312 | struct ide_event_handle *h = (struct ide_event_handle *) dummy; | |
313 | ide_interface_deregister_all (h); | |
314 | } | |
ca4e7e14 JI |
315 | #endif |
316 | Tcl_Finalize (); | |
6131622e SG |
317 | } |
318 | ||
ca4e7e14 JI |
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 | ||
754e5da2 | 326 | static void |
ca4e7e14 JI |
327 | gdbtk_init ( argv0 ) |
328 | char *argv0; | |
754e5da2 | 329 | { |
ca4e7e14 | 330 | struct cleanup *old_chain; |
6f5af15b | 331 | int found_main; |
c98fe0c1 | 332 | char s[5]; |
ca4e7e14 | 333 | Tcl_Obj *auto_path_elem, *auto_path_name; |
6f5af15b | 334 | |
ca4e7e14 | 335 | /* start-sanitize-ide */ |
c98fe0c1 | 336 | #ifdef IDE |
ca4e7e14 JI |
337 | struct ide_event_handle *h; |
338 | const char *errmsg; | |
339 | char *libexecdir; | |
ca4e7e14 | 340 | #endif |
c98fe0c1 | 341 | /* end-sanitize-ide */ |
ca4e7e14 JI |
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. */ | |
754e5da2 | 346 | |
d836385e | 347 | #ifndef _WIN32 |
ca4e7e14 | 348 | if (getenv ("DISPLAY") == NULL) |
754e5da2 | 349 | return; |
ca4e7e14 | 350 | #endif |
754e5da2 | 351 | |
ad3b8c4a | 352 | old_chain = make_cleanup ((make_cleanup_func) cleanup_init, 0); |
929db6e5 | 353 | |
ca4e7e14 JI |
354 | /* First init tcl and tk. */ |
355 | Tcl_FindExecutable (argv0); | |
356 | gdbtk_interp = Tcl_CreateInterp (); | |
754e5da2 | 357 | |
ca4e7e14 JI |
358 | #ifdef TCL_MEM_DEBUG |
359 | Tcl_InitMemory (gdbtk_interp); | |
360 | #endif | |
754e5da2 | 361 | |
ca4e7e14 JI |
362 | if (!gdbtk_interp) |
363 | error ("Tcl_CreateInterp failed"); | |
754e5da2 | 364 | |
ca4e7e14 JI |
365 | if (Tcl_Init(gdbtk_interp) != TCL_OK) |
366 | error ("Tcl_Init failed: %s", gdbtk_interp->result); | |
754e5da2 | 367 | |
c98fe0c1 JI |
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 */ | |
ca4e7e14 | 374 | #ifndef IDE |
c98fe0c1 | 375 | /* end-sanitize-ide */ |
ca4e7e14 JI |
376 | /* For the IDE we register the cleanup later, after we've |
377 | initialized events. */ | |
378 | make_final_cleanup (gdbtk_cleanup, NULL); | |
c98fe0c1 JI |
379 | /* start-sanitize-ide */ |
380 | #endif /* IDE */ | |
381 | /* end-sanitize-ide */ | |
746d1df4 | 382 | |
ca4e7e14 | 383 | /* Initialize the Paths variable. */ |
c98fe0c1 | 384 | if (ide_initialize_paths (gdbtk_interp, "") != TCL_OK) |
ca4e7e14 | 385 | error ("ide_initialize_paths failed: %s", gdbtk_interp->result); |
746d1df4 | 386 | |
ca4e7e14 | 387 | /* start-sanitize-ide */ |
c98fe0c1 | 388 | #ifdef IDE |
ca4e7e14 JI |
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); | |
746d1df4 | 392 | |
ca4e7e14 | 393 | IluTk_Init (); |
929db6e5 | 394 | |
ca4e7e14 JI |
395 | h = ide_event_init_from_environment (&errmsg, libexecdir); |
396 | make_final_cleanup (gdbtk_cleanup, h); | |
397 | if (h == NULL) | |
746d1df4 | 398 | { |
ca4e7e14 JI |
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); | |
746d1df4 | 402 | |
ca4e7e14 | 403 | Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0); |
746d1df4 | 404 | } |
ca4e7e14 | 405 | else |
3d9f68c0 | 406 | { |
ca4e7e14 JI |
407 | if (ide_create_tclevent_command (gdbtk_interp, h) != TCL_OK) |
408 | error ("ide_create_tclevent_command failed: %s", gdbtk_interp->result); | |
0422b59e | 409 | |
ca4e7e14 JI |
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); | |
018d76dd | 415 | |
ca4e7e14 JI |
416 | if (ide_create_build_command (gdbtk_interp, h) != TCL_OK) |
417 | error ("ide_create_build_command failed: %s", gdbtk_interp->result); | |
754e5da2 | 418 | |
ca4e7e14 JI |
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); | |
fda6fadc | 423 | |
ca4e7e14 JI |
424 | if (ide_create_window_command (gdbtk_interp, h) != TCL_OK) |
425 | error ("ide_create_window_command failed: %s", gdbtk_interp->result); | |
0b7148e4 | 426 | |
ca4e7e14 JI |
427 | if (ide_create_exit_command (gdbtk_interp, h) != TCL_OK) |
428 | error ("ide_create_exit_command failed: %s", gdbtk_interp->result); | |
018d76dd | 429 | |
ca4e7e14 JI |
430 | if (ide_create_help_command (gdbtk_interp) != TCL_OK) |
431 | error ("ide_create_help_command failed: %s", gdbtk_interp->result); | |
018d76dd | 432 | |
ca4e7e14 JI |
433 | /* |
434 | if (ide_initialize (gdbtk_interp, "gdb") != TCL_OK) | |
435 | error ("ide_initialize failed: %s", gdbtk_interp->result); | |
436 | */ | |
479f0f18 | 437 | |
ca4e7e14 | 438 | Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "1", 0); |
7234efcb | 439 | } |
ca4e7e14 | 440 | #else |
c98fe0c1 | 441 | /* end-sanitize-ide */ |
ca4e7e14 | 442 | Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0); |
c98fe0c1 | 443 | /* start-sanitize-ide */ |
ca4e7e14 | 444 | #endif /* IDE */ |
c98fe0c1 | 445 | /* end-sanitize-ide */ |
0776b0b0 | 446 | |
ca4e7e14 JI |
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. */ | |
86db943c | 450 | |
ca4e7e14 JI |
451 | if (Tk_Init(gdbtk_interp) != TCL_OK) |
452 | error ("Tk_Init failed: %s", gdbtk_interp->result); | |
86db943c | 453 | |
ca4e7e14 JI |
454 | if (Itcl_Init(gdbtk_interp) == TCL_ERROR) |
455 | error ("Itcl_Init failed: %s", gdbtk_interp->result); | |
c98fe0c1 JI |
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, | |
ca4e7e14 | 462 | (Tcl_PackageInitProc *) NULL); |
09722039 | 463 | |
ca4e7e14 JI |
464 | if (Tix_Init(gdbtk_interp) != TCL_OK) |
465 | error ("Tix_Init failed: %s", gdbtk_interp->result); | |
c98fe0c1 | 466 | Tcl_StaticPackage(gdbtk_interp, "Tix", Tix_Init, |
ca4e7e14 | 467 | (Tcl_PackageInitProc *) NULL); |
86db943c | 468 | |
ca4e7e14 JI |
469 | if (Tktable_Init(gdbtk_interp) != TCL_OK) |
470 | error ("Tktable_Init failed: %s", gdbtk_interp->result); | |
929db6e5 | 471 | |
ca4e7e14 JI |
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 | */ | |
018d76dd | 477 | |
c98fe0c1 | 478 | #ifdef __CYGWIN32__ |
ca4e7e14 JI |
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"); | |
018d76dd | 486 | /* start-sanitize-ide */ |
ca4e7e14 JI |
487 | /* An interface to ShellExecute. */ |
488 | if (ide_create_shell_execute_command (gdbtk_interp) != TCL_OK) | |
489 | error ("shell execute command initialization failed"); | |
018d76dd | 490 | /* end-sanitize-ide */ |
ca4e7e14 JI |
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"); | |
40a7f1e9 MH |
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"); | |
ca4e7e14 | 500 | #endif |
018d76dd | 501 | |
ca4e7e14 JI |
502 | /* |
503 | * This adds all the Gdbtk commands. | |
504 | */ | |
505 | ||
506 | if (Gdbtk_Init(gdbtk_interp) != TCL_OK) | |
018d76dd | 507 | { |
ca4e7e14 | 508 | error("Gdbtk_Init failed: %s", gdbtk_interp->result); |
018d76dd | 509 | } |
4f17e6eb | 510 | |
ca4e7e14 JI |
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 | */ | |
e0f7db02 | 516 | |
ca4e7e14 JI |
517 | gdbtk_add_hooks(); |
518 | ||
519 | /* Add a back door to Tk from the gdb console... */ | |
e0f7db02 | 520 | |
ca4e7e14 JI |
521 | add_com ("tk", class_obscure, tk_command, |
522 | "Send a command directly into tk."); | |
6f5af15b | 523 | |
c98fe0c1 JI |
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); | |
e0f7db02 | 530 | |
c98fe0c1 | 531 | /* find the gdb tcl library and source main.tcl */ |
929db6e5 | 532 | |
c98fe0c1 JI |
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[] ="\ | |
ca4e7e14 | 545 | proc gdbtk_find_main {} {\n\ |
c98fe0c1 JI |
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\ | |
ca4e7e14 | 554 | }\n\ |
c98fe0c1 JI |
555 | tcl_findLibrary gdb 1.0 {} main.tcl GDBTK_LIBRARY GDBTK_LIBRARY gdbtcl2 gdbtcl {} $debug_startup\n\ |
556 | set Paths(appdir) $GDBTK_LIBRARY\n\ | |
ca4e7e14 JI |
557 | }\n\ |
558 | gdbtk_find_main"; | |
c98fe0c1 JI |
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 | if (Tcl_GlobalEval (gdbtk_interp, (char *) script) != TCL_OK) | |
574 | { | |
575 | char *msg; | |
576 | ||
577 | /* Force errorInfo to be set up propertly. */ | |
578 | Tcl_AddErrorInfo (gdbtk_interp, ""); | |
579 | ||
580 | msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY); | |
581 | ||
582 | fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */ | |
583 | ||
584 | #ifdef _WIN32 | |
585 | MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL); | |
586 | #else | |
587 | fputs_unfiltered (msg, gdb_stderr); | |
588 | #endif | |
589 | ||
590 | error (""); | |
591 | ||
592 | } | |
593 | } | |
11f91b2b | 594 | |
ca4e7e14 JI |
595 | /* Defer setup of fputs_unfiltered_hook to near the end so that error messages |
596 | prior to this point go to stdout/stderr. */ | |
929db6e5 | 597 | |
ca4e7e14 | 598 | fputs_unfiltered_hook = gdbtk_fputs; |
7f6cb62e | 599 | |
ca4e7e14 | 600 | /* start-sanitize-ide */ |
c98fe0c1 | 601 | #ifdef IDE |
ca4e7e14 JI |
602 | /* Don't do this until we have initialized. Otherwise, we may get a |
603 | run command before we are ready for one. */ | |
604 | if (ide_run_server_init (gdbtk_interp, h) != TCL_OK) | |
605 | error ("ide_run_server_init failed: %s", gdbtk_interp->result); | |
ca4e7e14 | 606 | #endif |
c98fe0c1 | 607 | /* end-sanitize-ide */ |
7f6cb62e | 608 | |
ca4e7e14 JI |
609 | /* Now source in the filename provided by the --tclcommand option. |
610 | This is mostly used for the gdbtk testsuite... */ | |
7f6cb62e | 611 | |
ca4e7e14 JI |
612 | if (gdbtk_source_filename != NULL) |
613 | { | |
614 | char *s = "after idle source "; | |
615 | char *script = concat (s, gdbtk_source_filename, (char *) NULL); | |
616 | Tcl_Eval (gdbtk_interp, script); | |
617 | free (gdbtk_source_filename); | |
618 | free (script); | |
619 | } | |
620 | ||
621 | ||
622 | discard_cleanups (old_chain); | |
7f6cb62e KS |
623 | } |
624 | ||
ca4e7e14 JI |
625 | /* gdbtk_test is used in main.c to validate the -tclcommand option to |
626 | gdb, which sources in a file of tcl code after idle during the | |
627 | startup procedure. */ | |
628 | ||
7f6cb62e KS |
629 | int |
630 | gdbtk_test (filename) | |
631 | char *filename; | |
632 | { | |
633 | if (access (filename, R_OK) != 0) | |
634 | return 0; | |
635 | else | |
636 | gdbtk_source_filename = xstrdup (filename); | |
637 | return 1; | |
638 | } | |
ca4e7e14 | 639 | |
3f37b696 | 640 | /* Come here during initialize_all_files () */ |
754e5da2 SG |
641 | |
642 | void | |
643 | _initialize_gdbtk () | |
644 | { | |
c5197511 SG |
645 | if (use_windows) |
646 | { | |
647 | /* Tell the rest of the world that Gdbtk is now set up. */ | |
754e5da2 | 648 | |
c5197511 | 649 | init_ui_hook = gdbtk_init; |
c98fe0c1 | 650 | #ifdef __CYGWIN32__ |
47792960 KS |
651 | (void) FreeConsole (); |
652 | #endif | |
c5197511 | 653 | } |
c98fe0c1 | 654 | #ifdef __CYGWIN32__ |
cb432079 EZ |
655 | else |
656 | { | |
657 | DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE)); | |
cb432079 EZ |
658 | |
659 | switch (ft) | |
660 | { | |
661 | case FILE_TYPE_DISK: | |
662 | case FILE_TYPE_CHAR: | |
663 | case FILE_TYPE_PIPE: | |
664 | break; | |
665 | default: | |
666 | AllocConsole(); | |
1798621b GN |
667 | cygwin32_attach_handle_to_fd ("/dev/conin", 0, |
668 | GetStdHandle (STD_INPUT_HANDLE), | |
669 | 1, GENERIC_READ); | |
670 | cygwin32_attach_handle_to_fd ("/dev/conout", 1, | |
671 | GetStdHandle (STD_OUTPUT_HANDLE), | |
672 | 0, GENERIC_WRITE); | |
673 | cygwin32_attach_handle_to_fd ("/dev/conout", 2, | |
674 | GetStdHandle (STD_ERROR_HANDLE), | |
675 | 0, GENERIC_WRITE); | |
cb432079 EZ |
676 | break; |
677 | } | |
678 | } | |
679 | #endif | |
754e5da2 | 680 | } |
ca4e7e14 JI |
681 | |
682 | static void | |
683 | tk_command (cmd, from_tty) | |
684 | char *cmd; | |
685 | int from_tty; | |
686 | { | |
687 | int retval; | |
688 | char *result; | |
689 | struct cleanup *old_chain; | |
690 | ||
691 | /* Catch case of no argument, since this will make the tcl interpreter dump core. */ | |
692 | if (cmd == NULL) | |
693 | error_no_arg ("tcl command to interpret"); | |
694 | ||
695 | retval = Tcl_Eval (gdbtk_interp, cmd); | |
696 | ||
697 | result = strdup (gdbtk_interp->result); | |
698 | ||
699 | old_chain = make_cleanup (free, result); | |
700 | ||
701 | if (retval != TCL_OK) | |
702 | error (result); | |
703 | ||
704 | printf_unfiltered ("%s\n", result); | |
705 | ||
706 | do_cleanups (old_chain); | |
707 | } | |
c98fe0c1 JI |
708 | \f |
709 | /* Local variables: */ | |
710 | /* change-log-default-name: "ChangeLog-gdbtk" */ | |
711 | /* End: */ | |
ca4e7e14 | 712 |