diff options
Diffstat (limited to 'generic/tclConfig.c')
| -rw-r--r-- | generic/tclConfig.c | 68 |
1 files changed, 34 insertions, 34 deletions
diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 28853a1..0bbac5b 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -4,7 +4,7 @@ * This file provides the facilities which allow Tcl and other packages * to embed configuration information into their binary libraries. * - * Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net> + * Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -41,10 +41,13 @@ typedef struct QCCD { * Static functions in this file: */ -static Tcl_ObjCmdProc QueryConfigObjCmd; -static Tcl_CmdDeleteProc QueryConfigDelete; -static Tcl_InterpDeleteProc ConfigDictDeleteProc; +static int QueryConfigObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + struct Tcl_Obj *CONST *objv); +static void QueryConfigDelete(ClientData clientData); static Tcl_Obj * GetConfigDict(Tcl_Interp *interp); +static void ConfigDictDeleteProc(ClientData clientData, + Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -66,21 +69,21 @@ 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. */ - const Tcl_Config *configuration, /* Embedded configuration. */ - const char *valEncoding) /* Name of the encoding used to store the + 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; - const Tcl_Config *cfg; + Tcl_Config *cfg; QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; if (valEncoding) { - cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1); + cdPtr->encoding = ckalloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; @@ -143,7 +146,7 @@ Tcl_RegisterConfig( */ Tcl_DStringInit(&cmdName); - TclDStringAppendLiteral(&cmdName, "::"); + Tcl_DStringAppend(&cmdName, "::", -1); Tcl_DStringAppend(&cmdName, pkgName, -1); /* @@ -161,10 +164,10 @@ Tcl_RegisterConfig( } } - TclDStringAppendLiteral(&cmdName, "::pkgconfig"); + Tcl_DStringAppend(&cmdName, "::pkgconfig", -1); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), - QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { + QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) { Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } @@ -178,10 +181,10 @@ Tcl_RegisterConfig( * QueryConfigObjCmd -- * * Implementation of "::<package>::pkgconfig", the command to query - * configuration information embedded into a library. + * configuration information embedded into a binary library. * * Results: - * A standard Tcl result. + * A standard tcl result. * * Side effects: * See the manual for what this command does. @@ -194,13 +197,13 @@ QueryConfigObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv) + struct Tcl_Obj *CONST *objv) { - QCCD *cdPtr = (QCCD *)clientData; + QCCD *cdPtr = (QCCD *) clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; int n, index; - static const char *const subcmdStrings[] = { + static CONST char *subcmdStrings[] = { "get", "list", NULL }; enum subcmds { @@ -208,10 +211,10 @@ QueryConfigObjCmd( }; Tcl_DString conv; Tcl_Encoding venc = NULL; - const char *value; + CONST char *value; if ((objc < 2) || (objc > 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?"); + Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0, @@ -227,9 +230,7 @@ QueryConfigObjCmd( * present. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); - Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", - TclGetString(pkgName), (void *)NULL); + Tcl_SetResult(interp, "package not known", TCL_STATIC); return TCL_ERROR; } @@ -242,9 +243,7 @@ QueryConfigObjCmd( if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", - TclGetString(objv[2]), (void *)NULL); + Tcl_SetResult(interp, "key not known", TCL_STATIC); return TCL_ERROR; } @@ -275,9 +274,8 @@ QueryConfigObjCmd( listPtr = Tcl_NewListObj(n, NULL); if (!listPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create list", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); + Tcl_SetResult(interp, "insufficient memory to create list", + TCL_STATIC); return TCL_ERROR; } @@ -323,16 +321,16 @@ static void QueryConfigDelete( ClientData clientData) { - QCCD *cdPtr = (QCCD *)clientData; + QCCD *cdPtr = (QCCD *) clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { - ckfree(cdPtr->encoding); + ckfree((char *)cdPtr->encoding); } - ckfree(cdPtr); + ckfree((char *)cdPtr); } /* @@ -356,7 +354,7 @@ static Tcl_Obj * GetConfigDict( Tcl_Interp *interp) { - Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL); + Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL); if (pDB == NULL) { pDB = Tcl_NewDictObj(); @@ -389,9 +387,11 @@ GetConfigDict( static void ConfigDictDeleteProc( ClientData clientData, /* Pointer to Tcl_Obj. */ - TCL_UNUSED(Tcl_Interp *)) + Tcl_Interp *interp) /* Interpreter being deleted. */ { - Tcl_DecrRefCount((Tcl_Obj *)clientData); + Tcl_Obj *pDB = (Tcl_Obj *) clientData; + + Tcl_DecrRefCount(pDB); } /* |