Fri Nov 13 00:15:08 1998 Geoffrey Noer <noer@cygnus.com>
[external/binutils.git] / gdb / gdbtk-hooks.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 int in_fputs = 0;
75
76 extern int  (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
77 extern void (*pre_add_symbol_hook) PARAMS ((char *));
78 extern void (*post_add_symbol_hook) PARAMS ((void));
79 extern void (*selected_frame_level_changed_hook) PARAMS ((int));
80 #ifdef __CYGWIN__
81 extern void (*ui_loop_hook) PARAMS ((int));
82 #endif
83
84 static void   gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
85 static void   gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
86 static void   gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
87 static void   gdbtk_trace_find  PARAMS ((char *arg, int from_tty));
88 static void   gdbtk_trace_start_stop PARAMS ((int, int));
89 static void   gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
90 static void   gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
91 static void   gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
92 static void   gdbtk_file_changed PARAMS ((char *));
93 static void   gdbtk_exec_file_display PARAMS ((char *));
94 static void   tk_command_loop PARAMS ((void));
95 static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
96 static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
97        void   x_event PARAMS ((int));
98 static int    gdbtk_query PARAMS ((const char *, va_list));
99 static void   gdbtk_warning PARAMS ((const char *, va_list));
100 void   gdbtk_ignorable_warning PARAMS ((const char *));
101 static char*  gdbtk_readline PARAMS ((char *));
102 static void
103 #ifdef ANSI_PROTOTYPES
104 gdbtk_readline_begin (char *format, ...);
105 #else
106 gdbtk_readline_begin ();
107 #endif
108 static void gdbtk_readline_end PARAMS ((void));
109 static void   gdbtk_flush PARAMS ((FILE *));
110 static void gdbtk_pre_add_symbol PARAMS ((char *));
111 static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
112 static void gdbtk_post_add_symbol PARAMS ((void));
113 static void pc_changed PARAMS ((void));
114 static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
115 static void gdbtk_selected_frame_changed PARAMS ((int));
116 static void gdbtk_context_change PARAMS ((int));
117
118 /*
119  * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
120  * See note there for details.
121  */
122
123 void   gdbtk_fputs PARAMS ((const char *, FILE *));
124 int           gdbtk_load_hash PARAMS ((char *, unsigned long));
125 static void   breakpoint_notify PARAMS ((struct breakpoint *, const char *));
126
127 /*
128  * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
129  * startup code to fill in the hooks needed by core gdb.
130  */
131
132 void
133 gdbtk_add_hooks(void)
134 {
135   command_loop_hook = tk_command_loop;
136   call_command_hook = gdbtk_call_command;
137   readline_begin_hook = gdbtk_readline_begin;
138   readline_hook = gdbtk_readline;
139   readline_end_hook = gdbtk_readline_end;
140
141   print_frame_info_listing_hook = gdbtk_print_frame_info;
142   query_hook = gdbtk_query;
143   warning_hook = gdbtk_warning;
144   flush_hook = gdbtk_flush;
145
146   create_breakpoint_hook = gdbtk_create_breakpoint;
147   delete_breakpoint_hook = gdbtk_delete_breakpoint;
148   modify_breakpoint_hook = gdbtk_modify_breakpoint;
149
150   interactive_hook       = gdbtk_interactive;
151   target_wait_hook       = gdbtk_wait;
152   ui_load_progress_hook  = gdbtk_load_hash;
153
154 #ifdef __CYGWIN__
155   ui_loop_hook = x_event;
156 #endif
157   pre_add_symbol_hook    = gdbtk_pre_add_symbol;
158   post_add_symbol_hook   = gdbtk_post_add_symbol;
159   file_changed_hook      = gdbtk_file_changed;
160   exec_file_display_hook = gdbtk_exec_file_display;
161
162   create_tracepoint_hook = gdbtk_create_tracepoint;
163   delete_tracepoint_hook = gdbtk_delete_tracepoint;
164   modify_tracepoint_hook = gdbtk_modify_tracepoint;
165   trace_find_hook        = gdbtk_trace_find;
166   trace_start_stop_hook  = gdbtk_trace_start_stop;
167   pc_changed_hook = pc_changed;
168   selected_frame_level_changed_hook = gdbtk_selected_frame_changed;
169   context_hook = gdbtk_context_change;
170 }
171
172 /* These control where to put the gdb output which is created by
173    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
174    lowest level of these routines and capture all output from the rest of GDB.
175
176    The reason to use the result_ptr rather than the gdbtk_interp's result
177    directly is so that a call_wrapper invoked function can preserve its result
178    across calls into Tcl which might be made in the course of the function's
179    execution.
180    
181    * result_ptr->obj_ptr is where to accumulate the result.
182    * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
183      instead of to the result_ptr.
184    * GDBTK_MAKES_LIST flag means add to the result as a list element.
185
186    */
187
188 gdbtk_result *result_ptr = NULL;
189 \f
190
191 /* This allows you to Tcl_Eval a tcl command which takes
192    a command word, and then a single argument. */
193   
194 int gdbtk_two_elem_cmd (cmd_name, argv1)
195     char *cmd_name;
196     char * argv1;
197 {
198   char *command;
199   int result, flags_ptr, arg_len, cmd_len;
200
201   arg_len = Tcl_ScanElement (argv1, &flags_ptr);
202   cmd_len = strlen (cmd_name);
203   command = malloc(arg_len + cmd_len + 2);
204   strcpy (command, cmd_name);
205   strcat (command, " ");
206   
207   Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
208
209   result = Tcl_Eval (gdbtk_interp, command);
210   free (command);
211   return result;
212   
213 }
214
215 static void
216 gdbtk_flush (stream)
217      FILE *stream;
218 {
219 #if 0
220   /* Force immediate screen update */
221
222   Tcl_VarEval (gdbtk_interp, "gdbtk_tcl_flush", NULL);
223 #endif
224 }
225
226 /* This handles all the output from gdb.  All the gdb printf_xxx functions
227  * eventually end up here.  The output is either passed to the result_ptr
228  * where it will go to the result of some gdbtk command, or passed to the
229  * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
230  * window.
231  *
232  * The cases are:
233  *
234  * 1) result_ptr == NULL - This happens when some output comes from gdb which
235  *    is not generated by a command in gdbtk-cmds, usually startup stuff.
236  *    In this case we just route the data to gdbtk_tcl_fputs.
237  * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
238  *    We place the data into the result_ptr, either as a string,
239  *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
240  * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
241  *    UNLESS it was coming to stderr.  Then we place it in the result_ptr
242  *    anyway, so it can be dealt with.
243  *
244  */
245
246 void
247 gdbtk_fputs (ptr, stream)
248      const char *ptr;
249      FILE *stream;
250 {
251   in_fputs = 1;
252
253   if (result_ptr != NULL)
254     {
255       if (result_ptr->flags & GDBTK_TO_RESULT)
256         {
257           if (result_ptr->flags & GDBTK_MAKES_LIST)
258             Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr, 
259                                      Tcl_NewStringObj((char *) ptr, -1));
260           else                           
261             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
262         }
263       else if (stream == gdb_stderr)
264         {
265           if (result_ptr->flags & GDBTK_ERROR_STARTED)
266             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
267           else
268             {
269               Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
270               result_ptr->flags |= GDBTK_ERROR_STARTED;
271             }
272         }
273       else
274         {
275           gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
276           if (result_ptr->flags & GDBTK_MAKES_LIST)
277               gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
278         }
279     }
280   else
281     {
282       gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
283     }
284   
285   in_fputs = 0;
286 }
287
288 /*
289  * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
290  */
291
292 static void
293 gdbtk_warning (warning, args)
294      const char *warning;
295      va_list args;
296 {
297   char buf[200];
298
299   vsprintf (buf, warning, args);
300   gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
301
302 }
303
304 /*
305  * This routes all ignorable warnings to the Tcl function
306  * "gdbtk_tcl_ignorable_warning".
307  */
308
309 void
310 gdbtk_ignorable_warning (warning)
311      const char *warning;
312 {
313   char buf[512];
314   sprintf (buf, warning);
315   gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf);
316 }
317
318 static void
319 pc_changed()
320 {
321   Tcl_Eval (gdbtk_interp, "gdbtk_pc_changed");
322 }
323
324 \f
325 /* This function is called instead of gdb's internal command loop.  This is the
326    last chance to do anything before entering the main Tk event loop. 
327    At the end of the command, we enter the main loop. */
328
329 static void
330 tk_command_loop ()
331 {
332   extern GDB_FILE *instream;
333
334   /* We no longer want to use stdin as the command input stream */
335   instream = NULL;
336
337   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
338     {
339       char *msg;
340
341       /* Force errorInfo to be set up propertly.  */
342       Tcl_AddErrorInfo (gdbtk_interp, "");
343
344       msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
345 #ifdef _WIN32
346       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
347 #else
348       fputs_unfiltered (msg, gdb_stderr);
349 #endif
350     }
351
352 #ifdef _WIN32
353   close_bfds ();
354 #endif
355
356   Tk_MainLoop ();
357 }
358
359 /* Come here when there is activity on the X file descriptor. */
360
361 void
362 x_event (signo)
363      int signo;
364 {
365   static int in_x_event = 0;
366   static Tcl_Obj *varname = NULL;
367   if (in_x_event || in_fputs)
368     return; 
369
370   in_x_event = 1;
371
372 #ifdef __CYGWIN__
373   if (signo == -2)
374     gdbtk_stop_timer ();
375 #endif
376
377   /* Process pending events */
378   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
379     ;
380
381   if (load_in_progress)
382     {
383       int val;
384       if (varname == NULL)
385         {
386           Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
387           varname = Tcl_ObjGetVar2(gdbtk_interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
388         }
389       if ((Tcl_GetIntFromObj(gdbtk_interp,varname,&val) == TCL_OK) && val)
390         {
391           quit_flag = 1;
392 #ifdef REQUEST_QUIT
393           REQUEST_QUIT;
394 #else
395           if (immediate_quit) 
396             quit ();
397 #endif
398         }
399     }
400   in_x_event = 0;
401 }
402
403 /* VARARGS */
404 static void
405 #ifdef ANSI_PROTOTYPES
406 gdbtk_readline_begin (char *format, ...)
407 #else
408 gdbtk_readline_begin (va_alist)
409      va_dcl
410 #endif
411 {
412   va_list args;
413   char buf[200];
414
415 #ifdef ANSI_PROTOTYPES
416   va_start (args, format);
417 #else
418   char *format;
419   va_start (args);
420   format = va_arg (args, char *);
421 #endif
422
423   vsprintf (buf, format, args);
424   gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
425
426 }
427
428 static char *
429 gdbtk_readline (prompt)
430      char *prompt;
431 {
432   int result;
433
434 #ifdef _WIN32
435   close_bfds ();
436 #endif
437
438   result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
439
440   if (result == TCL_OK)
441     {
442       return (strdup (gdbtk_interp -> result));
443     }
444   else
445     {
446       gdbtk_fputs (gdbtk_interp -> result, gdb_stdout);
447       gdbtk_fputs ("\n", gdb_stdout);
448       return (NULL);
449     }
450 }
451
452 static void
453 gdbtk_readline_end ()
454 {
455   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end");
456 }
457
458 static void
459 gdbtk_call_command (cmdblk, arg, from_tty)
460      struct cmd_list_element *cmdblk;
461      char *arg;
462      int from_tty;
463 {
464   running_now = 0;
465   if (cmdblk->class == class_run || cmdblk->class == class_trace)
466     {
467
468       running_now = 1;
469       if (!No_Update)
470         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
471       (*cmdblk->function.cfunc)(arg, from_tty);
472       running_now = 0;
473       if (!No_Update)
474         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
475     }
476   else
477     (*cmdblk->function.cfunc)(arg, from_tty);
478 }
479
480 /* The next three functions use breakpoint_notify to allow the GUI 
481  * to handle creating, deleting and modifying breakpoints.  These three
482  * functions are put into the appropriate gdb hooks in gdbtk_init.
483  */
484
485 static void
486 gdbtk_create_breakpoint(b)
487      struct breakpoint *b;
488 {
489   breakpoint_notify (b, "create");
490 }
491
492 static void
493 gdbtk_delete_breakpoint(b)
494      struct breakpoint *b;
495 {
496   breakpoint_notify (b, "delete");
497 }
498
499 static void
500 gdbtk_modify_breakpoint(b)
501      struct breakpoint *b;
502 {
503   breakpoint_notify (b, "modify");
504 }
505
506 /* This is the generic function for handling changes in
507  * a breakpoint.  It routes the information to the Tcl
508  * command "gdbtk_tcl_breakpoint" in the form:
509  *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
510  * On error, the error string is written to gdb_stdout.
511  */
512
513 static void
514 breakpoint_notify(b, action)
515      struct breakpoint *b;
516      const char *action;
517 {
518   char buf[256];
519   int v;
520   struct symtab_and_line sal;
521   char *filename;
522
523   if (b->type != bp_breakpoint)
524     return;
525
526   /* We ensure that ACTION contains no special Tcl characters, so we
527      can do this.  */
528   sal = find_pc_line (b->address, 0);
529   filename = symtab_to_filename (sal.symtab);
530   if (filename == NULL)
531     filename = "";
532
533   sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s} {%s} %d %d",
534            action, b->number, (long)b->address, b->line_number, filename,
535            bpdisp[b->disposition], b->enable,  b->thread);
536
537   v = Tcl_Eval (gdbtk_interp, buf);
538
539   if (v != TCL_OK)
540     {
541       gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp), gdb_stdout);
542       gdbtk_fputs ("\n", gdb_stdout);
543     }
544 }
545
546 int
547 gdbtk_load_hash (section, num)
548      char *section;
549      unsigned long num;
550 {
551   char buf[128];
552   sprintf (buf, "download_hash %s %ld", section, num);
553   Tcl_Eval (gdbtk_interp, buf); 
554   return  atoi (gdbtk_interp->result);
555 }
556
557
558 /* This hook is called whenever we are ready to load a symbol file so that
559    the UI can notify the user... */
560 static void
561 gdbtk_pre_add_symbol (name)
562   char *name;
563 {
564
565   gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name);
566
567 }
568
569 /* This hook is called whenever we finish loading a symbol file. */
570 static void
571 gdbtk_post_add_symbol ()
572 {
573   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol");
574 }
575
576 /* This hook function is called whenever we want to wait for the
577    target.  */
578
579 static int
580 gdbtk_wait (pid, ourstatus)
581      int pid;
582      struct target_waitstatus *ourstatus;
583 {
584   /* Don't run the timer on various targets... */
585   if (!STREQ (target_shortname, "ice"))
586     gdbtk_start_timer ();
587   pid = target_wait (pid, ourstatus);
588   gdbtk_stop_timer ();
589   return pid;
590 }
591
592 /*
593  * This handles all queries from gdb.
594  * The first argument is a printf style format statement, the rest are its
595  * arguments.  The resultant formatted string is passed to the Tcl function
596  * "gdbtk_tcl_query".  
597  * It returns the users response to the query, as well as putting the value
598  * in the result field of the Tcl interpreter.
599  */
600
601 static int
602 gdbtk_query (query, args)
603      const char *query;
604      va_list args;
605 {
606   char buf[200];
607   long val;
608
609   vsprintf (buf, query, args);
610   gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
611  
612   val = atol (gdbtk_interp->result);
613   return val;
614 }
615
616
617 static void
618 gdbtk_print_frame_info (s, line, stopline, noerror)
619   struct symtab *s;
620   int line;
621   int stopline;
622   int noerror;
623 {
624   current_source_symtab = s;
625   current_source_line = line;
626 }
627
628 static void
629 gdbtk_create_tracepoint (tp)
630   struct tracepoint *tp;
631 {
632   tracepoint_notify (tp, "create");
633 }
634
635 static void
636 gdbtk_delete_tracepoint (tp)
637   struct tracepoint *tp;
638 {
639   tracepoint_notify (tp, "delete");
640 }
641
642 static void
643 gdbtk_modify_tracepoint (tp)
644   struct tracepoint *tp;
645 {
646   tracepoint_notify (tp, "modify");
647 }
648
649 static void
650 tracepoint_notify(tp, action)
651      struct tracepoint *tp;
652      const char *action;
653 {
654   char buf[256];
655   int v;
656   struct symtab_and_line sal;
657   char *filename;
658
659   /* We ensure that ACTION contains no special Tcl characters, so we
660      can do this.  */
661   sal = find_pc_line (tp->address, 0);
662
663   filename = symtab_to_filename (sal.symtab);
664   if (filename == NULL)
665     filename = "N/A";
666   sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s} %d", action, tp->number, 
667            (long)tp->address, sal.line, filename, tp->pass_count);
668
669   v = Tcl_Eval (gdbtk_interp, buf);
670
671   if (v != TCL_OK)
672     {
673       gdbtk_fputs (gdbtk_interp->result, gdb_stdout);
674       gdbtk_fputs ("\n", gdb_stdout);
675     }
676 }
677
678 /*
679  * gdbtk_trace_find
680  *
681  * This is run by the trace_find_command.  arg is the argument that was passed
682  * to that command, from_tty is 1 if the command was run from a tty, 0 if it
683  * was run from a script.  It runs gdbtk_tcl_tfind_hook passing on these two
684  * arguments.
685  *
686  */
687
688 static void
689 gdbtk_trace_find (arg, from_tty)
690      char *arg;
691      int from_tty;
692 {
693   Tcl_Obj *cmdObj;
694   
695   if (from_tty) {
696     Tcl_GlobalEval (gdbtk_interp, "debug {*** In gdbtk_trace_find, from_tty is true}");
697     cmdObj = Tcl_NewListObj (0, NULL);
698     Tcl_ListObjAppendElement (gdbtk_interp, cmdObj,
699                               Tcl_NewStringObj ("gdbtk_tcl_trace_find_hook", -1));
700     Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewStringObj (arg, -1));
701     Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewIntObj(from_tty));
702     Tcl_GlobalEvalObj (gdbtk_interp, cmdObj);
703   } else {
704     Tcl_GlobalEval (gdbtk_interp, "debug {*** In gdbtk_trace_find, from_tty is false}");
705   }
706 }
707
708 /*
709  * gdbtk_trace_start_stop
710  *
711  * This is run by the trace_start_command and trace_stop_command.
712  * The START variable determines which, 1 meaning trace_start was run,
713  * 0 meaning trace_stop was run.
714  *
715  */
716
717 static void
718 gdbtk_trace_start_stop (start, from_tty)
719      int start;
720      int from_tty;
721 {
722   Tcl_Obj *cmdObj;
723   
724   if (from_tty) {
725     Tcl_GlobalEval (gdbtk_interp, "debug {*** In gdbtk_trace_start, from_tty is true}");
726     cmdObj = Tcl_NewListObj (0, NULL);
727     if (start)
728       Tcl_ListObjAppendElement (gdbtk_interp, cmdObj,
729                                 Tcl_NewStringObj ("gdbtk_tcl_tstart", -1));
730     else
731       Tcl_ListObjAppendElement (gdbtk_interp, cmdObj,
732                                 Tcl_NewStringObj ("gdbtk_tcl_tstop", -1));
733     Tcl_GlobalEvalObj (gdbtk_interp, cmdObj);
734   } else {
735     Tcl_GlobalEval (gdbtk_interp, "debug {*** In gdbtk_trace_startd, from_tty is false}");
736   }
737
738 }
739
740 static void
741 gdbtk_selected_frame_changed (level)
742      int level;
743 {
744   Tcl_UpdateLinkedVar (gdbtk_interp, "gdb_selected_frame_level");
745 }
746
747 /* Called when the current thread changes. */
748 /* gdb_context is linked to the tcl variable "gdb_context_id" */
749 static void
750 gdbtk_context_change (num)
751      int num;
752 {
753   gdb_context = num;
754 }
755
756 /* Called from file_command */
757 static void
758 gdbtk_file_changed (filename)
759      char *filename;
760 {
761   gdbtk_two_elem_cmd ("gdbtk_tcl_file_changed", filename);
762 }
763
764 /* Called from exec_file_command */
765 static void
766 gdbtk_exec_file_display (filename)
767      char *filename;
768 {
769   gdbtk_two_elem_cmd ("gdbtk_tcl_exec_file_display", filename);
770 }