diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 131 |
3 files changed, 136 insertions, 2 deletions
@@ -5,6 +5,10 @@ 2005-09-09 Don Porter <dgp@users.sourceforge.net> + * generic/tclInt.h: New internal routine TclObjPrintf() + * generic/tclStringObj.c: is similar to TclFormatObj() but + accepts arguments in non-Tcl_Obj format. + * generic/tclInt.h: New internal routines TclFormatObj() * generic/tclStringObj.c: and TclAppendFormattedObjs() to offer sprintf()-like means to append to Tcl_Obj. Work in progress toward diff --git a/generic/tclInt.h b/generic/tclInt.h index 25b4b78..689f95f 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.249 2005/09/09 15:44:27 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.250 2005/09/09 17:47:18 dgp Exp $ */ #ifndef _TCLINT @@ -2053,6 +2053,7 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Namespace *nsPtr, int flags); +MODULE_SCOPE int TclObjPrintf TCL_VARARGS(Tcl_Interp *, arg1); 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/tclStringObj.c b/generic/tclStringObj.c index f048540..be926fe 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.40 2005/09/09 17:19:19 kennykb Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.41 2005/09/09 17:47:19 dgp Exp $ */ #include "tclInt.h" @@ -54,6 +54,8 @@ static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr, static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static int FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp, va_list argList)); +static int ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp, + va_list argList)); static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)); @@ -2269,6 +2271,133 @@ TclFormatObj TCL_VARARGS_DEF(Tcl_Interp *,arg1) /* *--------------------------------------------------------------------------- * + * ObjPrintfVA -- + * + * Results: + * + * Side effects: + * + *--------------------------------------------------------------------------- + */ + +static int +ObjPrintfVA(interp, argList) + Tcl_Interp *interp; + va_list argList; +{ + int code, objc; + Tcl_Obj **objv, *element, *list = Tcl_NewObj(); + CONST char *format, *p; + Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *); + + if (objPtr == NULL) { + Tcl_Panic("TclObjPrintf: no Tcl_Obj to append to"); + } + + p = format = va_arg(argList, CONST char *); + if (format == NULL) { + Tcl_Panic("TclObjPrintf: no format string argument"); + } + + Tcl_IncrRefCount(list); + while (*p != '\0') { + int size = 0; + int seekingConversion = 1; + if (*p++ != '%') { + continue; + } + if (*p == '%') { + p++; + continue; + } + do { + switch (*p) { + + case '\0': + seekingConversion = 0; + break; + case 's': + Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj( + va_arg(argList, char *), -1)); + seekingConversion = 0; + break; + case 'c': + case 'i': + case 'u': + case 'd': + case 'o': + case 'x': + case 'X': + seekingConversion = 0; + switch (size) { + case -1: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( + (long int)va_arg(argList, short int))); + break; + case 0: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( + (long int)va_arg(argList, int))); + break; + case 1: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( + va_arg(argList, long int))); + break; + } + break; + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + va_arg(argList, double))); + seekingConversion = 0; + break; + case 'l': + size = 1; + p++; + break; + case 'h': + size = -1; + default: + p++; + } + } while (seekingConversion); + } + Tcl_ListObjGetElements(NULL, list, &objc, &objv); + code = TclAppendFormattedObjs(interp, objPtr, format, objc, objv); + Tcl_DecrRefCount(list); + return code; +} + +/* + *--------------------------------------------------------------------------- + * + * TclObjPrintf -- + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TclObjPrintf TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + va_list argList; + int result; + Tcl_Interp *interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList); + result = ObjPrintfVA(interp, argList); + va_end(argList); + return result; +} + +/* + *--------------------------------------------------------------------------- + * * FillUnicodeRep -- * * Populate the Unicode internal rep with the Unicode form of its string |