From f5e6dc061f04d3923e3e9098ee796d212209eff4 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 15 Nov 2006 20:08:41 +0000 Subject: TIP#270 IMPLEMENTATION * generic/tcl.decls: New public routines Tcl_ObjPrintf, * generic/tclStringObj.c: Tcl_AppendObjToErrorInfo, Tcl_Format, * generic/tclInt.h: Tcl_AppendLimitedToObj, Tcl_AppendFormatToObj and Tcl_AppendPrintfToObj. Former internal versions removed. * generic/tclDecls.h: make genstubs * generic/tclStubInit.c: * generic/tclBasic.c: Updated callers. * generic/tclCkalloc.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIORChan.c: * generic/tclIOUtil.c: * generic/tclMain.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclPkg.c: * generic/tclProc.c: * generic/tclStrToD.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c: --- ChangeLog | 32 +++++++++++++++++++++++ generic/tcl.decls | 25 +++++++++++++++++- generic/tclBasic.c | 12 ++++----- generic/tclCkalloc.c | 4 +-- generic/tclCmdAH.c | 14 +++++----- generic/tclCmdIL.c | 6 ++--- generic/tclCmdMZ.c | 8 +++--- generic/tclCompExpr.c | 30 +++++++++++----------- generic/tclCompile.c | 4 +-- generic/tclDecls.h | 69 +++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclDictObj.c | 6 ++--- generic/tclExecute.c | 8 +++--- generic/tclIORChan.c | 10 ++++---- generic/tclIOUtil.c | 4 +-- generic/tclInt.h | 15 +---------- generic/tclMain.c | 4 +-- generic/tclNamesp.c | 10 ++++---- generic/tclObj.c | 4 +-- generic/tclPkg.c | 4 +-- generic/tclProc.c | 20 +++++++-------- generic/tclStrToD.c | 4 +-- generic/tclStringObj.c | 34 ++++++++++++------------- generic/tclStubInit.c | 8 +++++- generic/tclTimer.c | 6 ++--- generic/tclUtil.c | 6 ++--- unix/tclUnixFCmd.c | 4 +-- 26 files changed, 233 insertions(+), 118 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3e3a73c..c5de807 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,37 @@ 2006-11-15 Don Porter + TIP#270 IMPLEMENTATION + + * generic/tcl.decls: New public routines Tcl_ObjPrintf, + * generic/tclStringObj.c: Tcl_AppendObjToErrorInfo, Tcl_Format, + * generic/tclInt.h: Tcl_AppendLimitedToObj, + Tcl_AppendFormatToObj and Tcl_AppendPrintfToObj. Former internal + versions removed. + + * generic/tclDecls.h: make genstubs + * generic/tclStubInit.c: + + * generic/tclBasic.c: Updated callers. + * generic/tclCkalloc.c: + * generic/tclCmdAH.c: + * generic/tclCmdIL.c: + * generic/tclCmdMZ.c: + * generic/tclCompExpr.c: + * generic/tclCompile.c: + * generic/tclDictObj.c: + * generic/tclExecute.c: + * generic/tclIORChan.c: + * generic/tclIOUtil.c: + * generic/tclMain.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclPkg.c: + * generic/tclProc.c: + * generic/tclStrToD.c: + * generic/tclTimer.c: + * generic/tclUtil.c: + * unix/tclUnixFCmd.c: + * tools/genStubs.tcl: Updated script to no longer produce the _ANSI_ARGS_ wrapper in generated declarations. Also revised to accept variadic prototypes with more than one fixed argument. diff --git a/generic/tcl.decls b/generic/tcl.decls index d92985f..40e548c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.122 2006/09/26 23:01:10 kennykb Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.123 2006/11/15 20:08:42 dgp Exp $ library tcl @@ -2072,6 +2072,29 @@ declare 573 generic { int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr) } +# TIP#270 Utility C Routines for String Formatting +declare 574 generic { + void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr) +} +declare 575 generic { + void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, CONST char *bytes, int length, + int limit, CONST char *ellipsis) +} +declare 576 generic { + Tcl_Obj * Tcl_Format(Tcl_Interp *interp, CONST char *format, int objc, + Tcl_Obj * CONST objv[]) +} +declare 577 generic { + int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + CONST char *format, int objc, Tcl_Obj * CONST objv[]) +} +declare 578 generic { + Tcl_Obj * Tcl_ObjPrintf(CONST char *format, ...) +} +declare 579 generic { + void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, CONST char *format, ...) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 22b715a..3844e16 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.217 2006/11/09 15:19:02 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.218 2006/11/15 20:08:42 dgp Exp $ */ #include "tclInt.h" @@ -3819,7 +3819,7 @@ Tcl_EvalEx( * Attempt to expand a non-list. */ - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (expanding word %d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); goto error; @@ -4210,7 +4210,7 @@ ProcessUnexpectedResult( Tcl_AppendResult(interp, "invoked \"continue\" outside of a loop", NULL); } else { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); } } @@ -4647,7 +4647,7 @@ Tcl_ExprString( /* *---------------------------------------------------------------------- * - * TclAppendObjToErrorInfo -- + * Tcl_AppendObjToErrorInfo -- * * Add a Tcl_Obj value to the errorInfo field that describes the current * error. @@ -4664,7 +4664,7 @@ Tcl_ExprString( */ void -TclAppendObjToErrorInfo( +Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ @@ -5839,7 +5839,7 @@ MathFuncWrongNumArgs( break; } } - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "too %s arguments for math function \"%s\"", (found < expected ? "few" : "many"), name)); } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 338b718..7993515 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -14,7 +14,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.29 2006/11/07 14:26:26 dkf Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.30 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -842,7 +842,7 @@ MemoryCmd( return TCL_OK; } if (strcmp(argv[1],"info") == 0) { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 27cdcff..a0aba43 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -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: tclCmdAH.c,v 1.79 2006/11/02 16:57:54 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.80 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -188,7 +188,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv) armPtr = caseObjv[body - 1]; result = Tcl_EvalObjEx(interp, caseObjv[body], 0); if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.50s\" arm line %d)", TclGetString(armPtr), interp->errorLine)); } @@ -251,7 +251,7 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) */ if (Tcl_LimitExceeded(interp)) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"catch\" body line %d)", interp->errorLine)); return TCL_ERROR; } @@ -660,7 +660,7 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); } if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"eval\" body line %d)", interp->errorLine)); } return result; @@ -1611,7 +1611,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objv[4], 0); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"for\" body line %d)", interp->errorLine)); } break; @@ -1821,7 +1821,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) result = TCL_OK; break; } else if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"foreach\" body line %d)", interp->errorLine)); break; } else { @@ -1881,7 +1881,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - resultPtr = TclFormat(interp, TclGetString(objv[1]), objc-2, objv+2); + resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2); if (resultPtr == NULL) { return TCL_ERROR; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index d679e90..8519de8 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.94 2006/11/09 16:11:46 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.95 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -3428,7 +3428,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); return TCL_ERROR; } @@ -4066,7 +4066,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); return TCL_ERROR; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e121999..66811ed 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.140 2006/11/09 16:11:46 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.141 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -2127,7 +2127,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) length2 = length1 * count; if ((length2 / count) != length1) { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow, must be less than %d", INT_MAX)); return TCL_ERROR; @@ -2924,7 +2924,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) if (result == TCL_ERROR) { int limit = 50; int overflow = (patternLength > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), interp->errorLine)); @@ -3072,7 +3072,7 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objv[2], 0); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"while\" body line %d)", interp->errorLine)); } break; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 81f6b3a..2ca5b0a 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -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: tclCompExpr.c,v 1.36 2006/11/13 08:23:07 das Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.37 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -224,12 +224,12 @@ Tcl_ParseExpr( if ((NODE_TYPE & nodePtr->lexeme) == 0) { switch (nodePtr->lexeme) { case INVALID: - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "invalid character \"%.*s\"", scanned, start); code = TCL_ERROR; continue; case INCOMPLETE: - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "incomplete operator \"%.*s\"", scanned, start); code = TCL_ERROR; continue; @@ -245,17 +245,17 @@ Tcl_ParseExpr( if (code == TCL_OK) { nodePtr->lexeme = BOOLEAN; } else { - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "invalid bareword \"%.*s%s\"", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); - post = TclObjPrintf( + post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "...", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); - TclAppendPrintfToObj(post, + Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); @@ -283,7 +283,7 @@ Tcl_ParseExpr( CONST char *operand = scratch.tokenPtr[lastNodePtr->token].start; - msg = TclObjPrintf("missing operator at %s", mark); + msg = Tcl_ObjPrintf("missing operator at %s", mark); if (operand[0] == '0') { Tcl_Obj *copy = Tcl_NewStringObj(operand, start + scanned - operand); @@ -417,7 +417,7 @@ Tcl_ParseExpr( case UNARY: if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) { - msg = TclObjPrintf("missing operator at %s", mark); + msg = Tcl_ObjPrintf("missing operator at %s", mark); scanned = 0; insertMark = 1; code = TCL_ERROR; @@ -463,7 +463,7 @@ Tcl_ParseExpr( break; } - msg = TclObjPrintf("empty subexpression at %s", mark); + msg = Tcl_ObjPrintf("empty subexpression at %s", mark); scanned = 0; insertMark = 1; code = TCL_ERROR; @@ -476,7 +476,7 @@ Tcl_ParseExpr( if (lastNodePtr->lexeme == OPEN_PAREN) { msg = Tcl_NewStringObj("unbalanced open paren", -1); } else if (lastNodePtr->lexeme == COMMA) { - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "missing function argument at %s", mark); scanned = 0; insertMark = 1; @@ -489,14 +489,14 @@ Tcl_ParseExpr( } else if ((nodePtr->lexeme == COMMA) && (lastNodePtr->lexeme == OPEN_PAREN) && (lastNodePtr[-1].lexeme == FUNCTION)) { - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "missing function argument at %s", mark); scanned = 0; insertMark = 1; } } if (msg == NULL) { - msg = TclObjPrintf("missing operand at %s", mark); + msg = Tcl_ObjPrintf("missing operand at %s", mark); scanned = 0; insertMark = 1; } @@ -546,7 +546,7 @@ Tcl_ParseExpr( } if ((otherPtr->lexeme == QUESTION) && (lastOrphanPtr->lexeme != COLON)) { - msg = TclObjPrintf( + msg = Tcl_ObjPrintf( "missing operator \":\" at %s", mark); scanned = 0; insertMark = 1; @@ -651,7 +651,7 @@ Tcl_ParseExpr( if (msg == NULL) { msg = Tcl_GetObjResult(interp); } - TclAppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", + Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < scratch.string) ? "" : "...", ((start - limit) < scratch.string) ? (start - scratch.string) : limit - 3, @@ -672,7 +672,7 @@ Tcl_ParseExpr( } Tcl_SetObjResult(interp, msg); numBytes = scratch.end - scratch.string; - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", (numBytes < limit) ? numBytes : limit - 3, scratch.string, (numBytes < limit) ? "" : "...")); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 2938698..fe587ef 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.99 2006/11/08 13:47:07 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.100 2006/11/15 20:08:43 dgp Exp $ */ #include "tclInt.h" @@ -1017,7 +1017,7 @@ TclCompileScript( Tcl_IncrRefCount(returnCmd); Tcl_IncrRefCount(errInfo); Tcl_AppendToObj(errInfo, "\n while executing\n\"", -1); - TclAppendLimitedToObj(errInfo, parse.commandStart, + Tcl_AppendLimitedToObj(errInfo, parse.commandStart, /* Drop the command terminator (";","]") if appropriate */ (parse.term == parse.commandStart + parse.commandSize - 1)? parse.commandSize - 1 : parse.commandSize, 153, NULL); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b95d321..c05e029 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.125 2006/11/15 14:58:26 dgp Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.126 2006/11/15 20:08:43 dgp Exp $ */ #ifndef _TCLDECLS @@ -3417,6 +3417,43 @@ EXTERN int Tcl_PkgRequireProc (Tcl_Interp * interp, Tcl_Obj *CONST objv[], ClientData * clientDataPtr); #endif +#ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED +#define Tcl_AppendObjToErrorInfo_TCL_DECLARED +/* 574 */ +EXTERN void Tcl_AppendObjToErrorInfo (Tcl_Interp * interp, + Tcl_Obj * objPtr); +#endif +#ifndef Tcl_AppendLimitedToObj_TCL_DECLARED +#define Tcl_AppendLimitedToObj_TCL_DECLARED +/* 575 */ +EXTERN void Tcl_AppendLimitedToObj (Tcl_Obj * objPtr, + CONST char * bytes, int length, int limit, + CONST char * ellipsis); +#endif +#ifndef Tcl_Format_TCL_DECLARED +#define Tcl_Format_TCL_DECLARED +/* 576 */ +EXTERN Tcl_Obj * Tcl_Format (Tcl_Interp * interp, CONST char * format, + int objc, Tcl_Obj * CONST objv[]); +#endif +#ifndef Tcl_AppendFormatToObj_TCL_DECLARED +#define Tcl_AppendFormatToObj_TCL_DECLARED +/* 577 */ +EXTERN int Tcl_AppendFormatToObj (Tcl_Interp * interp, + Tcl_Obj * objPtr, CONST char * format, + int objc, Tcl_Obj * CONST objv[]); +#endif +#ifndef Tcl_ObjPrintf_TCL_DECLARED +#define Tcl_ObjPrintf_TCL_DECLARED +/* 578 */ +EXTERN Tcl_Obj * Tcl_ObjPrintf (CONST char * format, ...); +#endif +#ifndef Tcl_AppendPrintfToObj_TCL_DECLARED +#define Tcl_AppendPrintfToObj_TCL_DECLARED +/* 579 */ +EXTERN void Tcl_AppendPrintfToObj (Tcl_Obj * objPtr, + CONST char * format, ...); +#endif typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -4032,6 +4069,12 @@ typedef struct TclStubs { int (*tcl_SetEncodingSearchPath) (Tcl_Obj* searchPath); /* 571 */ CONST char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString* bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp * interp, CONST char * name, int objc, Tcl_Obj *CONST objv[], ClientData * clientDataPtr); /* 573 */ + void (*tcl_AppendObjToErrorInfo) (Tcl_Interp * interp, Tcl_Obj * objPtr); /* 574 */ + void (*tcl_AppendLimitedToObj) (Tcl_Obj * objPtr, CONST char * bytes, int length, int limit, CONST char * ellipsis); /* 575 */ + Tcl_Obj * (*tcl_Format) (Tcl_Interp * interp, CONST char * format, int objc, Tcl_Obj * CONST objv[]); /* 576 */ + int (*tcl_AppendFormatToObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST char * format, int objc, Tcl_Obj * CONST objv[]); /* 577 */ + Tcl_Obj * (*tcl_ObjPrintf) (CONST char * format, ...); /* 578 */ + void (*tcl_AppendPrintfToObj) (Tcl_Obj * objPtr, CONST char * format, ...); /* 579 */ } TclStubs; #ifdef __cplusplus @@ -6368,6 +6411,30 @@ extern TclStubs *tclStubsPtr; #define Tcl_PkgRequireProc \ (tclStubsPtr->tcl_PkgRequireProc) /* 573 */ #endif +#ifndef Tcl_AppendObjToErrorInfo +#define Tcl_AppendObjToErrorInfo \ + (tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */ +#endif +#ifndef Tcl_AppendLimitedToObj +#define Tcl_AppendLimitedToObj \ + (tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */ +#endif +#ifndef Tcl_Format +#define Tcl_Format \ + (tclStubsPtr->tcl_Format) /* 576 */ +#endif +#ifndef Tcl_AppendFormatToObj +#define Tcl_AppendFormatToObj \ + (tclStubsPtr->tcl_AppendFormatToObj) /* 577 */ +#endif +#ifndef Tcl_ObjPrintf +#define Tcl_ObjPrintf \ + (tclStubsPtr->tcl_ObjPrintf) /* 578 */ +#endif +#ifndef Tcl_AppendPrintfToObj +#define Tcl_AppendPrintfToObj \ + (tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index e04d956..660a989 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.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: tclDictObj.c,v 1.44 2006/11/08 13:47:07 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.45 2006/11/15 20:08:44 dgp Exp $ */ #include "tclInt.h" @@ -2229,7 +2229,7 @@ DictForCmd( if (result == TCL_BREAK) { result = TCL_OK; } else if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict for\" body line %d)", interp->errorLine)); } @@ -2575,7 +2575,7 @@ DictFilterCmd( result = TCL_OK; break; case TCL_ERROR: - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"dict filter\" script line %d)", interp->errorLine)); default: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 9809b94..0e8c0d6 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.250 2006/11/13 08:23:07 das Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.251 2006/11/15 20:08:44 dgp Exp $ */ #include "tclInt.h" @@ -6308,7 +6308,7 @@ ValidatePcAndStackTop( if (cmd != NULL) { Tcl_Obj *message = Tcl_NewStringObj("\n executing ", -1); Tcl_IncrRefCount(message); - TclAppendLimitedToObj(message, cmd, numChars, 100, NULL); + Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); fprintf(stderr,"%s\n", Tcl_GetString(message)); Tcl_DecrRefCount(message); } else { @@ -6374,7 +6374,7 @@ IllegalExprOperandType( description = "(big) integer"; } - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use %s as operand of \"%s\"", description, operator)); } @@ -6638,7 +6638,7 @@ TclExprFloatError( Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL); } } else { - Tcl_Obj *objPtr = TclObjPrintf( + Tcl_Obj *objPtr = Tcl_ObjPrintf( "unknown floating-point error, errno = %d", errno); Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", Tcl_GetString(objPtr), (char *) NULL); diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 34d9556..8926fc5 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIORChan.c,v 1.17 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.18 2006/11/15 20:08:44 dgp Exp $ */ #include @@ -1652,7 +1652,7 @@ ReflectGetOption( */ Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); @@ -1909,7 +1909,7 @@ NextHandle(void) Tcl_Obj *resObj; Tcl_MutexLock(&rcCounterMutex); - resObj = TclObjPrintf("rc%lu", rcCounter); + resObj = Tcl_ObjPrintf("rc%lu", rcCounter); rcCounter++; Tcl_MutexUnlock(&rcCounterMutex); @@ -2043,13 +2043,13 @@ InvokeTclMethod( Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); - Tcl_SetObjResult(rcPtr->interp, TclObjPrintf( + Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } - TclAppendObjToErrorInfo(rcPtr->interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( "\n (chan handler subcommand \"%s\")", method)); resObj = MarshallError(rcPtr->interp); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ef913c5..f10c757 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.136 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.137 2006/11/15 20:08:44 dgp Exp $ */ #include "tclInt.h" @@ -1830,7 +1830,7 @@ Tcl_FSEvalFileEx( int limit = 150; int overflow = (length > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", (overflow ? limit : length), pathString, (overflow ? "..." : ""), interp->errorLine)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 915d2fa..88c6536 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.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: tclInt.h,v 1.295 2006/11/13 08:23:08 das Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.296 2006/11/15 20:08:44 dgp Exp $ */ #ifndef _TCLINT @@ -2060,16 +2060,6 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ -MODULE_SCOPE int TclAppendFormatToObj(Tcl_Interp *interp, - Tcl_Obj *appendObj, CONST char *format, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE void TclAppendLimitedToObj(Tcl_Obj *objPtr, - CONST char *bytes, int length, int limit, - CONST char *ellipsis); -MODULE_SCOPE void TclAppendPrintfToObj(Tcl_Obj *objPtr, - CONST char *format, ...); -MODULE_SCOPE void TclAppendObjToErrorInfo(Tcl_Interp *interp, - Tcl_Obj *objPtr); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(mp_int *bignum); @@ -2115,8 +2105,6 @@ MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadData(void); MODULE_SCOPE double TclFloor(mp_int *a); -MODULE_SCOPE Tcl_Obj * TclFormat(Tcl_Interp *interp, CONST char *format, - int objc, Tcl_Obj *CONST objv[]); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, CONST char *attributeName, int *indexPtr); @@ -2175,7 +2163,6 @@ MODULE_SCOPE int TclNokia770Doubles(); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Namespace *nsPtr, int flags); -MODULE_SCOPE Tcl_Obj * TclObjPrintf(CONST char *format, ...); MODULE_SCOPE int TclParseBackslash(CONST char *src, int numBytes, int *readPtr, char *dst); MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes, diff --git a/generic/tclMain.c b/generic/tclMain.c index c9ee3db..8356406 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -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: tclMain.c,v 1.38 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.39 2006/11/15 20:08:44 dgp Exp $ */ #include "tclInt.h" @@ -652,7 +652,7 @@ Tcl_Main( if (!Tcl_InterpDeleted(interp)) { if (!Tcl_LimitExceeded(interp)) { - Tcl_Obj *cmd = TclObjPrintf("exit %d", exitCode); + Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index f3d7bf1..645943a 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -22,7 +22,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.118 2006/11/14 16:30:31 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.119 2006/11/15 20:08:44 dgp Exp $ */ #include "tclInt.h" @@ -3458,7 +3458,7 @@ NamespaceEvalCmd( int limit = 200; int overflow = (length > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace eval \"%.*s%s\" script line %d)", (overflow ? limit : length), namespacePtr->fullName, (overflow ? "..." : ""), interp->errorLine)); @@ -3898,7 +3898,7 @@ NamespaceInscopeCmd( int limit = 200; int overflow = (length > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace inscope \"%.*s%s\" script line %d)", (overflow ? limit : length), namespacePtr->fullName, (overflow ? "..." : ""), interp->errorLine)); @@ -4628,7 +4628,7 @@ NamespaceUpvarCmd( /* * The namespace does not exist, leave an error message. */ - Tcl_SetObjResult(interp, TclFormat(NULL, + Tcl_SetObjResult(interp, Tcl_Format(NULL, "namespace \"%s\" does not exist", 1, objv+2)); return TCL_ERROR; } @@ -7019,7 +7019,7 @@ Tcl_LogCommandInfo( } overflow = (length > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), (overflow ? limit : length), command, (overflow ? "..." : ""))); diff --git a/generic/tclObj.c b/generic/tclObj.c index 3b2658d..7aac447 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -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: tclObj.c,v 1.114 2006/10/23 21:36:55 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.115 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" @@ -1404,7 +1404,7 @@ SetBooleanFromAny( char *str = Tcl_GetStringFromObj(objPtr, &length); Tcl_Obj *msg = Tcl_NewStringObj("expected boolean value but got \"", -1); - TclAppendLimitedToObj(msg, str, length, 50, ""); + Tcl_AppendLimitedToObj(msg, str, length, 50, ""); Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 7e148d1..cecc634 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -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: tclPkg.c,v 1.24 2006/11/08 11:41:44 dkf Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.25 2006/11/15 20:08:45 dgp Exp $ * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended @@ -539,7 +539,7 @@ Tcl_PkgRequireProc( } if (code == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"package ifneeded %s %s\" script)", name, versionToProvide)); } diff --git a/generic/tclProc.c b/generic/tclProc.c index 3a1121d..c0a3549 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.106 2006/11/13 08:23:09 das Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.107 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" @@ -369,7 +369,7 @@ TclCreateProc( if (precompiled) { if (numArgs > procPtr->numArgs) { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": arg list contains %d entries, " "precompiled header expects %d", procName, numArgs, procPtr->numArgs)); @@ -458,7 +458,7 @@ TclCreateProc( != (VAR_SCALAR | VAR_ARGUMENT)) || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter %d is " "inconsistent with precompiled body", procName, i)); ckfree((char *) fieldValues); @@ -475,7 +475,7 @@ TclCreateProc( &tmpLength); if ((valueLength != tmpLength) || strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) { - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"%s\" has " "default value inconsistent with precompiled body", procName, fieldValues[0])); @@ -839,7 +839,7 @@ Tcl_UplevelObjCmd( result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); } if (result == TCL_ERROR) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"uplevel\" body line %d)", interp->errorLine)); } @@ -1600,7 +1600,7 @@ ProcCompileProc( Tcl_IncrRefCount(message); Tcl_AppendStringsToObj(message, description, " \"", NULL); - TclAppendLimitedToObj(message, procName, -1, 50, NULL); + Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL); fprintf(stdout, "%s\"\n", TclGetString(message)); Tcl_DecrRefCount(message); } @@ -1692,7 +1692,7 @@ ProcCompileProc( int limit = 50; int overflow = (length > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (compiling %s \"%.*s%s\", line %d)", description, (overflow ? limit : length), procName, (overflow ? "..." : ""), interp->errorLine)); @@ -1739,7 +1739,7 @@ MakeProcError( const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), interp->errorLine)); @@ -2077,7 +2077,7 @@ SetLambdaFromAny( if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr, &procPtr) != TCL_OK) { - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing lambda expression \"%s\")", name)); return TCL_ERROR; } @@ -2267,7 +2267,7 @@ MakeLambdaError( const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); - TclAppendObjToErrorInfo(interp, TclObjPrintf( + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), interp->errorLine)); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 5e5f974..d25b645 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.25 2006/08/10 12:15:31 dkf Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.26 2006/11/15 20:08:45 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -1128,7 +1128,7 @@ TclParseNumber( Tcl_Obj *msg = Tcl_NewStringObj("expected ", -1); Tcl_AppendToObj(msg, expected, -1); Tcl_AppendToObj(msg, " but got \"", -1); - TclAppendLimitedToObj(msg, bytes, numBytes, 50, ""); + Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); if (state == BAD_OCTAL) { Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2e722c4..ea76330 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.62 2006/11/05 04:16:07 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.63 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -1021,7 +1021,7 @@ Tcl_SetUnicodeObj( /* *---------------------------------------------------------------------- * - * TclAppendLimitedToObj -- + * Tcl_AppendLimitedToObj -- * * This function appends a limited number of bytes from a sequence of * bytes to an object, marking any limitation with an ellipsis. @@ -1037,7 +1037,7 @@ Tcl_SetUnicodeObj( */ void -TclAppendLimitedToObj( +Tcl_AppendLimitedToObj( register Tcl_Obj *objPtr, /* Points to the object to append to. */ CONST char *bytes, /* Points to the bytes to append to the * object. */ @@ -1054,7 +1054,7 @@ TclAppendLimitedToObj( int toCopy = 0; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "TclAppendLimitedToObj"); + Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); } SetStringFromAny(NULL, objPtr); @@ -1126,7 +1126,7 @@ Tcl_AppendToObj( * If < 0, then append all bytes up to NUL * byte. */ { - TclAppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); + Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); } /* @@ -1676,7 +1676,7 @@ Tcl_AppendStringsToObj( /* *---------------------------------------------------------------------- * - * TclAppendFormatToObj -- + * Tcl_AppendFormatToObj -- * * This function appends a list of Tcl_Obj's to a Tcl_Obj according to * the formatting instructions embedded in the format string. The @@ -1694,7 +1694,7 @@ Tcl_AppendStringsToObj( */ int -TclAppendFormatToObj( +Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, CONST char *format, @@ -1715,7 +1715,7 @@ TclAppendFormatToObj( }; if (Tcl_IsShared(appendObj)) { - Tcl_Panic("%s called with shared object", "TclAppendFormatToObj"); + Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } Tcl_GetStringFromObj(appendObj, &originalLength); @@ -2291,7 +2291,7 @@ TclAppendFormatToObj( /* *--------------------------------------------------------------------------- * - * TclFormat-- + * Tcl_Format-- * * Results: * A refcount zero Tcl_Obj. @@ -2303,7 +2303,7 @@ TclAppendFormatToObj( */ Tcl_Obj * -TclFormat( +Tcl_Format( Tcl_Interp *interp, CONST char *format, int objc, @@ -2311,7 +2311,7 @@ TclFormat( { int result; Tcl_Obj *objPtr = Tcl_NewObj(); - result = TclAppendFormatToObj(interp, objPtr, format, objc, objv); + result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv); if (result != TCL_OK) { Tcl_DecrRefCount(objPtr); return NULL; @@ -2454,9 +2454,9 @@ AppendPrintfToObjVA( } while (seekingConversion); } Tcl_ListObjGetElements(NULL, list, &objc, &objv); - code = TclAppendFormatToObj(NULL, objPtr, format, objc, objv); + code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { - TclAppendPrintfToObj(objPtr, + Tcl_AppendPrintfToObj(objPtr, "Unable to format \"%s\" with supplied arguments: %s", format, Tcl_GetString(list)); } @@ -2466,7 +2466,7 @@ AppendPrintfToObjVA( /* *--------------------------------------------------------------------------- * - * TclAppendPrintfToObj -- + * Tcl_AppendPrintfToObj -- * * Results: * A standard Tcl result. @@ -2478,7 +2478,7 @@ AppendPrintfToObjVA( */ void -TclAppendPrintfToObj( +Tcl_AppendPrintfToObj( Tcl_Obj *objPtr, CONST char *format, ...) @@ -2493,7 +2493,7 @@ TclAppendPrintfToObj( /* *--------------------------------------------------------------------------- * - * TclObjPrintf -- + * Tcl_ObjPrintf -- * * Results: * A refcount zero Tcl_Obj. @@ -2505,7 +2505,7 @@ TclAppendPrintfToObj( */ Tcl_Obj * -TclObjPrintf( +Tcl_ObjPrintf( CONST char *format, ...) { diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 50fd94e..ff829be 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.136 2006/11/12 23:23:20 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.137 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" @@ -1076,6 +1076,12 @@ TclStubs tclStubs = { Tcl_SetEncodingSearchPath, /* 571 */ Tcl_GetEncodingNameFromEnvironment, /* 572 */ Tcl_PkgRequireProc, /* 573 */ + Tcl_AppendObjToErrorInfo, /* 574 */ + Tcl_AppendLimitedToObj, /* 575 */ + Tcl_Format, /* 576 */ + Tcl_AppendFormatToObj, /* 577 */ + Tcl_ObjPrintf, /* 578 */ + Tcl_AppendPrintfToObj, /* 579 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 866c114..3e5ad1a 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.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: tclTimer.c,v 1.27 2006/11/13 08:23:09 das Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.28 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" @@ -869,7 +869,7 @@ Tcl_AfterObjCmd( (ClientData) afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; - Tcl_SetObjResult(interp, TclObjPrintf("after#%d", afterPtr->id)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); return TCL_OK; } case AFTER_CANCEL: { @@ -932,7 +932,7 @@ Tcl_AfterObjCmd( afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr); - Tcl_SetObjResult(interp, TclObjPrintf("after#%d", afterPtr->id)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); break; case AFTER_INFO: { Tcl_Obj *resultListPtr; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 399fae7..8981ff6 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.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: tclUtil.c,v 1.75 2006/11/13 08:23:09 das Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.76 2006/11/15 20:08:45 dgp Exp $ */ #include "tclInt.h" @@ -221,7 +221,7 @@ TclFindElement( && (p2 < p+20)) { p2++; } - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list element in braces followed by \"%.*s\" " "instead of space", (int) (p2-p), p)); } @@ -280,7 +280,7 @@ TclFindElement( && (p2 < p+20)) { p2++; } - Tcl_SetObjResult(interp, TclObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list element in quotes followed by \"%.*s\" " "instead of space", (int) (p2-p), p)); } diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 8bf268d..13a2a6e 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -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: tclUnixFCmd.c,v 1.59 2006/11/07 17:29:48 andreas_kupries Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.60 2006/11/15 20:08:45 dgp Exp $ * * Portions of this code were derived from NetBSD source code which has the * following copyright notice: @@ -1423,7 +1423,7 @@ GetPermissionsAttribute( return TCL_ERROR; } - *attributePtrPtr = TclObjPrintf( + *attributePtrPtr = Tcl_ObjPrintf( "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); return TCL_OK; } -- cgit v0.12