[Patch 3124554]: Move WishPanic from Tk to Tcl

Better communication with debugger, if present.

3 files changed, 42 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index bb01061..b6f04b4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,9 @@
-2010-12-14  Jan Nijtmans  <nijtmans@users.sf.net>
+2010-12-16  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* generic/tclPanic.c:  [Patch 3124554]: Move WishPanic from Tk to Tcl
+	* win/tclWinFile.c:    Better communication with debugger, if present.
+
+2010-12-15  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclPanic.c:    Restore abort() as it was before.
 	* win/tclWinFile.c:      [Patch 3124554] use ExitProcess() here, like
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index d5d6142..6ef39e1 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -12,10 +12,16 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPanic.c,v 1.17 2010/12/15 14:03:52 nijtmans Exp $
+ * RCS: @(#) $Id: tclPanic.c,v 1.18 2010/12/16 08:52:37 nijtmans Exp $
  */
 
 #include "tclInt.h"
+#ifdef _WIN32
+#   ifdef _MSC_VER
+#	include <intrin.h>
+#   endif
+    MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
+#endif
 
 /*
  * The panicProc variable contains a pointer to an application specific panic
@@ -44,6 +50,10 @@ void
 Tcl_SetPanicProc(
     Tcl_PanicProc *proc)
 {
+#ifdef _WIN32
+    /* tclWinDebugPanic only installs if there is no panicProc yet. */
+    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#endif
     panicProc = proc;
 }
 
@@ -84,6 +94,10 @@ Tcl_PanicVA(
 
     if (panicProc != NULL) {
 	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#ifdef _WIN32
+    } else if (IsDebuggerPresent()) {
+	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#endif
     } else {
 	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 		arg8);
@@ -91,7 +105,16 @@ Tcl_PanicVA(
 	fflush(stderr);
     }
     /* In case the users panic proc does not abort, we do it here */
+#ifdef _WIN32
+#   ifdef __GNUC__
+    __builtin_trap();
+#   elif _MSC_VER
+    __debugbreak();
+#   endif
+    ExitProcess(1);
+#else
     abort();
+#endif
 }
 
 /*
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 48ce2d0..1e1fe90 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.118 2010/12/15 14:03:52 nijtmans Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.119 2010/12/16 08:52:37 nijtmans Exp $
  */
 
 #include "tclWinInt.h"
@@ -175,6 +175,7 @@ static int		WinLink(const TCHAR *LinkSource,
 			    const TCHAR *LinkTarget, int linkAction);
 static int		WinSymLinkDirectory(const TCHAR *LinkDirectory,
 			    const TCHAR *LinkTarget);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
 
 /*
  *--------------------------------------------------------------------
@@ -786,9 +787,10 @@ NativeWriteReparse(
 /*
  *----------------------------------------------------------------------
  *
- * WishPanic --
+ * tclWinDebugPanic --
  *
- *	Display a message.
+ *	Display a message. If a debugger is present, present it directly
+ *  to the debugger, otherwise use a MessageBox.
  *
  * Results:
  *	None.
@@ -799,8 +801,8 @@ NativeWriteReparse(
  *----------------------------------------------------------------------
  */
 
-static void
-PanicMessageBox(
+void
+tclWinDebugPanic(
     const char *format, ...)
 {
 #define TCL_MAX_WARN_LEN 1024
@@ -820,17 +822,13 @@ PanicMessageBox(
     if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
 		memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
 	}
+    if (IsDebuggerPresent()) {
+	OutputDebugStringW(msgString);
+    } else {
     MessageBeep(MB_ICONEXCLAMATION);
     MessageBoxW(NULL, msgString, L"Fatal Error",
 	    MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
-	/* try to trigger the debugger */
-#   ifdef __GNUC__
-	__builtin_trap();
-#   endif
-#   ifdef _MSC_VER
-	DebugBreak();
-#   endif
-	ExitProcess(1);
+	}
 }
 
 /*
@@ -862,7 +860,7 @@ TclpFindExecutable(
      * create this process. Only if it is NULL, install a new panic handler.
      */
     if (argv0 == NULL) {
-	Tcl_SetPanicProc(PanicMessageBox);
+	Tcl_SetPanicProc(tclWinDebugPanic);
     }
 
 #ifdef UNICODE