source: trunk/optimizer/src/rp_tcloptions.c @ 897

/*
 * ----------------------------------------------------------------------
 *  rp_tcloptions
 *
 *  This library is used to implement configuration options for the
 *  Tcl API used in Rappture.  It lets you define a series of
 *  configuration options like the ones used for Tk widgets, and
 *  provides functions to process them.
 *
 * ======================================================================
 *  AUTHOR:  Michael McLennan, Purdue University
 *  Copyright (c) 2008  Purdue Research Foundation
 *
 *  See the file "license.terms" for information on usage and
 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ======================================================================
 */
#include "rp_tcloptions.h"
#include <string.h>
#include <malloc.h>

/*
 *  Built-in types:
 */
RpCustomTclOptionParse RpOption_ParseInt;
RpCustomTclOptionGet RpOption_GetInt;
RpTclOptionType RpOption_Int = {
    "integer", RpOption_ParseInt, RpOption_GetInt, NULL
};

RpCustomTclOptionParse RpOption_ParseDouble;
RpCustomTclOptionGet RpOption_GetDouble;
RpTclOptionType RpOption_Double = {
    "double", RpOption_ParseDouble, RpOption_GetDouble, NULL
};

RpCustomTclOptionParse RpOption_ParseString;
RpCustomTclOptionGet RpOption_GetString;
RpCustomTclOptionCleanup RpOption_CleanupString;
RpTclOptionType RpOption_String = {
    "string", RpOption_ParseString, RpOption_GetString, RpOption_CleanupString
};

RpCustomTclOptionParse RpOption_ParseList;
RpCustomTclOptionGet RpOption_GetList;
RpCustomTclOptionCleanup RpOption_CleanupList;
RpTclOptionType RpOption_List = {
    "list", RpOption_ParseList, RpOption_GetList, RpOption_CleanupList
};

/*
 * ------------------------------------------------------------------------
 *  RpTclOptionsProcess()
 *
 *  Used internally to handle options processing for all optimization
 *  parameters.  Expects a list of "-switch value" parameters in the
 *  (objc,objv) arguments, and processes them according to the given
 *  specs.  Returns TCL_OK if successful.  If anything goes wrong, it
 *  leaves an error message in the interpreter and returns TCL_ERROR.
 * ------------------------------------------------------------------------
 */
int
RpTclOptionsProcess(interp, objc, objv, options, cdata)
    Tcl_Interp *interp;           /* interpreter for errors */
    int objc;                     /* number of args to process */
    Tcl_Obj *CONST objv[];        /* arg values to process */
    RpTclOption *options;         /* specification for known options */
    ClientData cdata;             /* option values inserted in here */
{
    int n, status;
    RpTclOption *spec;
    char *opt;

    for (n=0; n < objc; n++) {
        opt = Tcl_GetStringFromObj(objv[n], (int*)NULL);

        for (spec=options; spec->optname; spec++) {
            if (strcmp(opt,spec->optname) == 0) {
                /* found matching option spec! */
                if (n+1 >= objc) {
                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                        "missing value for option \"", spec->optname, "\"",
                        (char*)NULL);
                    return TCL_ERROR;
                }

                status = (*spec->typePtr->parseProc)(interp, objv[n+1], cdata,
                    spec->offset);

                if (status != TCL_OK) {
                    return TCL_ERROR;
                }
                n++;     /* skip over value just processed */
                break;   /* indicate that arg was handled */
            }
        }
        if (spec->optname == NULL) {
            char *sep = "";
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "bad option \"", opt, "\": should be ", (char*)NULL);
            for (spec=options; spec->optname; spec++) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    sep, spec->optname, (char*)NULL);
                sep = ", ";
            }
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  RpTclOptionGet()
 *
 *  Used internally to query the value of an option associated with
 *  an optimization parameter.  Returns TCL_OK along with the current
 *  value in the interpreter.  If the desired option name is not
 *  recognized or anything else goes wrong, it returns TCL_ERROR along
 *  with an error message.
 * ------------------------------------------------------------------------
 */
int
RpTclOptionGet(interp, options, cdata, desiredOpt)
    Tcl_Interp *interp;           /* interp for result or errors */
    RpTclOption *options;         /* specification for known options */
    ClientData cdata;             /* option values are found in here */
    char *desiredOpt;             /* look for this option name */
{
    RpTclOption *spec;
    char *sep;

    for (spec=options; spec->optname; spec++) {
        if (strcmp(desiredOpt,spec->optname) == 0) {
            /* found matching option spec! */
            return (*spec->typePtr->getProc)(interp, cdata, spec->offset);
        }
    }

    /* oops! desired option name not found */
    sep = "";
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
        "bad option \"", desiredOpt, "\": should be ", (char*)NULL);
    for (spec=options; spec->optname; spec++) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            sep, spec->optname, (char*)NULL);
        sep = ", ";
    }
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *  RpTclOptionsCleanup()
 *
 *  Used internally to free all memory associated with various values
 *  configured via the options package.  Frees any allocated memory
 *  and resets values to their null state.
 * ------------------------------------------------------------------------
 */
