diff options
| -rw-r--r-- | ChangeLog | 25 | ||||
| -rw-r--r-- | doc/Panic.3 | 102 | ||||
| -rw-r--r-- | generic/tcl.decls | 11 | ||||
| -rw-r--r-- | generic/tcl.h | 4 | ||||
| -rw-r--r-- | generic/tclDecls.h | 33 | ||||
| -rw-r--r-- | generic/tclInt.decls | 5 | ||||
| -rw-r--r-- | generic/tclIntPlatDecls.h | 9 | ||||
| -rw-r--r-- | generic/tclPanic.c | 21 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 11 | ||||
| -rw-r--r-- | mac/tclMacAppInit.c | 3 | ||||
| -rw-r--r-- | mac/tclMacBOAAppInit.c | 3 | ||||
| -rw-r--r-- | mac/tclMacPanic.c | 193 | ||||
| -rw-r--r-- | unix/mkLinks | 12 |
13 files changed, 313 insertions, 119 deletions
@@ -1,3 +1,28 @@ +2001-05-03 Don Porter <dgp@users.sourceforge.net> + + * generic/tcl.h: + * generic/tcl.decls: + * generic/tclPanic.c: Added CONST to Tcl_*Panic* public interfaces. + [Patch 415648, TIP 27] + + * generic/tclInt.decls: + * mac/tclMacAppInit.c (main): + * mac/tclMacBOAAppInit.c (main): + * mac/tclMacPanic.c: Modified special Mac implementations of + Tcl_*Panic* to be exact copies of the generic implementations. + Added TclMacSetPanic. The generic implementations should be + used directly, rather than copies, but that requires further + changes by someone familiar with the Mac build systems. + [Patch 415648] + + * generic/tclDecls.h: + * generic/tclIntPlatDecls.h: + *`generic/tclStubInit.c: `make gentubs` after above changes. + + * doc/Panic.3: + * unix/mkLinks: New file documenting Tcl_*Panic* public interfaces, + followed by `make mklinks`. [Patch 415648, Bug 219170, Bug 414936] + 2001-06-03 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclUtil.c (Tcl_DStringAppendElement): patch to save an diff --git a/doc/Panic.3 b/doc/Panic.3 new file mode 100644 index 0000000..c7b0f8c --- /dev/null +++ b/doc/Panic.3 @@ -0,0 +1,102 @@ +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +'\" RCS: @(#) $Id: Panic.3,v 1.1 2001/06/08 20:06:11 dgp Exp $ +'\" +.so man.macros +.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures" +.BS +.SH NAME +Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, panic, panicVA \- report fatal error and abort +.SH SYNOPSIS +.nf +\fB#include <tcl.h>\fR +.sp +void +\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) +.sp +void +\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) +.sp +void +\fBTcl_SetPanicProc\fR(\fIpanicProc\fR) +.sp +void +\fBpanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) +.sp +void +\fBpanicVA\fR(\fIformat\fR, \fIargList\fR) +.SH ARGUMENTS +.AS Tcl_PanicProc *panicProc +.AP "CONST char*" format in +A printf-style format string. +.AP "" arg in +Arguments matching the format string. +.AP va_list argList in +An argument list of arguments matching the format string. +Must have been initialized using \fBTCL_VARARGS_START\fR, +and cleared using \fBva_end\fR. +.AP Tcl_PanicProc *panicProc in +Procedure to report fatal error message and abort. +.BE + +.SH DESCRIPTION +.PP +When the Tcl library detects that its internal data structures are in an +inconsistent state, or that its C procedures have been called in a +manner inconsistent with their documentation, it calls \fBTcl_Panic\fR +to display a message describing the error and abort the process. The +\fIformat\fB argument is a format string describing how to format the +remaining arguments \fIarg\fR into an error message, according to the +same formatting rules used by the \fBprintf\fR family of functions. The +same formatting rules are also used by the builtin Tcl command +\fBformat\fR. +.PP +In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted +error message to the standard error file of the process, and then +calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not +return. +.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: +.CS +typedef void Tcl_PanicProc( CONST char *\fBformat\fR, + \fBarg\fR, \fBarg\fR,...); +.CE +After \fBTcl_SetPanicProc\fR returns, any future calls to +\fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the +\fIformat\fR and \fIarg\fR arguments. To maintain consistency with the +callers of \fBTcl_Panic\fR, \fIpanicProc\fB must not return; it must +call \fBabort\fR. \fIpanicProc\fR should avoid making calls into the +Tcl library, or into other libraries that may call the Tcl library, +since the original call to \fBTcl_Panic\fR indicates the Tcl library is +not in a state of reliable operation. +.PP +The typical use of \fBTcl_SetPanicProc\fR arranges for the error message +to be displayed or reported in a manner more suitable for the +application or the platform. As an example, the Windows implementation +of \fBwish\fR calls \fBTcl_SetPanicProc\fR to force all panic messages +to be displayed in a system dialog box, rather than to be printed to the +standard error file (usually not visible under Windows). +.PP +Although the primary callers of \fBTcl_Panic\fR are the procedures of +the Tcl library, \fBTcl_Panic\fR is a public function and may be called +by any extension or application that wishes to abort the process and +have a panic message displayed the same way that panic messages from Tcl +will be displayed. +.PP +\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of +taking a variable number of arguments it takes an argument list. The +procedures \fBpanic\fR and \fBpanicVA\fR are synonyms (implemented as +macros) for \fBTcl_Panic\fR and \fBTcl_PanicVA\fR, respectively. They +exist to support old code; new code should use direct calls to +\fBTcl_Panic\fR or \fBTcl_PanicVA\fR. + +.SH "SEE ALSO" +abort(3), printf(3), exec(n), format(n) + +.SH KEYWORDS +abort, fatal, error + diff --git a/generic/tcl.decls b/generic/tcl.decls index 14c014b..f60a719 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.48 2001/05/30 08:57:06 dkf Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.49 2001/06/08 20:06:11 dgp Exp $ library tcl @@ -36,7 +36,7 @@ declare 1 generic { int exact, ClientData *clientDataPtr ) } declare 2 generic { - void Tcl_Panic(char *format, ...) + void Tcl_Panic(CONST char *format, ...) } declare 3 generic { char * Tcl_Alloc(unsigned int size) @@ -967,8 +967,8 @@ declare 276 generic { declare 277 generic { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -declare 278 {unix win} { - void Tcl_PanicVA(char *format, va_list argList) +declare 278 generic { + void Tcl_PanicVA(CONST char *format, va_list argList) } declare 279 generic { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) @@ -1588,8 +1588,7 @@ declare 6 mac { } # These are not in MSL 2.1.2, so we need to export them from the -# Tcl shared library. They are found in the compat directory -# except the panic routine which is found in tclMacPanic.h. +# Tcl shared library. They are found in the compat directory. declare 7 mac { int strncasecmp(CONST char *s1, CONST char *s2, size_t n) diff --git a/generic/tcl.h b/generic/tcl.h index 507f952..3e8a71a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.90 2001/05/28 22:26:43 hobbs Exp $ + * RCS: @(#) $Id: tcl.h,v 1.91 2001/06/08 20:06:11 dgp Exp $ */ #ifndef _TCL @@ -597,7 +597,7 @@ typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[])); typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp)); -typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(char *, format)); +typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData, Tcl_Channel chan, char *address, int port)); typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData)); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b2a6031..bb600ed 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.50 2001/05/30 08:57:06 dkf Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.51 2001/06/08 20:06:11 dgp Exp $ */ #ifndef _TCLDECLS @@ -35,7 +35,7 @@ EXTERN CONST char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 2 */ -EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(char *,format)); +EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 3 */ EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size)); /* 4 */ @@ -898,16 +898,9 @@ EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp, /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -/* 278 */ -EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format, - va_list argList)); -#endif /* UNIX */ -#ifdef __WIN32__ /* 278 */ -EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format, +EXTERN void Tcl_PanicVA _ANSI_ARGS_((CONST char * format, va_list argList)); -#endif /* __WIN32__ */ /* 279 */ EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); @@ -1388,7 +1381,7 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */ CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ - void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(char *,format)); /* 2 */ + void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */ void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */ char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */ @@ -1712,15 +1705,7 @@ typedef struct TclStubs { void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */ int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */ Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */ -#endif /* UNIX */ -#ifdef __WIN32__ - void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */ -#endif /* __WIN32__ */ -#ifdef MAC_TCL - void *reserved278; -#endif /* MAC_TCL */ + void (*tcl_PanicVA) _ANSI_ARGS_((CONST char * format, va_list argList)); /* 278 */ void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */ void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */ Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */ @@ -3034,18 +3019,10 @@ extern TclStubs *tclStubsPtr; #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #endif -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -#ifndef Tcl_PanicVA -#define Tcl_PanicVA \ - (tclStubsPtr->tcl_PanicVA) /* 278 */ -#endif -#endif /* UNIX */ -#ifdef __WIN32__ #ifndef Tcl_PanicVA #define Tcl_PanicVA \ (tclStubsPtr->tcl_PanicVA) /* 278 */ #endif -#endif /* __WIN32__ */ #ifndef Tcl_GetVersion #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 241390d..8835119 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.26 2001/05/17 02:13:03 hobbs Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.27 2001/06/08 20:06:11 dgp Exp $ library tcl @@ -725,6 +725,9 @@ declare 23 mac { declare 25 mac { int TclMacChmod(char *path, int mode) } +declare 26 mac { + void TclMacSetPanic(void) +} ############################ # Windows specific internals diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index a288b03..ce5e87c 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -9,7 +9,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.9 2000/07/26 01:30:59 davidg Exp $ + * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.10 2001/06/08 20:06:11 dgp Exp $ */ #ifndef _TCLINTPLATDECLS @@ -194,6 +194,8 @@ EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((CONST char * path, /* Slot 24 is reserved */ /* 25 */ EXTERN int TclMacChmod _ANSI_ARGS_((char * path, int mode)); +/* 26 */ +EXTERN void TclMacSetPanic _ANSI_ARGS_((void)); #endif /* MAC_TCL */ typedef struct TclIntPlatStubs { @@ -268,6 +270,7 @@ typedef struct TclIntPlatStubs { FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char * path, CONST char * mode)); /* 23 */ void *reserved24; int (*tclMacChmod) _ANSI_ARGS_((char * path, int mode)); /* 25 */ + void (*tclMacSetPanic) _ANSI_ARGS_((void)); /* 26 */ #endif /* MAC_TCL */ } TclIntPlatStubs; @@ -521,6 +524,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclMacChmod \ (tclIntPlatStubsPtr->tclMacChmod) /* 25 */ #endif +#ifndef TclMacSetPanic +#define TclMacSetPanic \ + (tclIntPlatStubsPtr->tclMacSetPanic) /* 26 */ +#endif #endif /* MAC_TCL */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 87bc177..4e4b06c 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -2,8 +2,8 @@ * tclPanic.c -- * * Source code for the "Tcl_Panic" library procedure for Tcl; - * individual applications will probably override this with - * an application-specific panic procedure. + * individual applications will probably call Tcl_SetPanicProc() + * to set an application-specific panic procedure. * * Copyright (c) 1988-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. @@ -12,7 +12,7 @@ * 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.2 1999/03/04 01:01:59 stanton Exp $ + * RCS: @(#) $Id: tclPanic.c,v 1.3 2001/06/08 20:06:11 dgp Exp $ */ #include "tclInt.h" @@ -22,7 +22,8 @@ * specific panic procedure. */ -void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL; +static Tcl_PanicProc *panicProc = NULL; + /* *---------------------------------------------------------------------- @@ -42,7 +43,7 @@ void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL; void Tcl_SetPanicProc(proc) - void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format)); + Tcl_PanicProc *proc; { panicProc = proc; } @@ -65,7 +66,7 @@ Tcl_SetPanicProc(proc) void Tcl_PanicVA (format, argList) - char *format; /* Format string, suitable for passing to + CONST char *format; /* Format string, suitable for passing to * fprintf. */ va_list argList; /* Variable argument list. */ { @@ -97,7 +98,7 @@ Tcl_PanicVA (format, argList) /* *---------------------------------------------------------------------- * - * panic -- + * Tcl_Panic -- * * Print an error message and kill the process. * @@ -112,12 +113,12 @@ Tcl_PanicVA (format, argList) /* VARARGS ARGSUSED */ void -panic TCL_VARARGS_DEF(char *,arg1) +Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1) { va_list argList; - char *format; + CONST char *format; - format = TCL_VARARGS_START(char *,arg1,argList); + format = TCL_VARARGS_START(CONST char *,arg1,argList); Tcl_PanicVA(format, argList); va_end (argList); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index f4a9909..c20a13c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.50 2001/05/30 08:57:06 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.51 2001/06/08 20:06:11 dgp Exp $ */ #include "tclInt.h" @@ -315,6 +315,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclMacFOpenHack, /* 23 */ NULL, /* 24 */ TclMacChmod, /* 25 */ + TclMacSetPanic, /* 26 */ #endif /* MAC_TCL */ }; @@ -673,15 +674,7 @@ TclStubs tclStubs = { Tcl_SetErrorCodeVA, /* 275 */ Tcl_VarEvalVA, /* 276 */ Tcl_WaitPid, /* 277 */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - Tcl_PanicVA, /* 278 */ -#endif /* UNIX */ -#ifdef __WIN32__ Tcl_PanicVA, /* 278 */ -#endif /* __WIN32__ */ -#ifdef MAC_TCL - NULL, /* 278 */ -#endif /* MAC_TCL */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c index c4e4746..7eaa6c7 100644 --- a/mac/tclMacAppInit.c +++ b/mac/tclMacAppInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacAppInit.c,v 1.5 1999/04/16 00:47:19 stanton Exp $ + * RCS: @(#) $Id: tclMacAppInit.c,v 1.6 2001/06/08 20:06:11 dgp Exp $ */ #include "tcl.h" @@ -64,6 +64,7 @@ main( { char *newArgv[2]; + TclMacSetPanic(); if (MacintoshInit() != TCL_OK) { Tcl_Exit(1); } diff --git a/mac/tclMacBOAAppInit.c b/mac/tclMacBOAAppInit.c index 4fc34e8..afdfbd5 100644 --- a/mac/tclMacBOAAppInit.c +++ b/mac/tclMacBOAAppInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.3 1999/04/16 00:47:19 stanton Exp $ + * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.4 2001/06/08 20:06:11 dgp Exp $ */ #include "tcl.h" @@ -75,6 +75,7 @@ main( { char *newArgv[3]; + TclMacSetPanic(); if (MacintoshInit() != TCL_OK) { Tcl_Exit(1); } diff --git a/mac/tclMacPanic.c b/mac/tclMacPanic.c index 081c856..06ae73e 100644 --- a/mac/tclMacPanic.c +++ b/mac/tclMacPanic.c @@ -1,9 +1,9 @@ /* * tclMacPanic.c -- * - * Source code for the "panic" library procedure used in "Simple Shell"; - * other Mac applications will probably override this with a more robust - * application-specific panic procedure. + * Source code for the "Tcl_Panic" library procedure used in "Simple + * Shell"; other Mac applications will probably call Tcl_SetPanicProc + * to set a more robust application-specific panic procedure. * * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center * Copyright (c) 1995-1996 Sun Microsystems, Inc. @@ -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: tclMacPanic.c,v 1.2 1998/09/14 18:40:05 stanton Exp $ + * RCS: @(#) $Id: tclMacPanic.c,v 1.3 2001/06/08 20:06:11 dgp Exp $ */ @@ -27,8 +27,6 @@ #include <stdio.h> #include <stdlib.h> -#include "tclInt.h" - /* * constants for panic dialog */ @@ -40,56 +38,31 @@ #define ENTERCODE (0x03) #define RETURNCODE (0x0D) -/* - * The panicProc variable contains a pointer to an application - * specific panic procedure. - */ +static void MacPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); -void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL; - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetPanicProc -- - * - * Replace the default panic behavior with the specified functiion. - * - * Results: - * None. - * - * Side effects: - * Sets the panicProc variable. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetPanicProc(proc) - void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format)); -{ - panicProc = proc; -} /* *---------------------------------------------------------------------- * * MacPanic -- * - * Displays panic info.. + * Displays panic info, then aborts * * Results: * None. * * Side effects: - * Sets the panicProc variable. + * The process dies, entering the debugger if possible. * *---------------------------------------------------------------------- */ + /* VARARGS ARGSUSED */ static void -MacPanic( - char *msg) /* Text to show in panic dialog. */ +MacPanic TCL_VARARGS_DEF(CONST char *, arg1) { + va_list varg; + char msg[256]; WindowRef macWinPtr, foundWinPtr; Rect macRect; Rect buttonRect = PANIC_BUTTON_RECT; @@ -100,7 +73,10 @@ MacPanic( Handle stopIconHandle; int part; Boolean done = false; - + + va_start(varg, format); + vsprintf(msg, format, varg); + va_end(varg); /* * Put up an alert without using the Resource Manager (there may @@ -195,41 +171,138 @@ MacPanic( /* *---------------------------------------------------------------------- * - * panic -- + * TclMacSetPanic -- * - * Print an error message and kill the process. + * Replace Tcl's default panic behavior with one more suitable for + * the Mac * * Results: * None. * * Side effects: - * The process dies, entering the debugger if possible. + * Tcl's panic proc is set. * *---------------------------------------------------------------------- */ -#pragma ignore_oldstyle on void -panic(char * format, ...) +TclMacSetPanic() { - va_list varg; - char errorText[256]; - + Tcl_SetPanicProc(MacPanic); +} + +/* + * NOTE: The rest of this file is *identical* to the file + * generic/tclPanic.c. Someone with the right set of development tools on + * the Mac should be able to build the Tcl library using that file, and + * remove the rest of this one. + */ + +#include "tclInt.h" + +/* + * The panicProc variable contains a pointer to an application + * specific panic procedure. + */ + +static Tcl_PanicProc *panicProc = NULL; + + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetPanicProc -- + * + * Replace the default panic behavior with the specified functiion. + * + * Results: + * None. + * + * Side effects: + * Sets the panicProc variable. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetPanicProc(proc) + Tcl_SetPanicProc *proc; +{ + panicProc = proc; +} +^L +/* + *---------------------------------------------------------------------- + * + * Tcl_PanicVA -- + * + * Print an error message and kill the process. + * + * Results: + * None. + * + * Side effects: + * The process dies, entering the debugger if possible. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_PanicVA (format, argList) + CONST char *format; /* Format string, suitable for passing to + * fprintf. */ + va_list argList; /* Variable argument list. */ +{ + char *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in + * number) to pass to fprintf. */ + char *arg5, *arg6, *arg7, *arg8; + + arg1 = va_arg(argList, char *); + arg2 = va_arg(argList, char *); + arg3 = va_arg(argList, char *); + arg4 = va_arg(argList, char *); + arg5 = va_arg(argList, char *); + arg6 = va_arg(argList, char *); + arg7 = va_arg(argList, char *); + arg8 = va_arg(argList, char *); + if (panicProc != NULL) { - va_start(varg, format); - - (void) (*panicProc)(format, varg); - - va_end(varg); + (void) (*panicProc)(format, arg1, arg2, arg3, arg4, + arg5, arg6, arg7, arg8); } else { - va_start(varg, format); - - vsprintf(errorText, format, varg); - - va_end(varg); - - MacPanic(errorText); + (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, + arg7, arg8); + (void) fprintf(stderr, "\n"); + (void) fflush(stderr); + abort(); } +} +^L +/* + *---------------------------------------------------------------------- + * + * Tcl_Panic -- + * + * Print an error message and kill the process. + * + * Results: + * None. + * + * Side effects: + * The process dies, entering the debugger if possible. + * + *---------------------------------------------------------------------- + */ + + /* VARARGS ARGSUSED */ +void +Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1) +{ + va_list argList; + CONST char *format; + format = TCL_VARARGS_START(CONST char *,arg1,argList); + Tcl_PanicVA(format, argList); + va_end (argList); } -#pragma ignore_oldstyle reset + diff --git a/unix/mkLinks b/unix/mkLinks index d0b8d5c..fde23e4 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -698,6 +698,18 @@ if test -r OpenTcp.3; then ln OpenTcp.3 Tcl_MakeTcpClientChannel.3 ln OpenTcp.3 Tcl_OpenTcpServer.3 fi +if test -r Panic.3; then + rm -f Tcl_Panic.3 + rm -f Tcl_PanicVA.3 + rm -f Tcl_SetPanicProc.3 + rm -f panic.3 + rm -f panicVA.3 + ln Panic.3 Tcl_Panic.3 + ln Panic.3 Tcl_PanicVA.3 + ln Panic.3 Tcl_SetPanicProc.3 + ln Panic.3 panic.3 + ln Panic.3 panicVA.3 +fi if test -r ParseCmd.3; then rm -f Tcl_ParseCommand.3 rm -f Tcl_ParseExpr.3 |