summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog32
-rw-r--r--generic/tcl.decls25
-rw-r--r--generic/tclBasic.c12
-rw-r--r--generic/tclCkalloc.c4
-rw-r--r--generic/tclCmdAH.c14
-rw-r--r--generic/tclCmdIL.c6
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--generic/tclCompExpr.c30
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclDecls.h69
-rw-r--r--generic/tclDictObj.c6
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclInt.h15
-rw-r--r--generic/tclMain.c4
-rw-r--r--generic/tclNamesp.c10
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclProc.c20
-rwxr-xr-xgeneric/tclStrToD.c4
-rw-r--r--generic/tclStringObj.c34
-rw-r--r--generic/tclStubInit.c8
-rw-r--r--generic/tclTimer.c6
-rw-r--r--generic/tclUtil.c6
-rw-r--r--unix/tclUnixFCmd.c4
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 <dgp@users.sourceforge.net>
+ 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 <tclInt.h>
@@ -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;
}
generated by cgit v0.12 at 2024-11-01 12:51:15 (GMT)