diff options
| -rw-r--r-- | generic/tcl.decls | 8 | ||||
| -rw-r--r-- | generic/tclDecls.h | 10 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 59 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 |
4 files changed, 76 insertions, 4 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 33358e3..fc27323 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.46 2001/04/24 20:59:17 kennykb Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.47 2001/05/15 21:30:46 hobbs Exp $ library tcl @@ -1515,6 +1515,12 @@ declare 433 generic { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) } +# introduced in 8.4a3 +declare 434 generic { + Tcl_UniChar * Tcl_GetUnicodeFromObj (Tcl_Obj *objPtr, int *lengthPtr) +} + + ############################################################################## # Define the platform specific public Tcl interface. These functions are diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5d1639b..b1d3ee8 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.48 2001/04/24 20:59:18 kennykb Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.49 2001/05/15 21:30:46 hobbs Exp $ */ #ifndef _TCLDECLS @@ -1363,6 +1363,9 @@ EXTERN int Tcl_AttemptSetObjLength _ANSI_ARGS_(( /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread _ANSI_ARGS_(( Tcl_Channel channel)); +/* 434 */ +EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj * objPtr, + int * lengthPtr)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1864,6 +1867,7 @@ typedef struct TclStubs { char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 431 */ int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */ + Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 434 */ } TclStubs; #ifdef __cplusplus @@ -3648,6 +3652,10 @@ extern TclStubs *tclStubsPtr; #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #endif +#ifndef Tcl_GetUnicodeFromObj +#define Tcl_GetUnicodeFromObj \ + (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dbab4c7..d37b7ba 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.20 2001/04/04 16:07:21 kennykb Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.21 2001/05/15 21:30:46 hobbs Exp $ */ #include "tclInt.h" @@ -520,6 +520,63 @@ Tcl_GetUnicode(objPtr) /* *---------------------------------------------------------------------- * + * Tcl_GetUnicodeFromObj -- + * + * Get the Unicode form of the String object with length. If + * the object is not already a String object, it will be converted + * to one. If the String object does not have a Unicode rep, then + * one is create from the UTF string format. + * + * Results: + * Returns a pointer to the object's internal Unicode string. + * + * Side effects: + * Converts the object to have the String internal rep. + * + *---------------------------------------------------------------------- + */ + +Tcl_UniChar * +Tcl_GetUnicodeFromObj(objPtr, lengthPtr) + Tcl_Obj *objPtr; /* The object to find the unicode string for. */ + int *lengthPtr; /* If non-NULL, the location where the + * string rep's unichar length should be + * stored. If NULL, no length is stored. */ +{ + String *stringPtr; + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + + if ((stringPtr->numChars == -1) || (stringPtr->uallocated == 0)) { + + /* + * We haven't yet calculated the length, or all of the characters + * in the Utf string are 1 byte chars (so we didn't store the + * unicode str). Since this function must return a unicode string, + * and one has not yet been stored, force the Unicode to be + * calculated and stored now. + */ + + FillUnicodeRep(objPtr); + + /* + * We need to fetch the pointer again because we have just + * reallocated the structure to make room for the Unicode data. + */ + + stringPtr = GET_STRING(objPtr); + } + + if (lengthPtr != NULL) { + *lengthPtr = stringPtr->numChars; + } + return stringPtr->unicode; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetRange -- * * Create a Tcl Object that contains the chars between first and last diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 35fada8..0ce8ea7 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.48 2001/03/30 23:06:40 andreas_kupries Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.49 2001/05/15 21:30:46 hobbs Exp $ */ #include "tclInt.h" @@ -837,6 +837,7 @@ TclStubs tclStubs = { Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ + Tcl_GetUnicodeFromObj, /* 434 */ }; /* !END!: Do not edit above this line. */ |