From aec64f2eb71190635715a1a136214e6d4730cf42 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 2 Nov 2006 16:57:53 +0000 Subject: * generic/tclCmdAH.c: Further revisions to produce the routines * generic/tclInt.h: TclFormat() and TclAppendFormatToObj() that * generic/tclNamesp.c: accept (objc, objv) arguments rather than * generic/tclStringObj.c: any varargs stuff. FossilOrigin-Name: e66b307b7d8a10cd0ad6f6906bd530bce6a4d845 --- ChangeLog | 5 +++ generic/tclCmdAH.c | 10 ++--- generic/tclInt.h | 12 +++--- generic/tclNamesp.c | 6 +-- generic/tclStringObj.c | 101 +++++-------------------------------------------- 5 files changed, 26 insertions(+), 108 deletions(-) diff --git a/ChangeLog b/ChangeLog index f68bcd7..a56069a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -6,6 +6,11 @@ 2006-11-02 Don Porter + * generic/tclCmdAH.c: Further revisions to produce the routines + * generic/tclInt.h: TclFormat() and TclAppendFormatToObj() that + * generic/tclNamesp.c: accept (objc, objv) arguments rather than + * generic/tclStringObj.c: any varargs stuff. + * generic/tclBasic.c: Further revised TclAppendPrintToObj() and * generic/tclCkalloc.c: TclObjPrintf() routines to panic when unable * generic/tclCmdAH.c: to complete their formatting operations, rather diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 1ed975f..27cdcff 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.78 2006/11/02 15:58:04 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.79 2006/11/02 16:57:54 dgp Exp $ */ #include "tclInt.h" @@ -1881,15 +1881,11 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - resultPtr = Tcl_NewObj(); - Tcl_IncrRefCount(resultPtr); - if (TclAppendFormattedObjs(interp, resultPtr, TclGetString(objv[1]), - objc-2, objv+2) != TCL_OK) { - Tcl_DecrRefCount(resultPtr); + resultPtr = TclFormat(interp, TclGetString(objv[1]), objc-2, objv+2); + if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); return TCL_OK; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 540858e..54a27bc 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.291 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.292 2006/11/02 16:57:54 dgp Exp $ */ #ifndef _TCLINT @@ -2035,11 +2035,9 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ -MODULE_SCOPE int TclAppendFormattedObjs(Tcl_Interp *interp, - Tcl_Obj *appendObj, CONST char *format, - int objc, Tcl_Obj *CONST objv[]); MODULE_SCOPE int TclAppendFormatToObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, CONST char *format, ...); + 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); @@ -2092,6 +2090,8 @@ 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); @@ -2147,8 +2147,6 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); MODULE_SCOPE int TclNokia770Doubles(); -MODULE_SCOPE Tcl_Obj * TclObjFormat(Tcl_Interp *interp, - CONST char *format, ...); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Namespace *nsPtr, int flags); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 93a87ed..a33cffa 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.116 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.117 2006/11/02 16:57:54 dgp Exp $ */ #include "tclInt.h" @@ -4606,8 +4606,8 @@ NamespaceUpvarCmd( /* * The namespace does not exist, leave an error message. */ - Tcl_SetObjResult(interp, TclObjFormat(NULL, - "namespace \"%s\" does not exist", objv[2])); + Tcl_SetObjResult(interp, TclFormat(NULL, + "namespace \"%s\" does not exist", 1, objv+2)); return TCL_ERROR; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 9b06eb2..f4668d4 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.60 2006/11/02 15:58:09 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.61 2006/11/02 16:57:54 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -51,8 +51,6 @@ static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, static void AppendUtfToUtfRep(Tcl_Obj *objPtr, CONST char *bytes, int numBytes); static void FillUnicodeRep(Tcl_Obj *objPtr); -static int AppendFormatToObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST char *format, va_list argList); static void AppendPrintfToObjVA(Tcl_Obj *objPtr, CONST char *format, va_list argList); static void FreeStringInternalRep(Tcl_Obj *objPtr); @@ -1678,7 +1676,7 @@ Tcl_AppendStringsToObj( /* *---------------------------------------------------------------------- * - * TclAppendFormattedObjs -- + * TclAppendFormatToObj -- * * This function appends a list of Tcl_Obj's to a Tcl_Obj according to * the formatting instructions embedded in the format string. The @@ -1696,7 +1694,7 @@ Tcl_AppendStringsToObj( */ int -TclAppendFormattedObjs( +TclAppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, CONST char *format, @@ -1717,7 +1715,7 @@ TclAppendFormattedObjs( }; if (Tcl_IsShared(appendObj)) { - Tcl_Panic("%s called with shared object", "TclAppendFormattedObjs"); + Tcl_Panic("%s called with shared object", "TclAppendFormatToObj"); } Tcl_GetStringFromObj(appendObj, &originalLength); @@ -2293,83 +2291,7 @@ TclAppendFormattedObjs( /* *--------------------------------------------------------------------------- * - * AppendFormatToObjVA -- - * - * Populate the Unicode internal rep with the Unicode form of its string - * rep. The object must alread have a "String" internal rep. - * - * Results: - * None. - * - * Side effects: - * Reallocates the String internal rep. - * - *--------------------------------------------------------------------------- - */ - -static int -AppendFormatToObjVA( - Tcl_Interp *interp, - Tcl_Obj *objPtr, - CONST char *format, - va_list argList) -{ - int code, objc; - Tcl_Obj **objv, *element, *list = Tcl_NewObj(); - CONST char *p = format; - - Tcl_IncrRefCount(list); - while (*p != '\0') { - if (*p++ != '%') { - continue; - } - if (*p == '%') { - continue; - } - p++; - element = va_arg(argList, Tcl_Obj *); - Tcl_ListObjAppendElement(NULL, list, element); - } - Tcl_ListObjGetElements(NULL, list, &objc, &objv); - code = TclAppendFormattedObjs(interp, objPtr, format, objc, objv); - Tcl_DecrRefCount(list); - return code; -} - -/* - *--------------------------------------------------------------------------- - * - * TclAppendFormatToObj -- - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -int -TclAppendFormatToObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr, - CONST char *format, - ...) -{ - va_list argList; - int result; - - va_start(argList, format); - result = AppendFormatToObjVA(interp, objPtr, format, argList); - va_end(argList); - return result; -} - -/* - *--------------------------------------------------------------------------- - * - * TclObjFormat-- + * TclFormat-- * * Results: * A refcount zero Tcl_Obj. @@ -2381,18 +2303,15 @@ TclAppendFormatToObj( */ Tcl_Obj * -TclObjFormat( +TclFormat( Tcl_Interp *interp, CONST char *format, - ...) + int objc, + Tcl_Obj *CONST objv[]) { - va_list argList; int result; Tcl_Obj *objPtr = Tcl_NewObj(); - - va_start(argList, format); - result = AppendFormatToObjVA(interp, objPtr, format, argList); - va_end(argList); + result = TclAppendFormatToObj(interp, objPtr, format, objc, objv); if (result != TCL_OK) { Tcl_DecrRefCount(objPtr); return NULL; @@ -2535,7 +2454,7 @@ AppendPrintfToObjVA( } while (seekingConversion); } Tcl_ListObjGetElements(NULL, list, &objc, &objv); - code = TclAppendFormattedObjs(NULL, objPtr, format, objc, objv); + code = TclAppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { Tcl_Panic("Unable to format \"%s\" with supplied arguments: %s", format, Tcl_GetString(list)); -- cgit v0.12