Tue Jun 9 15:27:09 1998 Jim Ingham <jingham@cygnus.com>

	* gdbtk.c: Added hooks to run gdbtk under the TclPro debugger.
	To do this, build gdbtk with:

	    make CFLAGS="-g -DTCLPRO_DEBUGGER"

	Then set the environment variable TCLPRO_DEBUG_DIR to point to
	wherever you have installed the TclPro debugger.  Finally, in
	the Alpha of the TclPro Debugger, you have to start up the
	TclPro Debugger BEFORE you start gdbtk.  Unfortunately, the
	debugger does not understand Itcl 1.5 style classes...
	* .Sanitize: Sanitize out references to the TclPro debugger,
	since it is not yet released.

diff --git a/gdb/.Sanitize b/gdb/.Sanitize
index f4b57704496d0caacf9ce11582c6666223a85b3a..163f702c5b69cf7ba37b1818b379cc1a3869456a 100644 (file)
--- a/gdb/.Sanitize
+++ b/gdb/.Sanitize
@@ -834,6 +834,42 @@ else
        done
 fi
 
+# This is a temporary measure to sanitize out references to the
+# startup code need by the TclPro debugger.  When that goes out
+# of alpha, we can remove this.
+
+if ( echo $* | grep keep\-tclpro > /dev/null ) ; then
+       for i in * ; do
+               if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then
+                       echo Keeping \"tclpro\" stuff in $i, but editing out sanitize lines...
+                       cp $i new
+                       sed -e '/start\-sanitize\-tclpro/d' -e '/end\-sanitize\-tclpro/d' < $i > new
+                       if [ -n "${safe}" -a ! -f .Recover/$i ] ; then
+                               echo Caching $i in .Recover...
+                               mv $i .Recover
+                       fi
+                       mv new $i
+               fi
+       done
+else
+       for i in * ; do
+               if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then
+                       if [ -n "${verbose}" ] ; then
+                               echo Removing traces of \"tclpro\" from $i...
+                       fi
+                       cp $i new
+                       sed '/start\-sanitize\-tclpro/,/end-\sanitize\-tclpro/d' < $i > new
+                       if [ -n "${safe}" -a ! -f .Recover/$i ] ; then
+                               if [ -n "${verbose}" ] ; then
+                                       echo Caching $i in .Recover...
+                               fi
+                               mv $i .Recover
+                       fi
+                       mv new $i
+               fi
+       done
+fi
+
 if ( echo $* | grep keep\-mswin > /dev/null ) ; then
        for i in * ; do
                if test ! -d $i && (grep sanitize-mswin $i > /dev/null) ; then

diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c
index 4718e155427cba7c92ef1ecf89d575768e4491e6..15e5ed1989b19c58152f3d7367de2826a4fbbba1 100644 (file)
--- a/gdb/gdbtk.c
+++ b/gdb/gdbtk.c
@@ -1338,17 +1338,16 @@ call_obj_wrapper (clientData, interp, objc, objv)
 
       running_now = 0;
       Tcl_Eval (interp, "gdbtk_tcl_idle");
-
-
-      /* if the error message is in RESULT instead of ERROR_STRING we copy it
-         back to ERROR_STRING and free RESULT */
-
-      if ((Tcl_DStringLength (&error_string) == 0) && (Tcl_DStringLength (&result) > 0))
-        {
-          Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result), Tcl_DStringLength (&result));
-          Tcl_DStringFree (&result);
-        }
-
+       /* if the error message is in RESULT instead of ERROR_STRING we copy it
+          back to ERROR_STRING and free RESULT */
+ 
+       if ((Tcl_DStringLength (&error_string) == 0) &&
+          (Tcl_DStringLength (&result) > 0))
+         {
+           Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result),
+                             Tcl_DStringLength (&result));
+           Tcl_DStringFree (&result);
+         }
     }
   
   /* do not suppress any errors -- a remote target could have errored */
@@ -2454,8 +2453,27 @@ gdbtk_find_main";
 
   fputs_unfiltered_hook = gdbtk_fputs;
 
-  if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
-    {
+/* start-sanitize-tclpro */
+#ifdef TCLPRO_DEBUGGER
+  {
+    Tcl_DString source_cmd;
+
+    Tcl_DStringInit (&source_cmd);
+    Tcl_DStringAppend (&source_cmd,
+                     "if {[info exists env(TCLPRO_DEBUG_DIR)]} {source [file join $env(TCLPRO_DEBUG_DIR) src loader.tcl];", -1);
+    Tcl_DStringAppend (&source_cmd, "debugger_init; debugger_eval {source {", -1);
+    Tcl_DStringAppend (&source_cmd, gdbtk_file, -1);
+    Tcl_DStringAppend (&source_cmd, "}}} else {source {", -1);
+    Tcl_DStringAppend (&source_cmd, gdbtk_file, -1);
+    Tcl_DStringAppend (&source_cmd, "}}", -1);
+    if (Tcl_GlobalEval (interp, Tcl_DStringValue (&source_cmd)) != TCL_OK)
+#else
+/* end-sanitize-tclpro */
+      if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
+/* start-sanitize-tclpro */
+#endif
+/* end-sanitize-tclpro */
+       {
       char *msg;
 
       /* Force errorInfo to be set up propertly.  */
@@ -2473,7 +2491,13 @@ gdbtk_find_main";
 
       error ("");
     }
-
+/* start-sanitize-tclpro */
+#ifdef TCLPRO_DEBUGGER
+      Tcl_DStringFree(&source_cmd);
+    }
+#endif
+/* end-sanitize-tclpro */
+  
 #ifdef IDE
   /* start-sanitize-ide */
   /* Don't do this until we have initialized.  Otherwise, we may get a