diff options
Diffstat (limited to 'generic/tclConfig.c')
| -rw-r--r-- | generic/tclConfig.c | 95 |
1 files changed, 43 insertions, 52 deletions
diff --git a/generic/tclConfig.c b/generic/tclConfig.c index e8c7be6..e1336f2 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclConfig.c,v 1.3 2003/06/10 20:35:48 andreas_kupries Exp $ + * RCS: @(#) $Id: tclConfig.c,v 1.4 2003/11/01 01:20:34 dkf Exp $ */ #include "tclInt.h" @@ -189,26 +189,23 @@ Tcl_RegisterConfig (interp, pkgName, configuration, valEncoding) */ static int -QueryConfigObjCmd (clientData, interp, objc, objv) +QueryConfigObjCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; int objc; - struct Tcl_Obj * CONST * objv; + struct Tcl_Obj * CONST *objv; { - Tcl_Obj* pkgName = (Tcl_Obj*) clientData; - Tcl_Obj* pDB; - Tcl_Obj* pkgDict; - Tcl_Obj* val; + Tcl_Obj *pkgName = (Tcl_Obj*) clientData; + Tcl_Obj *pDB, *pkgDict, *val; Tcl_DictSearch s; int n, i, res, done, index; - Tcl_Obj* key; - Tcl_Obj** vals; + Tcl_Obj *key, **vals; static CONST char *subcmdStrings[] = { "get", "list", NULL }; enum subcmds { - CFG_GET, CFG_LIST + CFG_GET, CFG_LIST }; if ((objc < 2) || (objc > 3)) { @@ -220,61 +217,55 @@ QueryConfigObjCmd (clientData, interp, objc, objv) return TCL_ERROR; } - pDB = GetConfigDict (interp); - res = Tcl_DictObjGet (interp, pDB, pkgName, &pkgDict); - if ((res != TCL_OK) || (pkgDict == NULL)) { + pDB = GetConfigDict(interp); + res = Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict); + if (res!=TCL_OK || pkgDict==NULL) { /* Maybe a panic is better, because the package data has to be present */ - Tcl_SetObjResult (interp, Tcl_NewStringObj ("package not known", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); return TCL_ERROR; } switch ((enum subcmds) index) { - case CFG_GET: - if (objc != 3) { - Tcl_WrongNumArgs (interp, 0, NULL, "get key"); - return TCL_ERROR; - } - - res = Tcl_DictObjGet (interp, pkgDict, objv [2], &val); - if ((res != TCL_OK) || (val == NULL)) { - Tcl_SetObjResult (interp, Tcl_NewStringObj ("key not known", -1)); - return TCL_ERROR; - } - - Tcl_SetObjResult (interp, val); - return TCL_OK; + case CFG_GET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 0, NULL, "get key"); + return TCL_ERROR; + } + res = Tcl_DictObjGet(interp, pkgDict, objv [2], &val); + if (res!=TCL_OK || val==NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); + return TCL_ERROR; + } - case CFG_LIST: - if (objc != 2) { - Tcl_WrongNumArgs (interp, 0, NULL, "list"); - return TCL_ERROR; - } + Tcl_SetObjResult(interp, val); + return TCL_OK; - Tcl_DictObjSize (interp, pkgDict, &n); - if (n == 0) { - Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); - return TCL_OK; - } + case CFG_LIST: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 0, NULL, "list"); + return TCL_ERROR; + } - vals = (Tcl_Obj**) ckalloc (n * sizeof (Tcl_Obj*)); + Tcl_DictObjSize(interp, pkgDict, &n); + if (n == 0) { + Tcl_SetObjResult(interp, Tcl_NewListObj(0, NULL)); + return TCL_OK; + } - for (i = 0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done); - !done; - Tcl_DictObjNext (&s, &key, NULL, &done), i++) { - if (done) break; - vals [i] = key; - } - Tcl_DictObjDone (&s); + vals = (Tcl_Obj**) ckalloc(n * sizeof(Tcl_Obj*)); - Tcl_SetObjResult (interp, Tcl_NewListObj (n, vals)); - ckfree ((char*) vals); + for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done); + !done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) { + vals[i] = key; + } - return TCL_OK; + Tcl_SetObjResult(interp, TclNewListObjDirect(n, vals)); + return TCL_OK; - default: - Tcl_Panic ("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This can't happen"); - break; + default: + Tcl_Panic("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This can't happen"); + break; } return TCL_ERROR; } |