| Ticket UUID: | 414778 | |||
| Title: | Auto wrap Tcl_UtfToExternal | |||
| Type: | Patch | Version: | None | |
| Submitter: | vcc | Created on: | 2001-04-09 01:43:18 | |
| Subsystem: | 44. UTF-8 Strings | Assigned To: | andreas_kupries | |
| Priority: | 5 Medium | Severity: | ||
| Status: | Closed | Last Modified: | 2004-07-17 03:47:24 | |
| Resolution: | Fixed | Closed By: | andreas_kupries | |
| Closed on: | 2004-07-16 20:47:24 | |||
| Description: |
I wrote some packages use C/C++ , I must use
Tcl_UtfToExternal convert in
args form UTF-8 to cp936 to made process chinese word
in erveywhere. so I
hacked Tcl source code to auto do it.
It just simple, I add a flag needUtfToExternal to
struct Command and
Tcl_Interp,Interp, and add a command
needutftoexternal. if a C write package
need auto convert UTF to External just set the flag.
like:
needutftoexternal 1
load mypackage.dll
......
--- ./tcl.h.orig Sun Apr 8 12:49:44 2001
+++ ./tcl.h Sun Apr 8 12:54:18 2001
@@ -369,6 +369,7 @@
int errorLine; /* When TCL_ERROR is
returned, this gives
* the line number
within the command where
* the error occurred
(1 if first line). */
+ int needUtfToExternal; /* Zero means the the C
Command not need
UtfToExternal, other values need.*/
} Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
--- ./tclBasic.c.orig Sun Apr 8 12:49:45 2001
+++ ./tclBasic.c Sun Apr 8 12:59:52 2001
@@ -449,6 +449,7 @@
cmdPtr->deleteData = (ClientData) NULL;
cmdPtr->deleted = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->needUtfToExternal = 0;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
@@ -1524,6 +1525,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
@@ -1685,6 +1689,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
--- ./tclExecute.c.orig Sun Apr 8 12:49:46 2001
+++ ./tclExecute.c Sun Apr 8 15:35:17 2001
@@ -842,8 +842,40 @@
iPtr->cmdCount++;
DECACHE_STACK_INFO();
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_UtfToExternalDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
interp,
objc, objv);
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_ExternalToUtfDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
if (Tcl_AsyncReady()) {
result = Tcl_AsyncInvoke(interp, result);
}
--- ./tclInt.h.orig Sun Apr 8 12:49:47 2001
+++ ./tclInt.h Sun Apr 8 12:57:36 2001
@@ -1031,6 +1031,7 @@
* command. The list is used to remove all
* those imported commands when deleting
* this "real" command. */
+ int needUtfToExternal; /* 1 : args need
Tcl_UtfToExternal */
} Command;
/*
@@ -1106,6 +1107,9 @@
int errorLine; /* When TCL_ERROR is returned,
this gives
* the line number in the command where the
* error occurred (1 means first line). */
+
+ int needUtfToExternal;
+
struct TclStubs *stubTable;
/* Pointer to the exported Tcl stub table.
* On previous versions of Tcl this is a
--- ./tclInterp.c.orig Sun Apr 8 12:49:47 2001
+++ ./tclInterp.c Sun Apr 8 14:27:29 2001
@@ -191,6 +191,30 @@
static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
+int Tcl_InterpNeedUtfToExternalCmd _ANSI_ARGS_
((ClientData clientData,
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST
objv[]));
+
+
+int
+Tcl_InterpNeedUtfToExternalCmd(clientData, interp,
objc, objv)
+ ClientData clientData; /* Unused. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ Tcl_Obj* result = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(result,interp->needUtfToExternal);
+
+ if (objc >= 2) {
+ int need ;
+ Tcl_GetIntFromObj(interp,objv[1],&need);
+ interp->needUtfToExternal = need;
+ }
+
+ return TCL_OK;
+}
+
/*
*------------------------------------------------------
---------------------
*
@@ -231,13 +255,17 @@
slavePtr->slaveInterp = interp;
slavePtr->interpCmd = NULL;
Tcl_InitHashTable(&slavePtr->aliasTable,
TCL_STRING_KEYS);
-
+
+ interp->needUtfToExternal = 0;
+
Tcl_CreateObjCommand(interp, "interp",
Tcl_InterpObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "needutftoexternal",
Tcl_InterpNeedUtfToExternalCmd, NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc,
NULL);
return TCL_OK;
}
+
/*
*------------------------------------------------------
---------------------
*
--- ./tcl.h.orig Sun Apr 8 12:49:44 2001
+++ ./tcl.h Sun Apr 8 12:54:18 2001
@@ -369,6 +369,7 @@
int errorLine; /* When TCL_ERROR is
returned, this gives
* the line number
within the command where
* the error occurred
(1 if first line). */
+ int needUtfToExternal; /* Zero means the the C
Command not need
UtfToExternal, other values need.*/
} Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
--- ./tclBasic.c.orig Sun Apr 8 12:49:45 2001
+++ ./tclBasic.c Sun Apr 8 12:59:52 2001
@@ -449,6 +449,7 @@
cmdPtr->deleteData = (ClientData) NULL;
cmdPtr->deleted = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->needUtfToExternal = 0;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
@@ -1524,6 +1525,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
@@ -1685,6 +1689,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
--- ./tclExecute.c.orig Sun Apr 8 12:49:46 2001
+++ ./tclExecute.c Sun Apr 8 15:35:17 2001
@@ -842,8 +842,40 @@
iPtr->cmdCount++;
DECACHE_STACK_INFO();
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_UtfToExternalDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
interp,
objc, objv);
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_ExternalToUtfDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
if (Tcl_AsyncReady()) {
result = Tcl_AsyncInvoke(interp, result);
}
--- ./tclInt.h.orig Sun Apr 8 12:49:47 2001
+++ ./tclInt.h Sun Apr 8 12:57:36 2001
@@ -1031,6 +1031,7 @@
* command. The list is used to remove all
* those imported commands when deleting
* this "real" command. */
+ int needUtfToExternal; /* 1 : args need
Tcl_UtfToExternal */
} Command;
/*
@@ -1106,6 +1107,9 @@
int errorLine; /* When TCL_ERROR is returned,
this gives
* the line number in the command where the
* error occurred (1 means first line). */
+
+ int needUtfToExternal;
+
struct TclStubs *stubTable;
/* Pointer to the exported Tcl stub table.
* On previous versions of Tcl this is a
--- ./tclInterp.c.orig Sun Apr 8 12:49:47 2001
+++ ./tclInterp.c Sun Apr 8 14:27:29 2001
@@ -191,6 +191,30 @@
static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
+int Tcl_InterpNeedUtfToExternalCmd _ANSI_ARGS_
((ClientData clientData,
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST
objv[]));
+
+
+int
+Tcl_InterpNeedUtfToExternalCmd(clientData, interp,
objc, objv)
+ ClientData clientData; /* Unused. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ Tcl_Obj* result = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(result,interp->needUtfToExternal);
+
+ if (objc >= 2) {
+ int need ;
+ Tcl_GetIntFromObj(interp,objv[1],&need);
+ interp->needUtfToExternal = need;
+ }
+
+ return TCL_OK;
+}
+
/*
*------------------------------------------------------
---------------------
*
@@ -231,13 +255,17 @@
slavePtr->slaveInterp = interp;
slavePtr->interpCmd = NULL;
Tcl_InitHashTable(&slavePtr->aliasTable,
TCL_STRING_KEYS);
-
+
+ interp->needUtfToExternal = 0;
+
Tcl_CreateObjCommand(interp, "interp",
Tcl_InterpObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "needutftoexternal",
Tcl_InterpNeedUtfToExternalCmd, NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc,
NULL);
return TCL_OK;
}
+
/*
*------------------------------------------------------
---------------------
*
--- tcl.h.orig Sun Apr 8 12:49:44 2001
+++ tcl.h Sun Apr 8 12:54:18 2001
@@ -369,6 +369,7 @@
int errorLine; /* When TCL_ERROR is
returned, this gives
* the line number
within the command where
* the error occurred
(1 if first line). */
+ int needUtfToExternal; /* Zero means the the C
Command not need
UtfToExternal, other values need.*/
} Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
--- tclBasic.c.orig Sun Apr 8 12:49:45 2001
+++ tclBasic.c Sun Apr 8 12:59:52 2001
@@ -449,6 +449,7 @@
cmdPtr->deleteData = (ClientData) NULL;
cmdPtr->deleted = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->needUtfToExternal = 0;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
@@ -1524,6 +1525,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
@@ -1685,6 +1689,9 @@
*/
TclResetShadowedCmdRefs(interp, cmdPtr);
+
+ cmdPtr->needUtfToExternal = interp-
>needUtfToExternal;
+
return (Tcl_Command) cmdPtr;
}
--- tclExecute.c.orig Sun Apr 8 12:49:46 2001
+++ tclExecute.c Sun Apr 8 15:35:17 2001
@@ -842,8 +842,40 @@
iPtr->cmdCount++;
DECACHE_STACK_INFO();
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_UtfToExternalDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
interp,
objc, objv);
+
+ if (cmdPtr->needUtfToExternal) {
+ for (i = 0; i < objc; i++) {
+ if (objv[i]->typePtr == NULL && objv[i]->length>0
&& objv[i]->bytes) {
+ Tcl_DString ds;
+ int len;
+ Tcl_ExternalToUtfDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
+ len = Tcl_DStringLength(&ds);
+ memcpy(objv[i]->bytes,Tcl_DStringValue(&ds),len);
+ objv[i]->bytes[len] = 0;
+ objv[i]->length = len;
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
if (Tcl_AsyncReady()) {
result = Tcl_AsyncInvoke(interp, result);
}
--- tclInt.h.orig Sun Apr 8 12:49:47 2001
+++ tclInt.h Sun Apr 8 12:57:36 2001
@@ -1031,6 +1031,7 @@
* command. The list is used to remove all
* those imported commands when deleting
* this "real" command. */
+ int needUtfToExternal; /* 1 : args need
Tcl_UtfToExternal */
} Command;
/*
@@ -1106,6 +1107,9 @@
int errorLine; /* When TCL_ERROR is returned,
this gives
* the line number in the command where the
* error occurred (1 means first line). */
+
+ int needUtfToExternal;
+
struct TclStubs *stubTable;
/* Pointer to the exported Tcl stub table.
* On previous versions of Tcl this is a
--- tclInterp.c.orig Sun Apr 8 12:49:47 2001
+++ tclInterp.c Sun Apr 8 14:27:29 2001
@@ -191,6 +191,30 @@
static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
+int Tcl_InterpNeedUtfToExternalCmd _ANSI_ARGS_
((ClientData clientData,
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST
objv[]));
+
+
+int
+Tcl_InterpNeedUtfToExternalCmd(clientData, interp,
objc, objv)
+ ClientData clientData; /* Unused. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+
+ Tcl_Obj* result = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(result,interp->needUtfToExternal);
+
+ if (objc >= 2) {
+ int need ;
+ Tcl_GetIntFromObj(interp,objv[1],&need);
+ interp->needUtfToExternal = need;
+ }
+
+ return TCL_OK;
+}
+
/*
*------------------------------------------------------
---------------------
*
@@ -231,13 +255,17 @@
slavePtr->slaveInterp = interp;
slavePtr->interpCmd = NULL;
Tcl_InitHashTable(&slavePtr->aliasTable,
TCL_STRING_KEYS);
-
+
+ interp->needUtfToExternal = 0;
+
Tcl_CreateObjCommand(interp, "interp",
Tcl_InterpObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "needutftoexternal",
Tcl_InterpNeedUtfToExternalCmd, NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc,
NULL);
return TCL_OK;
}
+
/*
*------------------------------------------------------
---------------------
*
| |||
| User Comments: |
andreas_kupries added on 2004-07-17 03:47:24:
Logged In: YES user_id=75003 Added a note to the documentation of Tcl_CreateCommand, both head and 8.4 branches. davygrvy added on 2001-12-15 03:18:08: Logged In: YES
user_id=7549
Wei,
As a final note, Tcl_CreateObjCommand() is much prefered to
Tcl_CreateCommand(). I'm only assuming you are using
Tcl_CreateCommand() as I had a similar issue once.
If you are using Tcl_CreateObjCommand() already, yes, you
will need to prepare the string each and every time with
Tcl_UtfToExternalDString() as strings internally to Tcl are
meant to be in neutral UTF-8.
for (i = 0; i < objc; i++) {
...
Tcl_ExternalToUtfDString(NULL,objv[i]->bytes,objv
[i]->length,&ds);
...
}
In your patch, looping over the objv array and twiddling
with the bytes directly assumes each obj has a valid string
rep and kind of breaks the Tcl_Obj concept.
If you could show us an example of your extension code, I
could help advise a fix for you. If you are running on
windows only, you could use Tcl_WinUtfToTChar to prep the
string. This will also switch to use unicode if running on
NT.
Yes, this conversion stuff is tricky, but well worth the
effort to get right.
andreas_kupries added on 2001-12-15 02:25:03: Logged In: YES user_id=75003 Given that relink is required anyway I would opt for updating the documentation and mentioning this in the upgrade guide 7 -> 8.2. Especially there! davygrvy added on 2001-12-15 02:18:28: File Added - 14708: patch.txt Logged In: YES user_id=7549 Basically, an extension that works fine in 7.6, all of a sudden gets these funky UTF-8 special chars when run in 8.1+. It's interesting to note that to run in 8.1+, you need to re-link anyways. Change the docs or change TclInvokeStringCommand() to be back like it once was? I'm only bringing up the real issue. I can't be the one to make the descision. davygrvy added on 2001-12-15 01:52:09: Logged In: YES user_id=7549 TclInvokeStringCommand() in tclBasic.c (line 1735) is used for the Tcl_ObjCmdProc for Tcl_CmdProc commands as the global wrapper. wei's change should possibly go in here for changing the meaning of the argv[] array from UTF-8 back to system codepage (as in 7.6). Now I'm not saying I think the core needs a change for this, but I do agree that the behavior did change and wasn't documented. davygrvy added on 2001-12-15 01:09:57: Logged In: YES user_id=7549 Andreas, In a way I understand what he's doing. The old Tcl_CmdProc's argv[] array underhandedly changed to mean an array in UTF-8 in 8.1. It looks like wei is fixing argv[] to mean the old char* in system codepage. I did something similar once. I'll do some research and post back. andreas_kupries added on 2001-08-25 00:55:04: Logged In: YES user_id=75003 I do not believe that he is doing the right thing, but can't lay my finger on it. | |||
Attachments:
- patch.txt [download] added by davygrvy on 2001-12-15 02:18:28. [details]