diff options
Diffstat (limited to 'generic/tclConfig.c')
-rw-r--r-- | generic/tclConfig.c | 65 |
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); } |