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