Better Windows console panic proc, still to be TIPped.

7 files changed, 114 insertions, 16 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 4de18f0..73229b1 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2395,6 +2395,11 @@ const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
 			    int exact);
 const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 			    const char *version, int epoch, int revision);
+#ifdef _WIN32
+void Tcl_ConsolePanic(const char *format, ...);
+#else
+#define Tcl_ConsolePanic NULL
+#endif
 
 /*
  * When not using stubs, make it a macro.
@@ -2415,7 +2420,8 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    (Tcl_SetPanicProc(Tcl_ConsolePanic), \
+			Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b87a8df..a95b9c9 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -23,11 +23,7 @@
  * procedure.
  */
 
-#if defined(__CYGWIN__)
-static Tcl_PanicProc *panicProc = tclWinDebugPanic;
-#else
 static Tcl_PanicProc *panicProc = NULL;
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -49,10 +45,6 @@ void
 Tcl_SetPanicProc(
     Tcl_PanicProc *proc)
 {
-#if defined(_WIN32)
-    /* tclWinDebugPanic only installs if there is no panicProc yet. */
-    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
-#endif
     panicProc = proc;
 }
 
@@ -93,15 +85,15 @@ 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 {
+#if defined(_WIN32) || defined(__CYGWIN__)
+	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#else
 	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 		arg8);
 	fprintf(stderr, "\n");
 	fflush(stderr);
+#endif
 #if defined(_WIN32) || defined(__CYGWIN__)
 #   if defined(__GNUC__)
 	__builtin_trap();
diff --git a/win/Makefile.in b/win/Makefile.in
index 99009b9..2942da4 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -384,7 +384,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
 STUB_OBJS = \
 	tclStubLib.$(OBJEXT) \
 	tclTomMathStubLib.$(OBJEXT) \
-	tclOOStubLib.$(OBJEXT)
+	tclOOStubLib.$(OBJEXT) \
+	tclWinPanic.$(OBJEXT)
 
 TCLSH_OBJS = tclAppInit.$(OBJEXT)
 
@@ -519,6 +520,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
 tclOOStubLib.${OBJEXT}: tclOOStubLib.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
+tclWinPanic.${OBJEXT}: tclWinPanic.c
+	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
 # Implicit rule for all object files that will end up in the Tcl library
 
 %.${OBJEXT}: %.c
diff --git a/win/makefile.bc b/win/makefile.bc
index 18bfa28..b5f388c 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -278,7 +278,8 @@ TCLOBJS	= \
 TCLSTUBOBJS	= \
 	$(TMPDIR)\tclStubLib.obj \
 	$(TMPDIR)\tclTomMathStubLib.obj \
-	$(TMPDIR)\tclOOStubLib.obj
+	$(TMPDIR)\tclOOStubLib.obj \
+	$(TMPDIR)\tclWinPanic.obj
 
 WINDIR		= $(ROOT)\win
 GENERICDIR	= $(ROOT)\generic
@@ -532,6 +533,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
 $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
 
+$(TMPDIR)\tclWinPanic.obj : $(GENERICDIR)\tclWinPanic.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
 
 # Dedependency rules
 
diff --git a/win/makefile.vc b/win/makefile.vc
index 2784140..e4f064e 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -449,7 +449,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
 TCLSTUBOBJS = \
 	$(TMP_DIR)\tclStubLib.obj \
 	$(TMP_DIR)\tclTomMathStubLib.obj \
-	$(TMP_DIR)\tclOOStubLib.obj
+	$(TMP_DIR)\tclOOStubLib.obj \
+	$(TMP_DIR)\tclWinPanic.obj
 
 ### The following paths CANNOT have spaces in them.
 COMPATDIR	= $(ROOT)\compat
@@ -983,6 +984,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
 $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
+$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c
+	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
 #---------------------------------------------------------------------
 # Generate the source dependencies.  Having dependency rules will
 # improve incremental build accuracy without having to resort to a
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 57ec6bf..5880d09 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclOOStubLib.c
 # End Source File
 # Begin Source File
 
+SOURCE=..\generic\tclWinPanic.c
+# End Source File
+# Begin Source File
+
 SOURCE=..\generic\tclTomMathStubLib.c
 # End Source File
 # Begin Source File
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
new file mode 100644
index 0000000..266625c
--- /dev/null
+++ b/win/tclWinPanic.c
@@ -0,0 +1,84 @@
+/*
+ * tclWinPanic.c --
+ *
+ *	Contains the Windows-specific command-line panic proc.
+ *
+ * Copyright (c) 2013 by Jan Nijtmans.
+ * All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConsolePanic --
+ *
+ *	Display a message. If a debugger is present, present it directly to
+ *	the debugger, otherwise send it to stderr.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConsolePanic(
+    const char *format, ...)
+{
+#define TCL_MAX_WARN_LEN 1024
+    DWORD dummy;
+    va_list argList;
+    WCHAR msgString[TCL_MAX_WARN_LEN];
+    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
+
+    va_start(argList, format);
+    _vsnprintf(buf+3, sizeof(buf)-3, format, argList);
+    buf[sizeof(buf)-1] = 0;
+    msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+    MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN);
+
+    /*
+     * Truncate MessageBox string if it is too long to not overflow the buffer.
+     */
+
+    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 if (_isatty(2)) {
+	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+    } else {
+	buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+	WriteFile(handle, buf, strlen(buf), &dummy, 0);
+	FlushFileBuffers(handle);
+    }
+#if defined(__GNUC__)
+    __builtin_trap();
+#elif defined(_WIN64)
+    __debugbreak();
+#elif defined(_MSC_VER)
+    _asm {int 3}
+#else
+    DebugBreak();
+#endif
+    ExitProcess(1);
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */