summaryrefslogtreecommitdiffstats
path: root/generic/tclConfig.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-06-26 07:42:53 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-06-26 07:42:53 (GMT)
commitb7baefb37be1711dc8aefbbed9e9670b0926e1be (patch)
treeff6803454708bb81b4d00933974b1e0952746c35 /generic/tclConfig.c
parent61ab4e7385f66e8fbbfdae5b63d6548c62875ceb (diff)
downloadtcl-b7baefb37be1711dc8aefbbed9e9670b0926e1be.zip
tcl-b7baefb37be1711dc8aefbbed9e9670b0926e1be.tar.gz
tcl-b7baefb37be1711dc8aefbbed9e9670b0926e1be.tar.bz2
Proposed solution for [9b2e636361]
Diffstat (limited to 'generic/tclConfig.c')
-rw-r--r--generic/tclConfig.c44
1 files changed, 19 insertions, 25 deletions
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 28549ed..ffed6f2 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -26,14 +26,15 @@
#define ASSOC_KEY "tclPackageAboutDict"
/*
- * A ClientData struct for the QueryConfig command. Store the two bits
+ * A ClientData struct for the QueryConfig command. Store the three bits
* of data we need; the package name for which we store a config dict,
- * and the (Tcl_Interp *) in which it is stored.
+ * the (Tcl_Interp *) in which it is stored, and the encoding.
*/
typedef struct QCCD {
Tcl_Obj *pkg;
Tcl_Interp *interp;
+ CONST char *encoding;
} QCCD;
/*
@@ -78,10 +79,10 @@ Tcl_RegisterConfig(
Tcl_Obj *pDB, *pkgDict;
Tcl_DString cmdName;
Tcl_Config *cfg;
- Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));
cdPtr->interp = interp;
+ cdPtr->encoding = valEncoding;
cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
/*
@@ -104,7 +105,6 @@ Tcl_RegisterConfig(
* dictionaries visible at Tcl level. I.e. they are not filled
*/
- if (venc != NULL) {
/*
* Retrieve package specific configuration...
*/
@@ -123,32 +123,15 @@ Tcl_RegisterConfig(
*/
for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
- Tcl_DString conv;
- CONST char *convValue =
- Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
-
- /*
- * We know that the keys are in ASCII/UTF-8, so for them is no
- * conversion required.
- */
-
Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
- Tcl_NewStringObj(convValue, -1));
- Tcl_DStringFree(&conv);
+ Tcl_NewStringObj(cfg->value, -1));
}
/*
- * We're now done with the encoding, so drop it.
- */
-
- Tcl_FreeEncoding(venc);
-
- /*
* Write the changes back into the overall database.
*/
Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict);
- }
/*
* Now create the interface command for retrieval of the package
@@ -219,6 +202,9 @@ QueryConfigObjCmd(
enum subcmds {
CFG_GET, CFG_LIST
};
+ Tcl_DString conv;
+ Tcl_Encoding venc = NULL;
+ CONST char *value;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
@@ -237,7 +223,7 @@ QueryConfigObjCmd(
* present.
*/
- Tcl_SetResult(interp, "package not known", TCL_STATIC);
+ Tcl_SetResult(interp, "package not known", TCL_STATIC);
return TCL_ERROR;
}
@@ -254,7 +240,15 @@ QueryConfigObjCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, val);
+ if (cdPtr->encoding) {
+ venc = Tcl_GetEncoding(interp, cdPtr->encoding);
+ if (!venc) {
+ return TCL_ERROR;
+ }
+ }
+ value = Tcl_ExternalToUtfDString(venc, Tcl_GetString(val), -1, &conv);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ Tcl_DStringFree(&conv);
return TCL_OK;
case CFG_LIST:
@@ -361,7 +355,7 @@ GetConfigDict(
*
* This function is associated with the "Package About dict" assoc data
* for an interpreter; it is invoked when the interpreter is deleted in
- * order to free the information assoicated with any pending error
+ * order to free the information associated with any pending error
* reports.
*
* Results: