* generic/tcl.decls:

	* generic/tclDecls.h:
	* generic/tclStubInit.c:
	* generic/tclStringObj.c (Tcl_GetUnicodeFromObj): new function to
	parallel Tcl_GetStringFromObj (fix of an API oversight).

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. */