diff options
author | dgp <dgp@users.sourceforge.net> | 2001-06-08 20:06:11 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2001-06-08 20:06:11 (GMT) |
commit | 4f211efb0420a08b1bde5ecf7512c41ffbaac25a (patch) | |
tree | d894a8872011af91b11ec3c0353d3469de8e7c27 | |
parent | ea19d9dca7dada8b52673be131ea55726584ff5c (diff) | |
download | tcl-4f211efb0420a08b1bde5ecf7512c41ffbaac25a.zip tcl-4f211efb0420a08b1bde5ecf7512c41ffbaac25a.tar.gz tcl-4f211efb0420a08b1bde5ecf7512c41ffbaac25a.tar.bz2 |
* 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]
-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 |