1*47943Sbostic /*-
2*47943Sbostic * Copyright (c) 1980 The Regents of the University of California.
3*47943Sbostic * All rights reserved.
424100Sjerry *
5*47943Sbostic * %sccs.include.proprietary.c%
624100Sjerry */
724100Sjerry
8*47943Sbostic #ifndef lint
9*47943Sbostic static char sccsid[] = "@(#)wsnmle.c 5.4 (Berkeley) 04/12/91";
10*47943Sbostic #endif /* not lint */
11*47943Sbostic
1224100Sjerry /*
1324100Sjerry * name-list write
1424100Sjerry */
1524100Sjerry
1624100Sjerry #include "fio.h"
1724100Sjerry #include "lio.h"
1824100Sjerry #include "nmlio.h"
1942027Sbostic #include <string.h>
2024100Sjerry
2124100Sjerry int l_write(), t_putc();
2224100Sjerry LOCAL char nml_wrt[] = "namelist write";
2324100Sjerry char namelistkey_ = '&';
2424100Sjerry
s_wsne(a)2524100Sjerry s_wsne(a) namelist_arglist *a;
2624100Sjerry {
2724100Sjerry int n, first;
2824100Sjerry struct namelistentry *entries;
2924100Sjerry int *dimptr, *spans, ndim, nelem, offset, vlen, vtype, number;
3024100Sjerry char *nmlist_nm, *cptr;
3124100Sjerry
3224100Sjerry nmlist_nm = a->namelist->namelistname;
3324100Sjerry reading = NO;
3424100Sjerry formatted = NAMELIST;
3524100Sjerry fmtbuf = "ext namelist io";
3624100Sjerry if(n=c_le(a,WRITE)) return(n);
3724100Sjerry putn = t_putc;
3824100Sjerry line_len = LINE-1; /* so we can always add a comma */
3924100Sjerry curunit->uend = NO;
4024100Sjerry leof = NO;
4124100Sjerry if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, nml_wrt)
4224100Sjerry
4324100Sjerry /* begin line with " &namelistname " */
4424100Sjerry if(recpos != 0)
4524145Sjerry PUT('\n'); /* PUT() adds blank */
4624100Sjerry PUT(namelistkey_);
4724100Sjerry while(*nmlist_nm != '\0') PUT(*nmlist_nm++);
4824100Sjerry PUT(' ');
4924100Sjerry
5024100Sjerry /* now loop through entries writing them out */
5124100Sjerry entries = a->namelist->names;
5224100Sjerry first = 1;
5324100Sjerry while( entries->varname[0] != 0 )
5424100Sjerry {
5524100Sjerry /* write out variable name and '=' */
5624100Sjerry cptr = entries->varname;
5724100Sjerry chk_len( strlen(cptr) + 3);
5824100Sjerry if(first++ != 1) PUT(',');
5924100Sjerry PUT(' ');
6024100Sjerry while( *cptr != '\0') PUT(*cptr++);
6124100Sjerry PUT('=');
6224100Sjerry
6324100Sjerry /* how many value are there? */
6424100Sjerry if( (dimptr = entries->dimp) == NULL ) number = 1;
6524100Sjerry else number = dimptr[1];
6624100Sjerry /* what is element length? */
6724100Sjerry vlen = entries->typelen;
6824100Sjerry /* get type */
6924100Sjerry vtype = entries->type;
7024100Sjerry
7124100Sjerry if(n=l_write( &number, entries->varaddr, vlen, vtype ))
7224100Sjerry err(errflag,n,nml_wrt);
7324100Sjerry entries++;
7424100Sjerry }
7524100Sjerry PUT('\n');
7624100Sjerry PUT(namelistkey_);
7724100Sjerry cptr = "end\n";
7824100Sjerry while(*cptr != '\0') PUT(*cptr++);
7924100Sjerry return(OK);
8024100Sjerry }
8124100Sjerry
8224100Sjerry LOCAL
t_putc(c)8324100Sjerry t_putc(c) char c;
8424100Sjerry {
8524100Sjerry if(c=='\n') {
8624100Sjerry recpos=0;
8724100Sjerry } else if(recpos == 0) {
8824100Sjerry putc(' ',cf); /* for namelist, */
8924100Sjerry recpos = 2; /* never print in column 1 */
9024100Sjerry } else {
9124100Sjerry recpos++;
9224100Sjerry }
9324100Sjerry putc(c,cf);
9424100Sjerry return(OK);
9524100Sjerry }
96