The R Project SVN – R – Diff – /branches/R-exp-API/src/gnome/dataentry.c



	nprotect = 0;/* count the PROTECT()s */
	PROTECT(indata = VectorToPairList(CAR(args))); nprotect++;
	PROTECT(colmodes = VectorToPairList(CADR(args))); nprotect++;
 
	if (!isList(indata) || !isList(colmodes))
		errorcall(call, "invalid argument");
 
	/* initialize the constants */
 
	bufp = buf;
	ne = 0;

				CAR(tvec) = ssNewVector(type, 100);
				TAG(tvec) = install("var1");
				LEVELS(CAR(tvec)) = 0;
			}
			else if (!isVector(CAR(tvec)))
				errorcall(call, "invalid type for value");
			else {
				if (TYPEOF(CAR(tvec)) != type)
					CAR(tvec) = coerceVector(CAR(tvec), type);
				LEVELS(CAR(tvec)) = LENGTH(CAR(tvec));
			}
			tvec2 = CDR(tvec2);
		}
	}
	else {
		errorcall(call, "invalid parameter");
	}
 
 
	/* start up the window, more initializing in here */
	if (initwin())
		errorcall(call, "invalid device");
 
	/* set up a context which will close the window if there is an error */
	begincontext(&cntxt, 8, R_NilValue, R_NilValue, R_NilValue, R_NilValue);
	cntxt.cend = &closewin;
 

			strp = EncodeElement(invec, vrow, 0);
			printstring(strp, strlen(strp), ssrow, sscol);
		}
	}
	else
		error("spreadsheet: internal memory error");
}
 
void drawcol(int whichcol)
{
	int i, src_x, src_y, len;

			sprintf(cname, "var%d", wcol);
			TAG(tmp) = install(cname);
		}
	}
	if (!isVector(CAR(tmp)))
		error("internal type error in spreadsheet");
	len = LENGTH(CAR(tmp));
	type = TYPEOF(CAR(tmp));
	if (len < wrow) {
		tmp2 = ssNewVector(type, 2 * len);
		for (i = 0; i < len; i++)
			if (type == REALSXP)
				REAL(tmp2)[i] = REAL(CAR(tmp))[i];
			else if (type == STRSXP)
				STRING(tmp2)[i] = STRING(CAR(tmp))[i];
			else
				error("internal type error in spreadsheet");
		LEVELS(tmp2) = LEVELS(CAR(tmp));
		CAR(tmp) = tmp2;
	}
	return (CAR(tmp));
}

 
#else
 
SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)
{
	error("no data entry editor in this version of R");
	return R_NilValue;
}
 
#endif

