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

Last change on this file since 897 was 897, checked in by mmc, 15 years ago

Improved the Rappture optimization API to include Tcl bindings.
Added standard build/test stuff for Tcl libraries. Created a
plugin hook for optimization libraries like pgapack. The plugin
support still needs some work.

File size: 11.0 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  rp_tcloptions
4 *
5 *  This library is used to implement configuration options for the
6 *  Tcl API used in Rappture.  It lets you define a series of
7 *  configuration options like the ones used for Tk widgets, and
8 *  provides functions to process them.
9 *
10 * ======================================================================
11 *  AUTHOR:  Michael McLennan, Purdue University
12 *  Copyright (c) 2008  Purdue Research Foundation
13 *
14 *  See the file "license.terms" for information on usage and
15 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 * ======================================================================
17 */
18#include "rp_tcloptions.h"
19#include <string.h>
20#include <malloc.h>
21
22/*
23 *  Built-in types:
24 */
25RpCustomTclOptionParse RpOption_ParseInt;
26RpCustomTclOptionGet RpOption_GetInt;
27RpTclOptionType RpOption_Int = {
28    "integer", RpOption_ParseInt, RpOption_GetInt, NULL
29};
30
31RpCustomTclOptionParse RpOption_ParseDouble;
32RpCustomTclOptionGet RpOption_GetDouble;
33RpTclOptionType RpOption_Double = {
34    "double", RpOption_ParseDouble, RpOption_GetDouble, NULL
35};
36
37RpCustomTclOptionParse RpOption_ParseString;
38RpCustomTclOptionGet RpOption_GetString;
39RpCustomTclOptionCleanup RpOption_CleanupString;
40RpTclOptionType RpOption_String = {
41    "string", RpOption_ParseString, RpOption_GetString, RpOption_CleanupString
42};
43
44RpCustomTclOptionParse RpOption_ParseList;
45RpCustomTclOptionGet RpOption_GetList;
46RpCustomTclOptionCleanup RpOption_CleanupList;
47RpTclOptionType RpOption_List = {
48    "list", RpOption_ParseList, RpOption_GetList, RpOption_CleanupList
49};
50
51/*
52 * ------------------------------------------------------------------------
53 *  RpTclOptionsProcess()
54 *
55 *  Used internally to handle options processing for all optimization
56 *  parameters.  Expects a list of "-switch value" parameters in the
57 *  (objc,objv) arguments, and processes them according to the given
58 *  specs.  Returns TCL_OK if successful.  If anything goes wrong, it
59 *  leaves an error message in the interpreter and returns TCL_ERROR.
60 * ------------------------------------------------------------------------
61 */
62int
63RpTclOptionsProcess(interp, objc, objv, options, cdata)
64    Tcl_Interp *interp;           /* interpreter for errors */
65    int objc;                     /* number of args to process */
66    Tcl_Obj *CONST objv[];        /* arg values to process */
67    RpTclOption *options;         /* specification for known options */
68    ClientData cdata;             /* option values inserted in here */
69{
70    int n, status;
71    RpTclOption *spec;
72    char *opt;
73
74    for (n=0; n < objc; n++) {
75        opt = Tcl_GetStringFromObj(objv[n], (int*)NULL);
76
77        for (spec=options; spec->optname; spec++) {
78            if (strcmp(opt,spec->optname) == 0) {
79                /* found matching option spec! */
80                if (n+1 >= objc) {
81                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
82                        "missing value for option \"", spec->optname, "\"",
83                        (char*)NULL);
84                    return TCL_ERROR;
85                }
86
87                status = (*spec->typePtr->parseProc)(interp, objv[n+1], cdata,
88                    spec->offset);
89
90                if (status != TCL_OK) {
91                    return TCL_ERROR;
92                }
93                n++;     /* skip over value just processed */
94                break;   /* indicate that arg was handled */
95            }
96        }
97        if (spec->optname == NULL) {
98            char *sep = "";
99            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
100                "bad option \"", opt, "\": should be ", (char*)NULL);
101            for (spec=options; spec->optname; spec++) {
102                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
103                    sep, spec->optname, (char*)NULL);
104                sep = ", ";
105            }
106            return TCL_ERROR;
107        }
108    }
109    return TCL_OK;
110}
111
112/*
113 * ------------------------------------------------------------------------
114 *  RpTclOptionGet()
115 *
116 *  Used internally to query the value of an option associated with
117 *  an optimization parameter.  Returns TCL_OK along with the current
118 *  value in the interpreter.  If the desired option name is not
119 *  recognized or anything else goes wrong, it returns TCL_ERROR along
120 *  with an error message.
121 * ------------------------------------------------------------------------
122 */
123int
124RpTclOptionGet(interp, options, cdata, desiredOpt)
125    Tcl_Interp *interp;           /* interp for result or errors */
126    RpTclOption *options;         /* specification for known options */
127    ClientData cdata;             /* option values are found in here */
128    char *desiredOpt;             /* look for this option name */
129{
130    RpTclOption *spec;
131    char *sep;
132
133    for (spec=options; spec->optname; spec++) {
134        if (strcmp(desiredOpt,spec->optname) == 0) {
135            /* found matching option spec! */
136            return (*spec->typePtr->getProc)(interp, cdata, spec->offset);
137        }
138    }
139
140    /* oops! desired option name not found */
141    sep = "";
142    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
143        "bad option \"", desiredOpt, "\": should be ", (char*)NULL);
144    for (spec=options; spec->optname; spec++) {
145        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
146            sep, spec->optname, (char*)NULL);
147        sep = ", ";
148    }
149    return TCL_ERROR;
150}
151
152/*
153 * ------------------------------------------------------------------------
154 *  RpTclOptionsCleanup()
155 *
156 *  Used internally to free all memory associated with various values
157 *  configured via the options package.  Frees any allocated memory
158 *  and resets values to their null state.
159 * ------------------------------------------------------------------------
160 */
161void
162RpTclOptionsCleanup(options, cdata)
163    RpTclOption *options;         /* specification for known options */
164    ClientData cdata;             /* option values are found in here */
165{
166    RpTclOption *spec;
167
168    for (spec=options; spec->optname; spec++) {
169        if (spec->typePtr->cleanupProc) {
170            (*spec->typePtr->cleanupProc)(cdata, spec->offset);
171        }
172    }
173}
174
175/*
176 * ======================================================================
177 *  INTEGER
178 * ======================================================================
179 */
180int
181RpOption_ParseInt(interp, valObj, cdata, offset)
182    Tcl_Interp *interp;  /* interpreter handling this request */
183    Tcl_Obj *valObj;     /* set option to this new value */
184    ClientData cdata;    /* save in this data structure */
185    int offset;          /* save at this offset in cdata */
186{
187    int *ptr = (int*)(cdata+offset);
188    if (Tcl_GetIntFromObj(interp, valObj, ptr) != TCL_OK) {
189        return TCL_ERROR;
190    }
191    return TCL_OK;
192}
193
194int
195RpOption_GetInt(interp, cdata, offset)
196    Tcl_Interp *interp;  /* interpreter handling this request */
197    ClientData cdata;    /* get from this data structure */
198    int offset;          /* get from this offset in cdata */
199{
200    int *ptr = (int*)(cdata+offset);
201    Tcl_SetObjResult(interp, Tcl_NewIntObj(*ptr));
202    return TCL_OK;
203}
204
205/*
206 * ======================================================================
207 *  DOUBLE
208 * ======================================================================
209 */
210int
211RpOption_ParseDouble(interp, valObj, cdata, offset)
212    Tcl_Interp *interp;  /* interpreter handling this request */
213    Tcl_Obj *valObj;     /* set option to this new value */
214    ClientData cdata;    /* save in this data structure */
215    int offset;          /* save at this offset in cdata */
216{
217    double *ptr = (double*)(cdata+offset);
218    if (Tcl_GetDoubleFromObj(interp, valObj, ptr) != TCL_OK) {
219        return TCL_ERROR;
220    }
221    return TCL_OK;
222}
223
224int
225RpOption_GetDouble(interp, cdata, offset)
226    Tcl_Interp *interp;  /* interpreter handling this request */
227    ClientData cdata;    /* get from this data structure */
228    int offset;          /* get from this offset in cdata */
229{
230    double *ptr = (double*)(cdata+offset);
231    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(*ptr));
232    return TCL_OK;
233}
234
235/*
236 * ======================================================================
237 *  STRING
238 * ======================================================================
239 */
240int
241RpOption_ParseString(interp, valObj, cdata, offset)
242    Tcl_Interp *interp;  /* interpreter handling this request */
243    Tcl_Obj *valObj;     /* set option to this new value */
244    ClientData cdata;    /* save in this data structure */
245    int offset;          /* save at this offset in cdata */
246{
247    char **ptr = (char**)(cdata+offset);
248    char *value = Tcl_GetStringFromObj(valObj, (int*)NULL);
249    *ptr = strdup(value);
250    return TCL_OK;
251}
252
253int
254RpOption_GetString(interp, cdata, offset)
255    Tcl_Interp *interp;  /* interpreter handling this request */
256    ClientData cdata;    /* get from this data structure */
257    int offset;          /* get from this offset in cdata */
258{
259    char *ptr = (char*)(cdata+offset);
260    Tcl_SetObjResult(interp, Tcl_NewStringObj(ptr,-1));
261    return TCL_OK;
262}
263
264void
265RpOption_CleanupString(cdata, offset)
266    ClientData cdata;    /* cleanup in this data structure */
267    int offset;          /* cleanup at this offset in cdata */
268{
269    char **ptr = (char**)(cdata+offset);
270    if (*ptr != NULL) {
271        free((char*)(*ptr));
272        *ptr = NULL;
273    }
274}
275
276/*
277 * ======================================================================
278 *  LIST
279 * ======================================================================
280 */
281int
282RpOption_ParseList(interp, valObj, cdata, offset)
283    Tcl_Interp *interp;  /* interpreter handling this request */
284    Tcl_Obj *valObj;     /* set option to this new value */
285    ClientData cdata;    /* save in this data structure */
286    int offset;          /* save at this offset in cdata */
287{
288    int j;
289    int vc; Tcl_Obj **vv;
290    char *value, **allowedValues;
291
292    if (Tcl_ListObjGetElements(interp, valObj, &vc, &vv) != TCL_OK) {
293        return TCL_ERROR;
294    }
295
296    /* transfer them to an array of char* values */
297    allowedValues = (char**)malloc((vc+1)*(sizeof(char*)));
298    for (j=0; j < vc; j++) {
299        value = Tcl_GetStringFromObj(vv[j], (int*)NULL);
300        allowedValues[j] = strdup(value);
301    }
302    allowedValues[j] = NULL;
303
304    *(char***)(cdata+offset) = allowedValues;
305    return TCL_OK;
306}
307
308int
309RpOption_GetList(interp, cdata, offset)
310    Tcl_Interp *interp;  /* interpreter handling this request */
311    ClientData cdata;    /* get from this data structure */
312    int offset;          /* get from this offset in cdata */
313{
314    int n;
315    char **ptr = *(char***)(cdata+offset);
316    Tcl_ResetResult(interp);
317    for (n=0; ptr[n]; n++) {
318        Tcl_AppendElement(interp, ptr[n]);
319    }
320    return TCL_OK;
321}
322
323void
324RpOption_CleanupList(cdata, offset)
325    ClientData cdata;    /* cleanup in this data structure */
326    int offset;          /* cleanup at this offset in cdata */
327{
328    int n;
329    char **ptr = *(char***)(cdata+offset);
330    for (n=0; ptr[n]; n++) {
331        free((char*)(ptr[n]));
332        ptr[n] = NULL;
333    }
334    free((char*)ptr);
335    *(char***)(cdata+offset) = NULL;
336}
Note: See TracBrowser for help on using the repository browser.