Tcl Source Code

    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
				 * configuration values, ASCII, thus UTF-8. */
{
    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->pkg = Tcl_NewStringObj(pkgName, -1);

    /*
     * Phase I: Adding the provided information to the internal database of
     * package meta data. Only if we have an ok encoding.
     *
     * Phase II: Create a command for querying this database, specific to the
     * package registerting its configuration. This is the approved interface
     * in TIP 59. In the future a more general interface should be done, as
     * followup to TIP 59. Simply because our database is now general across
     * packages, and not a structure tied to one package.
     *
     * Note, the created command will have a reference through its clientdata.
     */

    Tcl_IncrRefCount(cdPtr->pkg);

    /*
     * For venc == NULL aka bogus encoding we skip the step setting up the
     * dictionaries visible at Tcl level. I.e. they are not filled
     */

    if (venc != NULL) {


	/*
	 * Retrieve package specific configuration...
	 */

	pDB = GetConfigDict(interp);

	if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
	    || (pkgDict == NULL)) {
	    pkgDict = Tcl_NewDictObj();
	} else if (Tcl_IsShared(pkgDict)) {
	    pkgDict = Tcl_DuplicateObj(pkgDict);
	}

	/*
	 * Extend the package configuration...
	 */

	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);
	}

	/*
	 * We're now done with the encoding, so drop it.
	 */

	}
    }

    Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);

    if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
	    QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) {
        Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
		"Unable to create query command for package configuration");
    }

    Tcl_DStringFree(&cmdName);
}

/*

    int objc,
    struct Tcl_Obj *CONST *objv)
{
    QCCD *cdPtr = (QCCD *) clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    int n, index;
    static const char *subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    };

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    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);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetResult(interp, "key not known", TCL_STATIC);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, val);
	return TCL_OK;

static void
QueryConfigDelete(
    ClientData clientData)
{
    QCCD *cdPtr = (QCCD *) clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    ckfree((char *)cdPtr);
}

/*
 *-------------------------------------------------------------------------