void
RpTclOptionsCleanup(options, cdata)
    RpTclOption *options;         /* specification for known options */
    ClientData cdata;             /* option values are found in here */
{
    RpTclOption *spec;

    for (spec=options; spec->optname; spec++) {
        if (spec->typePtr->cleanupProc) {
            (*spec->typePtr->cleanupProc)(cdata, spec->offset);
        }
    }
}

/*
 * ======================================================================
 *  INTEGER
 * ======================================================================
 */
int
RpOption_ParseInt(interp, valObj, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    Tcl_Obj *valObj;     /* set option to this new value */
    ClientData cdata;    /* save in this data structure */
    int offset;          /* save at this offset in cdata */
{
    int *ptr = (int*)(cdata+offset);
    if (Tcl_GetIntFromObj(interp, valObj, ptr) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

int
RpOption_GetInt(interp, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    ClientData cdata;    /* get from this data structure */
    int offset;          /* get from this offset in cdata */
{
    int *ptr = (int*)(cdata+offset);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(*ptr));
    return TCL_OK;
}

/*
 * ======================================================================
 *  DOUBLE
 * ======================================================================
 */
int
RpOption_ParseDouble(interp, valObj, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    Tcl_Obj *valObj;     /* set option to this new value */
    ClientData cdata;    /* save in this data structure */
    int offset;          /* save at this offset in cdata */
{
    double *ptr = (double*)(cdata+offset);
    if (Tcl_GetDoubleFromObj(interp, valObj, ptr) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

int
RpOption_GetDouble(interp, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    ClientData cdata;    /* get from this data structure */
    int offset;          /* get from this offset in cdata */
{
    double *ptr = (double*)(cdata+offset);
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(*ptr));
    return TCL_OK;
}

/*
 * ======================================================================
 *  STRING
 * ======================================================================
 */
int
RpOption_ParseString(interp, valObj, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    Tcl_Obj *valObj;     /* set option to this new value */
    ClientData cdata;    /* save in this data structure */
    int offset;          /* save at this offset in cdata */
{
    char **ptr = (char**)(cdata+offset);
    char *value = Tcl_GetStringFromObj(valObj, (int*)NULL);
    *ptr = strdup(value);
    return TCL_OK;
}

int
RpOption_GetString(interp, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    ClientData cdata;    /* get from this data structure */
    int offset;          /* get from this offset in cdata */
{
    char *ptr = (char*)(cdata+offset);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(ptr,-1));
    return TCL_OK;
}

void
RpOption_CleanupString(cdata, offset)
    ClientData cdata;    /* cleanup in this data structure */
    int offset;          /* cleanup at this offset in cdata */
{
    char **ptr = (char**)(cdata+offset);
    if (*ptr != NULL) {
        free((char*)(*ptr));
        *ptr = NULL;
    }
}

/*
 * ======================================================================
 *  LIST
 * ======================================================================
 */
int
RpOption_ParseList(interp, valObj, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    Tcl_Obj *valObj;     /* set option to this new value */
    ClientData cdata;    /* save in this data structure */
    int offset;          /* save at this offset in cdata */
{
    int j;
    int vc; Tcl_Obj **vv;
    char *value, **allowedValues;

    if (Tcl_ListObjGetElements(interp, valObj, &vc, &vv) != TCL_OK) {
        return TCL_ERROR;
    }

    /* transfer them to an array of char* values */
    allowedValues = (char**)malloc((vc+1)*(sizeof(char*)));
    for (j=0; j < vc; j++) {
        value = Tcl_GetStringFromObj(vv[j], (int*)NULL);
        allowedValues[j] = strdup(value);
    }
    allowedValues[j] = NULL;

    *(char***)(cdata+offset) = allowedValues;
    return TCL_OK;
}

int
RpOption_GetList(interp, cdata, offset)
    Tcl_Interp *interp;  /* interpreter handling this request */
    ClientData cdata;    /* get from this data structure */
    int offset;          /* get from this offset in cdata */
{
    int n;
    char **ptr = *(char***)(cdata+offset);
    Tcl_ResetResult(interp);
    for (n=0; ptr[n]; n++) {
        Tcl_AppendElement(interp, ptr[n]);
    }
    return TCL_OK;
}

void
RpOption_CleanupList(cdata, offset)
    ClientData cdata;    /* cleanup in this data structure */
    int offset;          /* cleanup at this offset in cdata */
{
    int n;
    char **ptr = *(char***)(cdata+offset);
    for (n=0; ptr[n]; n++) {
        free((char*)(ptr[n]));
        ptr[n] = NULL;
    }
    free((char*)ptr);
    *(char***)(cdata+offset) = NULL;
}