source: trunk/packages/optimizer/src/rp_tcloptions.c @ 1166

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

Optimization part is getting better. Fleshed out the plug-in for
PGApack, and integrated a first cut that includes the data handling.

File size: 13.3 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_ParseBoolean;
26RpCustomTclOptionGet RpOption_GetBoolean;
27RpTclOptionType RpOption_Boolean = {
28    "boolean", RpOption_ParseBoolean, RpOption_GetBoolean, NULL
29};
30
31RpCustomTclOptionParse RpOption_ParseInt;
32RpCustomTclOptionGet RpOption_GetInt;
33RpTclOptionType RpOption_Int = {
34    "integer", RpOption_ParseInt, RpOption_GetInt, NULL
35};
36
37RpCustomTclOptionParse RpOption_ParseDouble;
38RpCustomTclOptionGet RpOption_GetDouble;
39RpTclOptionType RpOption_Double = {
40    "double", RpOption_ParseDouble, RpOption_GetDouble, NULL
41};
42
43RpCustomTclOptionParse RpOption_ParseString;
44RpCustomTclOptionGet RpOption_GetString;
45RpCustomTclOptionCleanup RpOption_CleanupString;
46RpTclOptionType RpOption_String = {
47    "string", RpOption_ParseString, RpOption_GetString, RpOption_CleanupString
48};
49
50RpCustomTclOptionParse RpOption_ParseList;
51RpCustomTclOptionGet RpOption_GetList;
52RpCustomTclOptionCleanup RpOption_CleanupList;
53RpTclOptionType RpOption_List = {
54    "list", RpOption_ParseList, RpOption_GetList, RpOption_CleanupList
55};
56
57/*
58 * ------------------------------------------------------------------------
59 *  RpTclOptionsProcess()
60 *
61 *  Used internally to handle options processing for all optimization
62 *  parameters.  Expects a list of "-switch value" parameters in the
63 *  (objc,objv) arguments, and processes them according to the given
64 *  specs.  Returns TCL_OK if successful.  If anything goes wrong, it
65 *  leaves an error message in the interpreter and returns TCL_ERROR.
66 * ------------------------------------------------------------------------
67 */
68int
69RpTclOptionsProcess(interp, objc, objv, options, cdata)
70    Tcl_Interp *interp;           /* interpreter for errors */
71    int objc;                     /* number of args to process */
72    Tcl_Obj *CONST objv[];        /* arg values to process */
73    RpTclOption *options;         /* specification for known options */
74    ClientData cdata;             /* option values inserted in here */
75{
76    int n, status;
77    RpTclOption *spec;
78    char *opt;
79
80    for (n=0; n < objc; n++) {
81        opt = Tcl_GetStringFromObj(objv[n], (int*)NULL);
82
83        for (spec=options; spec->optname; spec++) {
84            if (strcmp(opt,spec->optname) == 0) {
85                /* found matching option spec! */
86                if (n+1 >= objc) {
87                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
88                        "missing value for option \"", spec->optname, "\"",
89                        (char*)NULL);
90                    return TCL_ERROR;
91                }
92
93                status = (*spec->typePtr->parseProc)(interp, objv[n+1], cdata,
94                    spec->offset);
95
96                if (status != TCL_OK) {
97                    return TCL_ERROR;
98                }
99                n++;     /* skip over value just processed */
100                break;   /* indicate that arg was handled */
101            }
102        }
103        if (spec->optname == NULL) {
104            char *sep = "";
105            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
106                "bad option \"", opt, "\": should be ", (char*)NULL);
107            for (spec=options; spec->optname; spec++) {
108                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
109                    sep, spec->optname, (char*)NULL);
110                sep = ", ";
111            }
112            return TCL_ERROR;
113        }
114    }
115    return TCL_OK;
116}
117
118/*
119 * ------------------------------------------------------------------------
120 *  RpTclOptionGet()
121 *
122 *  Used internally to query the value of an option associated with
123 *  an optimization parameter.  Returns TCL_OK along with the current
124 *  value in the interpreter.  If the desired option name is not
125 *  recognized or anything else goes wrong, it returns TCL_ERROR along
126 *  with an error message.
127 * ------------------------------------------------------------------------
128 */
129int
130RpTclOptionGet(interp, options, cdata, desiredOpt)
131    Tcl_Interp *interp;           /* interp for result or errors */
132    RpTclOption *options;         /* specification for known options */
133    ClientData cdata;             /* option values are found in here */
134    char *desiredOpt;             /* look for this option name */
135{
136    RpTclOption *spec;
137    char *sep;
138
139    for (spec=options; spec->optname; spec++) {
140        if (strcmp(desiredOpt,spec->optname) == 0) {
141            /* found matching option spec! */
142            return (*spec->typePtr->getProc)(interp, cdata, spec->offset);
143        }
144    }
145
146    /* oops! desired option name not found */
147    sep = "";
148    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
149        "bad option \"", desiredOpt, "\": should be ", (char*)NULL);
150    for (spec=options; spec->optname; spec++) {
151        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
152            sep, spec->optname, (char*)NULL);
153        sep = ", ";
154    }
155    return TCL_ERROR;
156}
157
158/*
159 * ------------------------------------------------------------------------
160 *  RpTclOptionsCleanup()
161 *
162 *  Used internally to free all memory associated with various values
163 *  configured via the options package.  Frees any allocated memory
164 *  and resets values to their null state.
165 * ------------------------------------------------------------------------
166 */
167void
168RpTclOptionsCleanup(options, cdata)
169    RpTclOption *options;         /* specification for known options */
170    ClientData cdata;             /* option values are found in here */
171{
172    RpTclOption *spec;
173
174    for (spec=options; spec->optname; spec++) {
175        if (spec->typePtr->cleanupProc) {
176            (*spec->typePtr->cleanupProc)(cdata, spec->offset);
177        }
178    }
179}
180
181/*
182 * ======================================================================
183 *  BOOLEAN
184 * ======================================================================
185 */
186int
187RpOption_ParseBoolean(interp, valObj, cdata, offset)
188    Tcl_Interp *interp;  /* interpreter handling this request */
189    Tcl_Obj *valObj;     /* set option to this new value */
190    ClientData cdata;    /* save in this data structure */
191    int offset;          /* save at this offset in cdata */
192{
193    int *ptr = (int*)(cdata+offset);
194    if (Tcl_GetBooleanFromObj(interp, valObj, ptr) != TCL_OK) {
195        return TCL_ERROR;
196    }
197    return TCL_OK;
198}
199
200int
201RpOption_GetBoolean(interp, cdata, offset)
202    Tcl_Interp *interp;  /* interpreter handling this request */
203    ClientData cdata;    /* get from this data structure */
204    int offset;          /* get from this offset in cdata */
205{
206    int *ptr = (int*)(cdata+offset);
207    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(*ptr));
208    return TCL_OK;
209}
210
211/*
212 * ======================================================================
213 *  INTEGER
214 * ======================================================================
215 */
216int
217RpOption_ParseInt(interp, valObj, cdata, offset)
218    Tcl_Interp *interp;  /* interpreter handling this request */
219    Tcl_Obj *valObj;     /* set option to this new value */
220    ClientData cdata;    /* save in this data structure */
221    int offset;          /* save at this offset in cdata */
222{
223    int *ptr = (int*)(cdata+offset);
224    if (Tcl_GetIntFromObj(interp, valObj, ptr) != TCL_OK) {
225        return TCL_ERROR;
226    }
227    return TCL_OK;
228}
229
230int
231RpOption_GetInt(interp, cdata, offset)
232    Tcl_Interp *interp;  /* interpreter handling this request */
233    ClientData cdata;    /* get from this data structure */
234    int offset;          /* get from this offset in cdata */
235{
236    int *ptr = (int*)(cdata+offset);
237    Tcl_SetObjResult(interp, Tcl_NewIntObj(*ptr));
238    return TCL_OK;
239}
240
241/*
242 * ======================================================================
243 *  DOUBLE
244 * ======================================================================
245 */
246int
247RpOption_ParseDouble(interp, valObj, cdata, offset)
248    Tcl_Interp *interp;  /* interpreter handling this request */
249    Tcl_Obj *valObj;     /* set option to this new value */
250    ClientData cdata;    /* save in this data structure */
251    int offset;          /* save at this offset in cdata */
252{
253    double *ptr = (double*)(cdata+offset);
254    if (Tcl_GetDoubleFromObj(interp, valObj, ptr) != TCL_OK) {
255        return TCL_ERROR;
256    }
257    return TCL_OK;
258}
259
260int
261RpOption_GetDouble(interp, cdata, offset)
262    Tcl_Interp *interp;  /* interpreter handling this request */
263    ClientData cdata;    /* get from this data structure */
264    int offset;          /* get from this offset in cdata */
265{
266    double *ptr = (double*)(cdata+offset);
267    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(*ptr));
268    return TCL_OK;
269}
270
271/*
272 * ======================================================================
273 *  STRING
274 * ======================================================================
275 */
276int
277RpOption_ParseString(interp, valObj, cdata, offset)
278    Tcl_Interp *interp;  /* interpreter handling this request */
279    Tcl_Obj *valObj;     /* set option to this new value */
280    ClientData cdata;    /* save in this data structure */
281    int offset;          /* save at this offset in cdata */
282{
283    char **ptr = (char**)(cdata+offset);
284    char *value = Tcl_GetStringFromObj(valObj, (int*)NULL);
285    *ptr = strdup(value);
286    return TCL_OK;
287}
288
289int
290RpOption_GetString(interp, cdata, offset)
291    Tcl_Interp *interp;  /* interpreter handling this request */
292    ClientData cdata;    /* get from this data structure */
293    int offset;          /* get from this offset in cdata */
294{
295    char *ptr = (char*)(cdata+offset);
296    Tcl_SetObjResult(interp, Tcl_NewStringObj(ptr,-1));
297    return TCL_OK;
298}
299
300void
301RpOption_CleanupString(cdata, offset)
302    ClientData cdata;    /* cleanup in this data structure */
303    int offset;          /* cleanup at this offset in cdata */
304{
305    char **ptr = (char**)(cdata+offset);
306    if (*ptr != NULL) {
307        free((char*)(*ptr));
308        *ptr = NULL;
309    }
310}
311
312/*
313 * ======================================================================
314 *  LIST
315 * ======================================================================
316 */
317int
318RpOption_ParseList(interp, valObj, cdata, offset)
319    Tcl_Interp *interp;  /* interpreter handling this request */
320    Tcl_Obj *valObj;     /* set option to this new value */
321    ClientData cdata;    /* save in this data structure */
322    int offset;          /* save at this offset in cdata */
323{
324    int j;
325    int vc; Tcl_Obj **vv;
326    char *value, **allowedValues;
327
328    if (Tcl_ListObjGetElements(interp, valObj, &vc, &vv) != TCL_OK) {
329        return TCL_ERROR;
330    }
331
332    /* transfer them to an array of char* values */
333    allowedValues = (char**)malloc((vc+1)*(sizeof(char*)));
334    for (j=0; j < vc; j++) {
335        value = Tcl_GetStringFromObj(vv[j], (int*)NULL);
336        allowedValues[j] = strdup(value);
337    }
338    allowedValues[j] = NULL;
339
340    *(char***)(cdata+offset) = allowedValues;
341    return TCL_OK;
342}
343
344int
345RpOption_GetList(interp, cdata, offset)
346    Tcl_Interp *interp;  /* interpreter handling this request */
347    ClientData cdata;    /* get from this data structure */
348    int offset;          /* get from this offset in cdata */
349{
350    int n;
351    char **ptr = *(char***)(cdata+offset);
352    Tcl_ResetResult(interp);
353    for (n=0; ptr[n]; n++) {
354        Tcl_AppendElement(interp, ptr[n]);
355    }
356    return TCL_OK;
357}
358
359void
360RpOption_CleanupList(cdata, offset)
361    ClientData cdata;    /* cleanup in this data structure */
362    int offset;          /* cleanup at this offset in cdata */
363{
364    int n;
365    char **ptr = *(char***)(cdata+offset);
366    for (n=0; ptr[n]; n++) {
367        free((char*)(ptr[n]));
368        ptr[n] = NULL;
369    }
370    free((char*)ptr);
371    *(char***)(cdata+offset) = NULL;
372}
373
374/*
375 * ======================================================================
376 *  CHOICES
377 * ======================================================================
378 */
379int
380RpOption_ParseChoices(interp, valObj, cdata, offset)
381    Tcl_Interp *interp;  /* interpreter handling this request */
382    Tcl_Obj *valObj;     /* set option to this new value */
383    ClientData cdata;    /* save in this data structure */
384    int offset;          /* save at this offset in cdata */
385{
386    char **ptr = (char**)(cdata+offset);
387    char *value = Tcl_GetStringFromObj(valObj, (int*)NULL);
388    *ptr = strdup(value);
389    return TCL_OK;
390}
391
392int
393RpOption_GetChoices(interp, cdata, offset)
394    Tcl_Interp *interp;  /* interpreter handling this request */
395    ClientData cdata;    /* get from this data structure */
396    int offset;          /* get from this offset in cdata */
397{
398    char *ptr = (char*)(cdata+offset);
399    Tcl_SetObjResult(interp, Tcl_NewStringObj(ptr,-1));
400    return TCL_OK;
401}
402
403void
404RpOption_CleanupChoices(cdata, offset)
405    ClientData cdata;    /* cleanup in this data structure */
406    int offset;          /* cleanup at this offset in cdata */
407{
408    char **ptr = (char**)(cdata+offset);
409    if (*ptr != NULL) {
410        free((char*)(*ptr));
411        *ptr = NULL;
412    }
413}
Note: See TracBrowser for help on using the repository browser.