summaryrefslogtreecommitdiffstats
path: root/generic/tclConfig.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclConfig.c')
-rw-r--r--generic/tclConfig.c65
1 files changed, 35 insertions, 30 deletions
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 28549ed..a4ba71a 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -42,7 +42,7 @@ typedef struct QCCD {
static int QueryConfigObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- struct Tcl_Obj *CONST *objv);
+ struct Tcl_Obj *const *objv);
static void QueryConfigDelete(ClientData clientData);
static Tcl_Obj * GetConfigDict(Tcl_Interp *interp);
static void ConfigDictDeleteProc(ClientData clientData,
@@ -68,18 +68,17 @@ void
Tcl_RegisterConfig(
Tcl_Interp *interp, /* Interpreter the configuration command is
* registered in. */
- CONST char *pkgName, /* Name of the package registering the
+ const char *pkgName, /* Name of the package registering the
* embedded configuration. ASCII, thus in
* UTF-8 too. */
- Tcl_Config *configuration, /* Embedded configuration. */
- CONST char *valEncoding) /* Name of the encoding used to store the
+ const Tcl_Config *configuration, /* Embedded configuration. */
+ const char *valEncoding) /* Name of the encoding used to store the
* configuration values, ASCII, thus UTF-8. */
{
- Tcl_Obj *pDB, *pkgDict;
Tcl_DString cmdName;
- Tcl_Config *cfg;
+ const Tcl_Config *cfg;
Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
- QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));
+ QCCD *cdPtr = ckalloc(sizeof(QCCD));
cdPtr->interp = interp;
cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
@@ -105,14 +104,14 @@ Tcl_RegisterConfig(
*/
if (venc != NULL) {
+ Tcl_Obj *pkgDict, *pDB = GetConfigDict(interp);
+
/*
* Retrieve package specific configuration...
*/
- pDB = GetConfigDict(interp);
-
if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
- || (pkgDict == NULL)) {
+ || (pkgDict == NULL)) {
pkgDict = Tcl_NewDictObj();
} else if (Tcl_IsShared(pkgDict)) {
pkgDict = Tcl_DuplicateObj(pkgDict);
@@ -124,8 +123,8 @@ 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);
+ 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
@@ -133,7 +132,7 @@ Tcl_RegisterConfig(
*/
Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
- Tcl_NewStringObj(convValue, -1));
+ Tcl_NewStringObj(convValue, -1));
Tcl_DStringFree(&conv);
}
@@ -156,7 +155,7 @@ Tcl_RegisterConfig(
*/
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "::", -1);
+ TclDStringAppendLiteral(&cmdName, "::");
Tcl_DStringAppend(&cmdName, pkgName, -1);
/*
@@ -174,11 +173,11 @@ Tcl_RegisterConfig(
}
}
- Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+ TclDStringAppendLiteral(&cmdName, "::pkgconfig");
if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
- QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) {
- Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
+ QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
+ Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
"Unable to create query command for package configuration");
}
@@ -207,13 +206,13 @@ QueryConfigObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
- struct Tcl_Obj *CONST *objv)
+ struct Tcl_Obj *const *objv)
{
- QCCD *cdPtr = (QCCD *) clientData;
+ QCCD *cdPtr = clientData;
Tcl_Obj *pkgName = cdPtr->pkg;
Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
int n, index;
- static const char *subcmdStrings[] = {
+ static const char *const subcmdStrings[] = {
"get", "list", NULL
};
enum subcmds {
@@ -221,7 +220,7 @@ QueryConfigObjCmd(
};
if ((objc < 2) || (objc > 3)) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
@@ -232,12 +231,14 @@ QueryConfigObjCmd(
pDB = GetConfigDict(interp);
if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
|| pkgDict == NULL) {
- /*
+ /*
* Maybe a Tcl_Panic is better, because the package data has to be
* present.
*/
- Tcl_SetResult(interp, "package not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
+ Tcl_GetString(pkgName), NULL);
return TCL_ERROR;
}
@@ -248,9 +249,11 @@ QueryConfigObjCmd(
return TCL_ERROR;
}
- if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK
+ if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
|| val == NULL) {
- Tcl_SetResult(interp, "key not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
+ Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
}
@@ -267,8 +270,9 @@ QueryConfigObjCmd(
listPtr = Tcl_NewListObj(n, NULL);
if (!listPtr) {
- Tcl_SetResult(interp, "insufficient memory to create list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "insufficient memory to create list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
@@ -314,12 +318,13 @@ static void
QueryConfigDelete(
ClientData clientData)
{
- QCCD *cdPtr = (QCCD *) clientData;
+ QCCD *cdPtr = clientData;
Tcl_Obj *pkgName = cdPtr->pkg;
Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
+
Tcl_DictObjRemove(NULL, pDB, pkgName);
Tcl_DecrRefCount(pkgName);
- ckfree((char *)cdPtr);
+ ckfree(cdPtr);
}
/*
@@ -378,7 +383,7 @@ ConfigDictDeleteProc(
ClientData clientData, /* Pointer to Tcl_Obj. */
Tcl_Interp *interp) /* Interpreter being deleted. */
{
- Tcl_Obj *pDB = (Tcl_Obj *) clientData;
+ Tcl_Obj *pDB = clientData;
Tcl_DecrRefCount(pDB);
}