chemshell_qchem / blob
1 #include <stdio.h>
2 #include <string.h>
3 #include <dutil.h>
4 #include <objects.h>
5 #include "tcl.h"
6 #include "chemsh.h"
8 extern int bannerflag;
9 extern int printargflag;
11 /***********************************************************************
12 *
13 * argument parsing code for args to chemsh commands
14 *
15 * a=b - sets variable a in the calling procedure to b
16 * a= {b c d} or to {b c d}
17 *
18 * a=b : {x=y c=d} - sets a=b in the calling procedure to b, and sets
19 * a=b:x=y a_arg to the contents of the following list (with
20 * spaces around : and = )
21 * a:{x=y} sets a_arg to the x = y
22 *
23 * also checks if a is in a list of valid arguments
24 *
25 * there is some messing about - for example in TCL does not recognise
26 * the {} in
27 * a=b:{c=d f=g}
28 *
29 * as defining a list (because there is no preceding space( - we allow this
30 * searching for the \'s TCL adds and removing them.
31 *
32 ***********************************************************************/
34 #define ARG_UNUSED 0
35 #define ARG_NAME 1
36 #define ARG_VALUE 2
37 #define ARG_EQ 3
38 #define ARG_COLON 4
39 #define ARG_COLON_NAME 5
40 #define ARG_COLON_VALUE 6
43 #define WHITESPACE 0
44 #define INWORD 1
45 #define PROTECT 2
46 #define NEWWORD { l = New(struct list_struct); listtail->next = l; l->prev = listtail; l->next = NULL; l->stat = ARG_UNUSED; listtail = l; s=p ; status=INWORD; }
48 #define SAVEWORD(i) { for(q=s,b=buff;q<=p+(i);q++,b++)*b=*q; *b = '\0'; strcpym(&l->element,buff); status=WHITESPACE; }
50 struct list_struct {
51 struct list_struct *next;
52 struct list_struct *prev;
53 int stat;
54 char *element;
55 };
57 int parsearg(clientData, interp, argc, argv)
58 ClientData clientData;
59 Tcl_Interp *interp;
60 int argc;
61 const char *argv[];
62 {
63 int nlist;
64 const char **list = NULL;
65 char *arglist = NULL;
66 int iret;
67 char tempnam[100];
68 char tempstr[20];
69 char *tempval = NULL;
70 const char *list3[3];
71 char *p, *q, *b, *s;
72 static char buff[40960000];
73 int more, status, level, protectlevel;
74 char strbuffl[STRBUFFLEN];
75 int lencnt, len0;
77 struct list_struct *listhead, *listtail, *l, *splitter(), *ltmp;
79 /* edit each of the arguments 3 -> argc to add separators before and
80 after any colons and = symbols */
82 /* the second argument is a list of valid keywords for this
83 command - split it up to simplify checking */
85 /* print message */
86 push_module_name(interp,argv[1]);
88 if(printargflag){
89 printf("\n");
90 printf("Arguments to %s :",argv[1]);
91 len0 = lencnt=strlen(argv[1])+strlen("Arguments to :");
92 }
94 /* printf("arg lengths: ");
95 for(i=0;i<argc;i++){
96 printf("| %d",strlen(argv[i]));
97 }
98 printf("\n");
99 */
100 Tcl_SplitList(interp, argv[2], &nlist, &list);
102 /* now concatenate the command arguments into a single
103 TCL list, and then use a recursive scheme to split it again
105 with protection for lists in structures of the form
106 a = { b c} and a = b : { c = d }
107 */
109 arglist = Tcl_Merge(argc - 3, argv + 3);
111 listtail = listhead = New(struct list_struct);
112 listhead->prev =listhead->next = NULL;
113 strcpym(&listhead->element,"START");
115 /* main parsing loop */
116 level = 0;
117 p=arglist;
118 status=WHITESPACE;
119 more=1;
120 while(more){
121 switch (*p){
122 case '\0':
123 switch (status){
124 case INWORD:
125 SAVEWORD(-1);
126 break;
127 case WHITESPACE:
128 break;
129 default:
130 printf("parse error with null, status=%d\n",status);
131 printf(" current string %s\n",arglist);
132 goto err;
133 }
134 more = 0;
135 break;
136 case '\\': /* move over this character and the next */
137 switch (status){
138 case WHITESPACE:
139 NEWWORD;
140 break;
141 }
142 p+=2;
143 break;
144 case ':':
145 case '=':
146 switch (status){
147 case INWORD:
148 SAVEWORD(-1);
149 NEWWORD;
150 SAVEWORD(0);
151 status=PROTECT;
152 protectlevel = level;
153 break;
154 case WHITESPACE:
155 NEWWORD;
156 SAVEWORD(0);
157 status=PROTECT;
158 protectlevel = level;
159 break;
160 case PROTECT:
161 /* pass over */
162 break;
163 default:
164 printf("parse error with =, status %d\n",status);
165 printf(" current string %s\n",arglist);
166 goto err;
167 }
168 p++;
169 break;
170 case ' ':
171 case '\n':
172 case '\t':
173 switch (status){
174 case INWORD:
175 SAVEWORD(-1);
176 break;
177 case WHITESPACE:
178 break;
179 case PROTECT:
180 break;
181 default:
182 break;
183 }
184 p++;
185 break;
186 case '{':
187 level++;
188 switch (status){
189 case PROTECT:
190 p++;
191 NEWWORD;
192 for( ; *p && (*p != '}' || level != protectlevel+1 ) ;p++){
193 switch (*p){
194 case '}':
195 level--;
196 break;
197 case '{':
198 level++;
199 break;
200 }
201 }
202 if(!*p){ /* unlikely when passed from TCL */
203 printf("unmatched } \n");
204 goto err;
205 }
206 SAVEWORD(-1);
207 status=WHITESPACE;
208 break;
209 case INWORD:
210 SAVEWORD(-1);
211 status=WHITESPACE;
212 p++;
213 break;
214 case WHITESPACE:
215 p++;
216 break;
217 }
218 break;
219 case '}':
220 switch (status){
221 case INWORD:
222 SAVEWORD(-1);
223 status=WHITESPACE;
224 }
225 p++;
226 level--;
227 break;
228 default:
229 switch (status){
230 case WHITESPACE:
231 NEWWORD;
232 status=INWORD;
233 p++;
234 break;
235 case PROTECT: /* look for whitespace */
236 NEWWORD;
237 for(; *p != ' ' &&
238 *p != '\n' &&
239 *p != '\t' &&
240 *p != ':' &&
241 *p != '}' &&
242 *p; p++);
243 SAVEWORD(-1);
244 switch(*p){
245 case ' ':
246 case '\n':
247 case '\t':
248 status=WHITESPACE;
249 p++;
250 break;
251 case ':':
252 NEWWORD;
253 SAVEWORD(0);
254 status=PROTECT;
255 p++;
256 break;
257 case '}':
258 status=WHITESPACE;
259 break;
260 case '\0':
261 more=0;
262 break;
263 }
264 break;
265 default:
266 p++;
267 break;
268 }
269 }
270 }
272 /* printf("resultant level %d \n",level);
273 printf("resultant element list : \n");
274 for(l=listhead;l;l=l->next){
275 printf(" [%s]",l->element);
276 }
277 printf("\n");
278 */
279 /* now assign TCL variables based on the current list */
281 for(l = listhead->next; l ; l=l->next ){
282 if(!strcmp(l->element,"=")){
283 if(l->prev->stat || l->next->stat || l->stat){
284 printf("problem parsing =\n");
285 goto err;
286 }
287 if(check_arg(l->prev->element, list, nlist,argv[1])) goto err;
289 /* printf("parser setting %s %s\n", l->prev->element, l->next->element ); */
291 if(printargflag){
292 sprintf(strbuffl," %s=%s", l->prev->element, l->next->element);
293 if(lencnt + strlen(strbuffl) < 80){
294 printf("%s",strbuffl);
295 lencnt += strlen(strbuffl);
296 }else{
297 printf("\n");
298 for(lencnt=0;lencnt < len0;lencnt++)printf(" ");
299 printf("%s",strbuffl);
300 lencnt += strlen(strbuffl);
301 }
302 }
304 Tcl_SetVar(interp, l->prev->element,l->next->element,0);
305 l->prev->stat = ARG_NAME;
306 l->stat = ARG_EQ;
307 l->next->stat = ARG_VALUE;
308 l = l->next;
310 } else if(!strcmp(l->element,":")){
312 if(l->next->stat || l->stat){
313 printf("problem parsing =\n");
314 goto err;
315 }
317 /* first define the variable name */
318 if(l->prev->stat == ARG_VALUE){
320 /* a = b : c ... no need to check arg here as already done */
322 sprintf(tempnam,"%s_args",l->prev->prev->prev->element);
323 } else if (l->prev->stat == ARG_UNUSED){
325 /* a : c ... check that a is a valid argument first*/
327 if(check_arg(l->prev->element, list, nlist,argv[1])) goto err;
328 l->prev->stat = ARG_COLON_NAME;
329 sprintf(tempnam,"%s_args",l->prev->element);
330 }else{
331 printf("problem parsing :\n");
332 goto err;
333 }
335 /*
336 now its value - unpleasant bit here, as we could have been passed
337 ... : {a=b c=d} in which case we should capture a single list element
338 OR
339 ... : a = b where we have to group the a = b into a new list to store
341 the only difference is the presence of = in the next+1 argument.
343 */
345 l->stat = ARG_COLON;
346 l->next->stat = ARG_COLON_VALUE;
348 if(l->next->next && !strcmp(l->next->next->element,"=")){
350 list3[0] = l->next->element;
351 list3[1] = l->next->next->element;
352 list3[2] = l->next->next->next->element;
353 tempval = Tcl_Merge(3,list3);
354 Tcl_SetVar(interp, tempnam, tempval,0);
355 ckfree(tempval);
357 l->next->next->stat = ARG_COLON_VALUE;
358 l->next->next->next->stat = ARG_COLON_VALUE;
359 l = l->next->next->next;
360 }else{ /* pre-constructed list (or single field, currently illegal) */
361 Tcl_SetVar(interp, tempnam, l->next->element,0);
362 l = l->next;
363 }
364 }
365 }
367 /* sanity check that all elements have been interpreted */
369 for(l=listhead->next;l;l=l->next){
370 if(l->stat == ARG_UNUSED){
371 printf("syntax error - arg %s not associated with = or :\n",l->element);
372 goto err;
373 }
374 }
376 ok:
378 iret = TCL_OK;
379 goto leave;
381 err:
382 iret = TCL_ERROR;
383 goto leave;
385 leave:
386 sprintf(tempstr,"%d",iret);
387 Tcl_SetResult(interp, tempstr, TCL_VOLATILE);
389 if(list)ckfree((char *) list);
390 if(arglist)ckfree(arglist);
392 for(l=listhead;l;l=ltmp){
393 ckfree((char *) l->element);
394 ltmp = l->next;
395 ckfree((char *) l);
396 }
398 if(printargflag)printf("\n");
399 return iret;
400 }
402 /*
404 check that an argument is in the last of valid words
406 */
408 int check_arg(test,list,nlist,prog)
410 char *test;
411 int nlist;
412 char **list;
413 char *prog;
414 {
415 int i, j, ii, ok;
416 ok = 0;
417 for(ii=0;ii<nlist;ii++)if(!strcmp(test,list[ii])) ok = 1;
418 if(!ok){
419 printf("-------------------------------------------------------------------------------\n");
420 printf("error : unrecognized argument %s\n",test);
421 printf("-------------------------------------------------------------------------------\n");
422 printf("legal arguments to the %s script are \n",prog);
423 for(j=0,i=0;i<nlist;j++,i++) {
424 if(j==10){j=0; printf("\n"); }
425 printf("%s ",list[i]);
426 }
427 printf("\n");
428 printf("-------------------------------------------------------------------------------\n");
429 return -1;
430 }
431 return 0;
432 }
434 struct list_struct *splitter(interp, inlist, listhead, listtail)
435 char *inlist;
436 Tcl_Interp *interp;
437 struct list_struct *listhead, *listtail;
438 {
439 struct list_struct *l;
440 int nlist, i;
441 const char **list;
443 if( strcmp(listtail->element,"=") && strcmp(listtail->element,":")){
445 /* the previous element isn't = or :, so we try and split the
446 current one */
448 Tcl_SplitList(interp, inlist, &nlist, &list);
450 /* if the split has modified list, resplit the component parts */
452 if(nlist != 1 || strcmp(list[0],inlist) ){
454 /* re-parse each element */
455 for(i=0;i<nlist;i++){
456 listtail = splitter(interp,list[i],listhead,listtail);
457 }
458 return listtail;
459 }
461 /* free memory */
462 ckfree((char *) list);
464 }
465 /* parsing is complete - append element to list */
467 /* ieq = strst1(inlist,"=");
468 printf("ieq %d\n",ieq);
469 if(ieq && strcmp(inlist,"=") ){
470 printf("ieq x\n");
472 *(inlist+ieq-1)= NULL;
474 l = New(struct list_struct);
475 listtail->next = l;
476 l->prev = listtail;
477 l->next = NULL;
478 l->stat = ARG_UNUSED;
479 strcpym(&l->element,inlist);
480 listtail = l;
482 l = New(struct list_struct);
483 listtail->next = l;
484 l->prev = listtail;
485 l->next = NULL;
486 l->stat = ARG_UNUSED;
487 strcpym(&l->element,"=");
488 listtail = l;
490 l = New(struct list_struct);
491 listtail->next = l;
492 l->prev = listtail;
493 l->next = NULL;
494 l->stat = ARG_UNUSED;
495 strcpym(&l->element,inlist+ieq);
497 }else{ */
499 l = New(struct list_struct);
500 listtail->next = l;
501 l->prev = listtail;
502 l->next = NULL;
503 l->stat = ARG_UNUSED;
504 strcpym(&l->element,inlist);
506 return l;
508 }
510 /***********************************************************************
511 C-callable version - currently a Tcl_Eval of the above..
512 ***********************************************************************/
513 C_parsearg(interp,clientData,valid_args,argc,argv)
514 Tcl_Interp *interp;
515 char *clientData;
516 char *valid_args;
517 int argc;
518 const char *argv[];
519 {
520 char *arglist[4];
521 char *tmp;
523 /* build a dummy arg list */
524 arglist[0]="parsearg";
525 arglist[1]=clientData;
526 arglist[2]=valid_args;
527 arglist[3]=Tcl_Merge(argc-1,argv+1);
528 tmp = Tcl_Merge(4, arglist);
529 ckfree(arglist[3]) ;
530 if(Tcl_Eval(interp,tmp) != TCL_OK)return TCL_ERROR;
531 ckfree(tmp);
532 return TCL_OK;
533 }
537 /***********************************************************************
538 parsing lists
539 ***********************************************************************/
540 C_parse_integer_list(clientData,interp,argc,argv)
541 char *clientData;
542 Tcl_Interp *interp;
543 int argc;
544 const char *argv[];
545 {
546 int *result;
547 int members;
548 int nmax;
549 int nset;
550 int i;
551 char buff[10];
553 if(Tcl_GetInt(interp,argv[1],&nmax) != TCL_OK){
554 printf("parse_integer_list: first argument must be an integer (highest expected element)\n");
555 return TCL_ERROR;
556 }
557 nset = parse_integer_list3(argv[2],nmax, &members, &result);
559 if(nset < 0){
560 printf("parse_integer_list: could not decode list\n");
561 return TCL_ERROR;
562 }
564 Tcl_ResetResult(interp);
566 for(i=0;i<members;i++){
567 sprintf(buff,"%d ",result[i]);
568 Tcl_AppendResult(interp, buff, (char *) NULL);
569 }
570 ckfree((char *) result);
571 return TCL_OK;
572 }