Rev 5458	Rev 5731
Line 90...	Line 90...
90	`nprotect = 0;/* count the PROTECT()s */`	90	`nprotect = 0;/* count the PROTECT()s */`
91	`PROTECT(indata = VectorToPairList(CAR(args))); nprotect++;`	91	`PROTECT(indata = VectorToPairList(CAR(args))); nprotect++;`
92	`PROTECT(colmodes = VectorToPairList(CADR(args))); nprotect++;`	92	`PROTECT(colmodes = VectorToPairList(CADR(args))); nprotect++;`
93		93
94	`if (!isList(indata) \|\| !isList(colmodes))`	94	`if (!isList(indata) \|\| !isList(colmodes))`
95	`errorcall(call, "invalid argument\n");`	95	`errorcall(call, "invalid argument");`
96		96
97	`/* initialize the constants */`	97	`/* initialize the constants */`
98		98
99	`bufp = buf;`	99	`bufp = buf;`
100	`ne = 0;`	100	`ne = 0;`
Line 136...	Line 136...
136	`CAR(tvec) = ssNewVector(type, 100);`	136	`CAR(tvec) = ssNewVector(type, 100);`
137	`TAG(tvec) = install("var1");`	137	`TAG(tvec) = install("var1");`
138	`LEVELS(CAR(tvec)) = 0;`	138	`LEVELS(CAR(tvec)) = 0;`
139	`}`	139	`}`
140	`else if (!isVector(CAR(tvec)))`	140	`else if (!isVector(CAR(tvec)))`
141	`errorcall(call, "invalid type for value \n");`	141	`errorcall(call, "invalid type for value");`
142	`else {`	142	`else {`
143	`if (TYPEOF(CAR(tvec)) != type)`	143	`if (TYPEOF(CAR(tvec)) != type)`
144	`CAR(tvec) = coerceVector(CAR(tvec), type);`	144	`CAR(tvec) = coerceVector(CAR(tvec), type);`
145	`LEVELS(CAR(tvec)) = LENGTH(CAR(tvec));`	145	`LEVELS(CAR(tvec)) = LENGTH(CAR(tvec));`
146	`}`	146	`}`
147	`tvec2 = CDR(tvec2);`	147	`tvec2 = CDR(tvec2);`
148	`}`	148	`}`
149	`}`	149	`}`
150	`else {`	150	`else {`
151	`errorcall(call, "invalid parameter \n");`	151	`errorcall(call, "invalid parameter");`
152	`}`	152	`}`
153		153
154		154
155	`/* start up the window, more initializing in here */`	155	`/* start up the window, more initializing in here */`
156	`if (initwin())`	156	`if (initwin())`
157	`errorcall(call, "invalid device\n");`	157	`errorcall(call, "invalid device");`
158		158
159	`/* set up a context which will close the window if there is an error */`	159	`/* set up a context which will close the window if there is an error */`
160	`begincontext(&cntxt, 8, R_NilValue, R_NilValue, R_NilValue, R_NilValue);`	160	`begincontext(&cntxt, 8, R_NilValue, R_NilValue, R_NilValue, R_NilValue);`
161	`cntxt.cend = &closewin;`	161	`cntxt.cend = &closewin;`
162		162
Line 510...	Line 510...
510	`strp = EncodeElement(invec, vrow, 0);`	510	`strp = EncodeElement(invec, vrow, 0);`
511	`printstring(strp, strlen(strp), ssrow, sscol);`	511	`printstring(strp, strlen(strp), ssrow, sscol);`
512	`}`	512	`}`
513	`}`	513	`}`
514	`else`	514	`else`
515	`error("spreadsheet: internal memory error\n");`	515	`error("spreadsheet: internal memory error");`
516	`}`	516	`}`
517		517
518	`void drawcol(int whichcol)`	518	`void drawcol(int whichcol)`
519	`{`	519	`{`
520	`int i, src_x, src_y, len;`	520	`int i, src_x, src_y, len;`
Line 692...	Line 692...
692	`sprintf(cname, "var%d", wcol);`	692	`sprintf(cname, "var%d", wcol);`
693	`TAG(tmp) = install(cname);`	693	`TAG(tmp) = install(cname);`
694	`}`	694	`}`
695	`}`	695	`}`
696	`if (!isVector(CAR(tmp)))`	696	`if (!isVector(CAR(tmp)))`
697	`error("internal type error in spreadsheet\n");`	697	`error("internal type error in spreadsheet");`
698	`len = LENGTH(CAR(tmp));`	698	`len = LENGTH(CAR(tmp));`
699	`type = TYPEOF(CAR(tmp));`	699	`type = TYPEOF(CAR(tmp));`
700	`if (len < wrow) {`	700	`if (len < wrow) {`
701	`tmp2 = ssNewVector(type, 2 * len);`	701	`tmp2 = ssNewVector(type, 2 * len);`
702	`for (i = 0; i < len; i++)`	702	`for (i = 0; i < len; i++)`
703	`if (type == REALSXP)`	703	`if (type == REALSXP)`
704	`REAL(tmp2)[i] = REAL(CAR(tmp))[i];`	704	`REAL(tmp2)[i] = REAL(CAR(tmp))[i];`
705	`else if (type == STRSXP)`	705	`else if (type == STRSXP)`
706	`STRING(tmp2)[i] = STRING(CAR(tmp))[i];`	706	`STRING(tmp2)[i] = STRING(CAR(tmp))[i];`
707	`else`	707	`else`
708	`error("internal type error in spreadsheet\n");`	708	`error("internal type error in spreadsheet");`
709	`LEVELS(tmp2) = LEVELS(CAR(tmp));`	709	`LEVELS(tmp2) = LEVELS(CAR(tmp));`
710	`CAR(tmp) = tmp2;`	710	`CAR(tmp) = tmp2;`
711	`}`	711	`}`
712	`return (CAR(tmp));`	712	`return (CAR(tmp));`
713	`}`	713	`}`
Line 1649...	Line 1649...
1649		1649
1650	`#else`	1650	`#else`
1651		1651
1652	`SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)`	1652	`SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)`
1653	`{`	1653	`{`
1654	`error("no data entry editor in this version of R\n");`	1654	`error("no data entry editor in this version of R");`
1655	`return R_NilValue;`	1655	`return R_NilValue;`
1656	`}`	1656	`}`
1657		1657
1658	`#endif`	1658	`#endif`

The R Project SVN R

(root)/branches/R-exp-API/src/gnome/dataentry.c @ 63243 – Rev 5458 → 5731