summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/Panic.313
-rw-r--r--generic/tcl.h7
-rw-r--r--[-rwxr-xr-x]library/clock.tcl0
-rw-r--r--win/Makefile.in6
-rw-r--r--win/makefile.bc6
-rw-r--r--win/makefile.vc6
-rw-r--r--win/tcl.dsp4
-rw-r--r--[-rwxr-xr-x]win/tclWinFile.c0
-rw-r--r--win/tclWinPanic.c99
9 files changed, 136 insertions, 5 deletions
diff --git a/doc/Panic.3 b/doc/Panic.3
index 28d56fa..14204c3 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -7,7 +7,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
+Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,6 +21,9 @@ void
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
+void
+\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
@@ -54,6 +57,14 @@ message is sent to the debugger in stead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
+If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
+and you want to implicitly use the stderr channel of your
+application's C runtime (in stead of the stderr channel of the
+C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
+with \fBTcl_ConsolePanic\fR as its argument. On platforms which
+only have one C runtime (almost all platforms except Windows
+and Cygwin) \fBTcl_ConsolePanic\fR is equivalent to NULL.
+.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
diff --git a/generic/tcl.h b/generic/tcl.h
index 1f7b5cb..f5e0d26 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2398,6 +2398,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);
+#if defined(_WIN32)
+ void Tcl_ConsolePanic(const char *format, ...);
+#else
+# define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
+#endif
/*
* When not using stubs, make it a macro.
@@ -2418,7 +2423,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
*/
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
- ((Tcl_CreateInterp)()))
+ ((Tcl_SetPanicProc(Tcl_ConsolePanic), 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/library/clock.tcl b/library/clock.tcl
index bfdf832..bfdf832 100755..100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
diff --git a/win/Makefile.in b/win/Makefile.in
index b92a062..f357978 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -388,7 +388,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
- tclOOStubLib.$(OBJEXT)
+ tclOOStubLib.$(OBJEXT) \
+ tclWinPanic.$(OBJEXT)
TCLSH_OBJS = tclAppInit.$(OBJEXT)
@@ -523,6 +524,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 f5b5acc..1312abc 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -281,7 +281,8 @@ TCLOBJS = \
TCLSTUBOBJS = \
$(TMPDIR)\tclStubLib.obj \
$(TMPDIR)\tclTomMathStubLib.obj \
- $(TMPDIR)\tclOOStubLib.obj
+ $(TMPDIR)\tclOOStubLib.obj \
+ $(TMPDIR)\tclWinPanic.obj
WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
@@ -535,6 +536,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
$(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c
$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+$(TMPDIR)\tclWinPanic.obj : $(WINDIR)\tclWinPanic.c
+ $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
# Dedependency rules
diff --git a/win/makefile.vc b/win/makefile.vc
index be05e73..cc8c45e 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -452,7 +452,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
@@ -986,6 +987,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: $(WINDIR)\tclWinPanic.c
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 96d5893..a7c9b94 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/tclWinFile.c b/win/tclWinFile.c
index a5b14b4..a5b14b4 100755..100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
new file mode 100644
index 0000000..3c2e072
--- /dev/null
+++ b/win/tclWinPanic.c
@@ -0,0 +1,99 @@
+/*
+ * 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 26000
+ va_list argList;
+ WCHAR msgString[TCL_MAX_WARN_LEN];
+ char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+#ifndef __CYGWIN__
+ HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
+ DWORD dummy;
+#endif
+
+ 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);
+#ifdef __CYGWIN__
+ } else {
+ buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+ write(2, buf, strlen(buf));
+ fsync(2);
+#else
+ } 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);
+#endif
+ }
+#if defined(_WIN32) || defined(__CYGWIN__)
+# if defined(__GNUC__)
+ __builtin_trap();
+# elif defined(_WIN64)
+ __debugbreak();
+# elif defined(_MSC_VER)
+ _asm {int 3}
+# else
+ DebugBreak();
+# endif
+#endif
+#if defined(_WIN32)
+ ExitProcess(1);
+#else
+ abort();
+#endif
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
generated by cgit v0.12 at 2025-12-16 00:49:44 (GMT)