The R Project SVN R

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
4394 ripley 1 
/*
2 
 *  R : A Computer Langage for Statistical Data Analysis
3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
40748 ripley 4 
 *  Copyright (C) 1998--2007  Robert Gentleman, Ross Ihaka and the
9044 ripley 5 
 *                            R Development Core Team
4394 ripley 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
11 
 *
12 
 *  This program is distributed in the hope that it will be useful,
13 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 
 *  GNU General Public License for more details.
16 
 *
17 
 *  You should have received a copy of the GNU General Public License
42300 ripley 18 
 *  along with this program; if not, a copy is available at
19 
 *  http://www.r-project.org/Licenses/
4394 ripley 20 
 */
21 
 
9044 ripley 22 
/* TODO
9095 ripley 23 
   - spreadsheet copy and paste?
9044 ripley 24 
 */
25 
 
32704 ripley 26 
/* Use of strchr here is MBCS-safe */
27 
 
5222 ripley 28 
#ifdef HAVE_CONFIG_H
7701 hornik 29 
#include <config.h>
5222 ripley 30 
#endif
33001 ripley 31 
#include "win-nls.h"
5222 ripley 32 
 
32578 ripley 33 
#include <wchar.h>
35776 ripley 34 
#include <R_ext/rlocale.h>
32578 ripley 35 
 
4394 ripley 36 
#include "Defn.h"
37 
#include "Print.h"
46038 murdoch 38 
#include <Rinternals.h>
39 
#include <R_ext/Parse.h>  /* parsing is used in handling escape codes */
4394 ripley 40 
 
9044 ripley 41 
#include "graphapp/ga.h"
42 
#include "console.h"
43 
#include "consolestructs.h"
9079 ripley 44 
#include "rui.h"
4394 ripley 45 
 
24276 ripley 46 
typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;
9044 ripley 47 
 
40748 ripley 48 
/* Used to check if eventloop needs to be run */
24276 ripley 49 
static Rboolean R_de_up;
50 
 
9095 ripley 51 
#ifndef max
52 
#define max(a, b) (((a)>(b))?(a):(b))
53 
#endif
54 
#ifndef min
55 
#define min(a, b) (((a)<(b))?(a):(b))
56 
#endif
40748 ripley 57 
#define BOXW(x) (min(((x<100 && DE->nboxchars == 0) ? DE->boxw[x] : DE->box_w), DE->p->w - DE->boxw[0] - 2*DE->bwidth - 2))
9095 ripley 58 
 
9044 ripley 59 
#define FIELDWIDTH 10
38332 murdoch 60 
#define BUFSIZE 200
9044 ripley 61 
 
40748 ripley 62 
typedef struct {
63 
    dataeditor de;
64 
    ConsoleData p;
65 
    int box_w;                       /* width of a box */
66 
    int boxw[100];                   /* widths of cells */
67 
    int box_h;                       /* height of a box */
68 
    int windowWidth;                 /* current width of the window */
69 
    int windowHeight;                /* current height of the window */
70 
    int currentexp;                  /* boolean: whether an cell is active */
71 
    int crow;                        /* current row */
72 
    int ccol;                        /* current column */
73 
    int nwide, nhigh;
74 
    int colmax, colmin, rowmax, rowmin;
75 
    int ndecimal;                    /* count decimal points */
76 
    int ne;                          /* count exponents */
77 
    int nneg;			     /* indicate whether its a negative */
78 
    int clength;                     /* number of characters currently entered */
79 
    int inSpecial;
80 
    char buf[BUFSIZE];
81 
    char *bufp;
82 
    int bwidth;			/* width of the border */
83 
    int hwidth;			/* width of header  */
84 
    int text_xoffset, text_yoffset;
85 
    field celledit;
86 
    Rboolean CellModified, CellEditable;
87 
    int xmaxused, ymaxused;
88 
    int oldWIDTH, oldHEIGHT;
89 
    int nboxchars;
90 
    char labform[6];
45070 ripley 91 
    int xScrollbarScale, yScrollbarScale;
40748 ripley 92 
    SEXP work, names, lens;
93 
    PROTECT_INDEX wpi, npi, lpi;
94 
    menuitem de_mvw;
95 
    SEXP ssNA_STRING;
40750 ripley 96 
    Rboolean isEditor;
40748 ripley 97 
} destruct, *DEstruct;
98 
 
9044 ripley 99 
/* Local Function Definitions */
9095 ripley 100 
 
40748 ripley 101 
static void advancerect(DEstruct, int);
44201 ripley 102 
static void bell(void);
40748 ripley 103 
static void cleararea(DEstruct, int, int, int, int, rgb);
104 
static void clearrect(DEstruct);
105 
static void closerect(DEstruct);
106 
static void clearwindow(DEstruct);
107 
static void de_closewin(DEstruct);
108 
static void copyarea(DEstruct, int, int, int, int);
109 
static void copyH(DEstruct, int, int, int);
110 
static void deredraw(DEstruct);
111 
static void downlightrect(DEstruct);
112 
static void drawwindow(DEstruct);
113 
static void drawcol(DEstruct, int);
9095 ripley 114 
/* static void de_drawline(int, int, int, int);*/
43800 ripley 115 
static void de_drawtext(DEstruct, int, int, const char *);
40748 ripley 116 
static void drawrectangle(DEstruct, int, int, int, int, int, int);
117 
static void drawrow(DEstruct, int);
118 
static void find_coords(DEstruct, int, int, int*, int*);
43800 ripley 119 
static void handlechar(DEstruct, const char *);
40748 ripley 120 
static void highlightrect(DEstruct);
41783 ripley 121 
static Rboolean initwin(DEstruct, const char *);
40748 ripley 122 
static void jumppage(DEstruct, int);
123 
static void jumpwin(DEstruct, int, int);
124 
static void de_popupmenu(DEstruct, int, int, int);
125 
static void printlabs(DEstruct);
126 
static void printrect(DEstruct, int, int);
43800 ripley 127 
static void printstring(DEstruct, const char *, int, int, int, int);
40748 ripley 128 
static void printelt(DEstruct, SEXP, int, int, int);
129 
static void setcellwidths(DEstruct);
9044 ripley 130 
 
41783 ripley 131 
static dataeditor newdataeditor(DEstruct, const char *);
9212 ripley 132 
static void de_copy(control c);
133 
static void de_paste(control c);
134 
static void de_delete(control c);
135 
 
9044 ripley 136 
 
36901 ripley 137 
#define WIN32_LEAN_AND_MEAN 1
24259 ripley 138 
#include <windows.h> /* for Sleep */
9044 ripley 139 
 
43882 ripley 140 
int mb_char_len(const char *buf, int clength)
141 
{
142 
    int i, mb_len = 0;
32578 ripley 143 
 
43882 ripley 144 
    for(i = 0; i <= clength; i += mb_len)
145 
	mb_len = mbrtowc(NULL, buf+i, MB_CUR_MAX, NULL);
146 
    return mb_len;
147 
}
148 
 
40748 ripley 149 
static void moveback(DEstruct DE)
32578 ripley 150 
{
151 
    int mb_len;
152 
 
40748 ripley 153 
    if (DE->clength > 0) {
43882 ripley 154 
	mb_len = mb_char_len(DE->buf, DE->clength-1);
40748 ripley 155 
	DE->clength -= mb_len;
156 
	DE->bufp -= mb_len;
157 
	printstring(DE, DE->buf, DE->clength, DE->crow, DE->ccol, 1);
32578 ripley 158 
    } else bell();
159 
}
160 
 
161 
 
24276 ripley 162 
 /*
24272 ripley 163 
  Underlying assumptions (for this version R >= 1.8.0)
164 
 
165 
  The data are stored in a list `work', with unused columns having
166 
  NULL entries.  The names for the list are in `names', which should
27357 murdoch 167 
  have a name for all displayable columns (up to xmaxused).
24272 ripley 168 
  The *used* lengths of the columns are in `lens': this needs only be
169 
  set for non-NULL columns.
170 
 
27357 murdoch 171 
  If the list was originally length(0), that should work with
24276 ripley 172 
 
24272 ripley 173 
 
174 
  All row and col numbers are 1-based.
175 
 
176 
  BDR May 2003
177 
 */
178 
 
24276 ripley 179 
/*
40748 ripley 180 
   ssNewVector is just an interface to allocVector but it lets us set
181 
   the fields to NA. We need to have a special NA for strings so that
182 
   we can differentiate between uninitialized elements in the vectors
183 
   and user supplied NA's; hence ssNA_STRING
24276 ripley 184 
 */
185 
 
40748 ripley 186 
static SEXP ssNewVector(DEstruct DE, SEXPTYPE type, int vlen)
24276 ripley 187 
{
188 
    SEXP tvec;
189 
    int j;
190 
 
191 
    tvec = allocVector(type, vlen);
192 
    for (j = 0; j < vlen; j++)
193 
	if (type == REALSXP)
40748 ripley 194 
	    REAL(tvec)[j] = NA_REAL;
24276 ripley 195 
	else if (type == STRSXP)
40748 ripley 196 
	    SET_STRING_ELT(tvec, j, DE->ssNA_STRING);
24276 ripley 197 
    return (tvec);
198 
}
199 
 
40748 ripley 200 
static void de_closewin_cend(void *DE)
24276 ripley 201 
{
40748 ripley 202 
    de_closewin((DEstruct) DE);
24276 ripley 203 
}
204 
 
9044 ripley 205 
SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)
206 
{
24272 ripley 207 
    SEXP colmodes, tnames, tvec, tvec2, work2;
9044 ripley 208 
    SEXPTYPE type;
24272 ripley 209 
    int i, j, cnt, len, nprotect;
9044 ripley 210 
    RCNTXT cntxt;
24272 ripley 211 
    char clab[25];
40748 ripley 212 
    destruct DE1;
213 
    DEstruct DE = &DE1;
9044 ripley 214 
 
40750 ripley 215 
    checkArity(op, args);
216 
    DE->isEditor = TRUE;
9044 ripley 217 
    nprotect = 0;/* count the PROTECT()s */
40748 ripley 218 
    PROTECT_WITH_INDEX(DE->work = duplicate(CAR(args)), &DE->wpi); nprotect++;
24272 ripley 219 
    colmodes = CADR(args);
40748 ripley 220 
    tnames = getAttrib(DE->work, R_NamesSymbol);
9044 ripley 221 
 
40748 ripley 222 
    if (TYPEOF(DE->work) != VECSXP || TYPEOF(colmodes) != VECSXP)
33001 ripley 223 
	errorcall(call, G_("invalid argument"));
9044 ripley 224 
 
225 
    /* initialize the constants */
226 
 
40748 ripley 227 
    DE->bufp = DE->buf;
228 
    DE->ne = 0;
229 
    DE->currentexp = 0;
230 
    DE->nneg = 0;
231 
    DE->ndecimal = 0;
232 
    DE->clength = 0;
233 
    DE->inSpecial = 0;
234 
    DE->ccol = 1;
235 
    DE->crow = 1;
236 
    DE->colmin = 1;
237 
    DE->rowmin = 1;
45070 ripley 238 
    PROTECT(DE->ssNA_STRING = duplicate(NA_STRING));
40748 ripley 239 
    nprotect++;
240 
    DE->bwidth = 0;
241 
    DE->hwidth = 5;
9044 ripley 242 
 
24272 ripley 243 
    /* setup work, names, lens  */
40748 ripley 244 
    DE->xmaxused = length(DE->work); DE->ymaxused = 0;
245 
    PROTECT_WITH_INDEX(DE->lens = allocVector(INTSXP, DE->xmaxused), &DE->lpi);
24272 ripley 246 
    nprotect++;
9044 ripley 247 
 
24272 ripley 248 
    if (isNull(tnames)) {
45070 ripley 249 
	PROTECT_WITH_INDEX(DE->names = allocVector(STRSXP, DE->xmaxused),
40748 ripley 250 
			   &DE->npi);
251 
	for(i = 0; i < DE->xmaxused; i++) {
24272 ripley 252 
	    sprintf(clab, "var%d", i);
40748 ripley 253 
	    SET_STRING_ELT(DE->names, i, mkChar(clab));
9044 ripley 254 
	}
24272 ripley 255 
    } else
40748 ripley 256 
	PROTECT_WITH_INDEX(DE->names = duplicate(tnames), &DE->npi);
24272 ripley 257 
    nprotect++;
40748 ripley 258 
    for (i = 0; i < DE->xmaxused; i++) {
259 
	int len = LENGTH(VECTOR_ELT(DE->work, i));
260 
	INTEGER(DE->lens)[i] = len;
261 
	DE->ymaxused = max(len, DE->ymaxused);
262 
	type = TYPEOF(VECTOR_ELT(DE->work, i));
25365 ripley 263 
	if (LENGTH(colmodes) > 0 && !isNull(VECTOR_ELT(colmodes, i)))
24272 ripley 264 
	    type = str2type(CHAR(STRING_ELT(VECTOR_ELT(colmodes, i), 0)));
265 
	if (type != STRSXP) type = REALSXP;
40748 ripley 266 
	if (isNull(VECTOR_ELT(DE->work, i))) {
24272 ripley 267 
	    if (type == NILSXP) type = REALSXP;
40748 ripley 268 
	    SET_VECTOR_ELT(DE->work, i, ssNewVector(DE, type, 100));
269 
	} else if (!isVector(VECTOR_ELT(DE->work, i)))
33001 ripley 270 
	    errorcall(call, G_("invalid type for value"));
24272 ripley 271 
	else {
40748 ripley 272 
	    if (TYPEOF(VECTOR_ELT(DE->work, i)) != type)
273 
		SET_VECTOR_ELT(DE->work, i,
274 
			       coerceVector(VECTOR_ELT(DE->work, i), type));
24272 ripley 275 
	}
9044 ripley 276 
    }
277 
 
45528 ripley 278 
    DE->xScrollbarScale = DE->yScrollbarScale = 1;
9044 ripley 279 
 
280 
    /* start up the window, more initializing in here */
40750 ripley 281 
    if (initwin(DE, G_("Data Editor")))
33001 ripley 282 
	errorcall(call, G_("invalid device"));
40750 ripley 283 
    R_de_up = TRUE;
9044 ripley 284 
 
285 
    /* set up a context which will close the window if there is an error */
35450 murdoch 286 
    begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_BaseEnv, R_BaseEnv,
23463 luke 287 
		 R_NilValue, R_NilValue);
14561 luke 288 
    cntxt.cend = &de_closewin_cend;
40748 ripley 289 
    cntxt.cenddata = (void *)DE;
9044 ripley 290 
 
40748 ripley 291 
    highlightrect(DE);
9044 ripley 292 
 
40750 ripley 293 
    while (R_de_up) {
294 
	/* avoid consuming 100% CPU time here */
295 
	Sleep(10);
296 
	R_ProcessEvents();
297 
    }
9044 ripley 298 
 
299 
    endcontext(&cntxt);
300 
 
301 
    /* drop out unused columns */
40748 ripley 302 
    for(i = 0, cnt = 0; i < DE->xmaxused; i++)
303 
	if(!isNull(VECTOR_ELT(DE->work, i))) cnt++;
304 
    if (cnt < DE->xmaxused) {
24272 ripley 305 
	PROTECT(work2 = allocVector(VECSXP, cnt)); nprotect++;
40748 ripley 306 
	for(i = 0, j = 0; i < DE->xmaxused; i++) {
307 
	    if(!isNull(VECTOR_ELT(DE->work, i))) {
308 
		SET_VECTOR_ELT(work2, j, VECTOR_ELT(DE->work, i));
309 
		INTEGER(DE->lens)[j] = INTEGER(DE->lens)[i];
310 
		SET_STRING_ELT(DE->names, j, STRING_ELT(DE->names, i));
24272 ripley 311 
		j++;
9044 ripley 312 
	    }
313 
	}
40748 ripley 314 
	REPROTECT(DE->names = lengthgets(DE->names, cnt), DE->npi);
315 
    } else work2 = DE->work;
9044 ripley 316 
 
24272 ripley 317 
    for (i = 0; i < LENGTH(work2); i++) {
40748 ripley 318 
	len = INTEGER(DE->lens)[i];
24272 ripley 319 
	tvec = VECTOR_ELT(work2, i);
320 
	if (LENGTH(tvec) != len) {
40748 ripley 321 
	    tvec2 = ssNewVector(DE, TYPEOF(tvec), len);
24272 ripley 322 
	    for (j = 0; j < len; j++) {
323 
		if (TYPEOF(tvec) == REALSXP) {
324 
			REAL(tvec2)[j] = REAL(tvec)[j];
325 
		} else if (TYPEOF(tvec) == STRSXP) {
40748 ripley 326 
		    if (STRING_ELT(tvec, j) != DE->ssNA_STRING)
24272 ripley 327 
			SET_STRING_ELT(tvec2, j, STRING_ELT(tvec, j));
9044 ripley 328 
		    else
10172 luke 329 
			SET_STRING_ELT(tvec2, j, NA_STRING);
9044 ripley 330 
		} else
33001 ripley 331 
		    error(G_("dataentry: internal memory problem"));
24272 ripley 332 
	    }
333 
	    SET_VECTOR_ELT(work2, i, tvec2);
9044 ripley 334 
	}
335 
    }
336 
 
40748 ripley 337 
    setAttrib(work2, R_NamesSymbol, DE->names);
9044 ripley 338 
    UNPROTECT(nprotect);
24272 ripley 339 
    return work2;
9044 ripley 340 
}
341 
 
342 
/* Window Drawing Routines */
343 
 
9079 ripley 344 
static rgb bbg;
9044 ripley 345 
 
40748 ripley 346 
static void setcellwidths(DEstruct DE)
9044 ripley 347 
{
9079 ripley 348 
    int i, w, dw;
9095 ripley 349 
 
40748 ripley 350 
    DE->windowWidth = w = 2*DE->bwidth + DE->boxw[0] + BOXW(DE->colmin);
351 
    DE->nwide = 2;
9095 ripley 352 
    for (i = 2; i < 100; i++) { /* 100 on-screen columns cannot occur */
40748 ripley 353 
	dw = BOXW(i + DE->colmin - 1);
40750 ripley 354 
	if((w += dw) > DE->p->w ||
45070 ripley 355 
	   (!DE->isEditor && i > DE->xmaxused - DE->colmin + 1)
40750 ripley 356 
	    ) {
40748 ripley 357 
	    DE->nwide = i;
358 
	    DE->windowWidth = w - dw;
9079 ripley 359 
	    break;
360 
	}
361 
    }
9212 ripley 362 
}
363 
 
364 
 
40748 ripley 365 
static void drawwindow(DEstruct DE)
9212 ripley 366 
{
367 
    /* might have resized */
40748 ripley 368 
    setcellwidths(DE);
369 
    DE->nhigh = (DE->p->h - 2 * DE->bwidth - DE->hwidth - 3) / DE->box_h;
40750 ripley 370 
    if(!DE->isEditor && DE->nhigh > DE->ymaxused+1) DE->nhigh = DE->ymaxused+1;
40748 ripley 371 
    DE->windowHeight = DE->nhigh * DE->box_h + 2 * DE->bwidth + DE->hwidth;
372 
    DE->oldWIDTH = DE->p->w;
373 
    DE->oldHEIGHT = DE->p->h;
27357 murdoch 374 
 
40748 ripley 375 
    clearwindow(DE);
376 
    deredraw(DE);
9079 ripley 377 
    /* row/col 1 = pos 0 */
40748 ripley 378 
    gchangescrollbar(DE->de, VWINSB, (DE->rowmin - 1)/DE->yScrollbarScale,
379 
		     DE->ymaxused/DE->yScrollbarScale,
380 
		     max(DE->nhigh/DE->yScrollbarScale, 1), 0);
381 
    gchangescrollbar(DE->de, HWINSB, (DE->colmin - 1)/DE->xScrollbarScale,
382 
		     DE->xmaxused/DE->xScrollbarScale,
383 
		     max(DE->nwide/DE->xScrollbarScale, 1), 0);
9044 ripley 384 
}
385 
 
40748 ripley 386 
static void doHscroll(DEstruct DE, int oldcol)
9095 ripley 387 
{
9212 ripley 388 
    int i, dw;
40748 ripley 389 
    int oldnwide = DE->nwide, oldwindowWidth = DE->windowWidth;
9095 ripley 390 
 
391 
    /* horizontal re-position */
40748 ripley 392 
    setcellwidths(DE);
393 
    DE->colmax = DE->colmin + (DE->nwide - 2);
394 
    if (oldcol < DE->colmin) { /* drop oldcol...colmin - 1 */
395 
	dw = DE->boxw[0];
396 
	for (i = oldcol; i < DE->colmin; i++) dw += BOXW(i);
397 
	copyH(DE, dw, DE->boxw[0], oldwindowWidth - dw + 1);
9095 ripley 398 
	dw = oldwindowWidth - BOXW(oldcol) + 1;
46784 murdoch 399 
	cleararea(DE, dw, DE->hwidth, DE->p->w-dw, DE->p->h, DE->p->guiColors[dataeditbg]);
9095 ripley 400 
	/* oldnwide includes the row labels */
40748 ripley 401 
	for (i = oldcol+oldnwide-1; i <= DE->colmax; i++) drawcol(DE, i);
9095 ripley 402 
    } else {
403 
	/* move one or more cols left */
40748 ripley 404 
	dw = BOXW(DE->colmin);
405 
	copyH(DE, DE->boxw[0], DE->boxw[0] + dw, DE->windowWidth - dw + 1);
406 
	dw = DE->windowWidth + 1;
46784 murdoch 407 
	cleararea(DE, dw, DE->hwidth, DE->p->w-dw, DE->p->h, DE->p->guiColors[dataeditbg]);
40748 ripley 408 
	drawcol(DE, DE->colmin);
9095 ripley 409 
    }
40748 ripley 410 
    gchangescrollbar(DE->de, HWINSB, (DE->colmin - 1)/DE->xScrollbarScale,
411 
		     DE->xmaxused/DE->xScrollbarScale,
412 
		     max(DE->nwide/DE->xScrollbarScale, 1), 0);
413 
    highlightrect(DE);
9095 ripley 414 
}
415 
 
9044 ripley 416 
/* find_coords finds the coordinates of the upper left corner of the
9079 ripley 417 
   given cell on the screen: row and col are on-screen coords */
9044 ripley 418 
 
45070 ripley 419 
static void find_coords(DEstruct DE,
40748 ripley 420 
			int row, int col, int *xcoord, int *ycoord)
9044 ripley 421 
{
9079 ripley 422 
    int i, w;
40748 ripley 423 
    w = DE->bwidth;
424 
    if (col > 0) w += DE->boxw[0];
425 
    for(i = 1; i < col; i ++) w += BOXW(i + DE->colmin - 1);
9079 ripley 426 
    *xcoord = w;
40748 ripley 427 
    *ycoord = DE->bwidth + DE->hwidth + DE->box_h * row;
9044 ripley 428 
}
429 
 
430 
/* draw the window with the top left box at column wcol and row wrow */
431 
 
40748 ripley 432 
static void jumpwin(DEstruct DE, int wcol, int wrow)
9044 ripley 433 
{
434 
    if (wcol < 0 || wrow < 0) {
435 
	bell();
436 
	return;
437 
    }
40748 ripley 438 
    closerect(DE);
439 
    if (DE->colmin != wcol || DE->rowmin != wrow) {
440 
	DE->colmin = wcol;
441 
	DE->rowmin = wrow;
442 
	deredraw(DE);
40757 ripley 443 
	gchangescrollbar(DE->de, VWINSB, (DE->rowmin - 1)/DE->yScrollbarScale,
444 
			 DE->ymaxused/DE->yScrollbarScale,
445 
			 max(DE->nhigh/DE->yScrollbarScale, 1), 0);
446 
	gchangescrollbar(DE->de, HWINSB, (DE->colmin - 1)/DE->xScrollbarScale,
447 
			 DE->xmaxused/DE->xScrollbarScale,
448 
			 max(DE->nwide/DE->xScrollbarScale, 1), 0);
40748 ripley 449 
    } else highlightrect(DE);
9044 ripley 450 
}
451 
 
40748 ripley 452 
static void advancerect(DEstruct DE, int which)
9044 ripley 453 
{
454 
 
455 
    /* if we are in the header, changing a name then only down is
456 
       allowed */
40748 ripley 457 
    if (DE->crow < 1 && which != DOWN) {
9044 ripley 458 
	bell();
459 
	return;
460 
    }
461 
 
40748 ripley 462 
    closerect(DE);
9044 ripley 463 
 
464 
    switch (which) {
465 
    case UP:
40748 ripley 466 
	if (DE->crow == 1) {
467 
	    if (DE->rowmin == 1)
9044 ripley 468 
		bell();
469 
	    else
40748 ripley 470 
		jumppage(DE, UP);
9044 ripley 471 
	} else
40748 ripley 472 
	    DE->crow--;
9044 ripley 473 
	break;
474 
    case DOWN:
40748 ripley 475 
	if (DE->crow == (DE->nhigh - 1))
476 
	    jumppage(DE, DOWN);
9044 ripley 477 
	else
40748 ripley 478 
	    DE->crow++;
9044 ripley 479 
	break;
480 
    case RIGHT:
40748 ripley 481 
	if (DE->ccol == (DE->nwide - 1))
482 
	    jumppage(DE, RIGHT);
9044 ripley 483 
	else
40748 ripley 484 
	    DE->ccol++;
9044 ripley 485 
	break;
486 
    case LEFT:
40748 ripley 487 
	if (DE->ccol == 1) {
488 
	    if (DE->colmin == 1)
9044 ripley 489 
		bell();
490 
	    else
40748 ripley 491 
		jumppage(DE, LEFT);
9044 ripley 492 
	} else
40748 ripley 493 
	    DE->ccol--;
9044 ripley 494 
	break;
495 
    default:
496 
	UNIMPLEMENTED("advancerect");
497 
    }
498 
 
40748 ripley 499 
    highlightrect(DE);
9044 ripley 500 
}
501 
 
41783 ripley 502 
static const char *get_col_name(DEstruct DE, int col)
9079 ripley 503 
{
24272 ripley 504 
    static char clab[25];
40748 ripley 505 
    if (col <= DE->xmaxused) {
24272 ripley 506 
	/* don't use NA labels */
40748 ripley 507 
	SEXP tmp = STRING_ELT(DE->names, col - 1);
24272 ripley 508 
	if(tmp != NA_STRING) return(CHAR(tmp));
9079 ripley 509 
    }
510 
    sprintf(clab, "var%d", col);
511 
    return clab;
512 
}
513 
 
40748 ripley 514 
static int get_col_width(DEstruct DE, int col)
9079 ripley 515 
{
9205 ripley 516 
    int i, w = 0, w1, fw = FIELDWIDTH;
41861 ripley 517 
    const char *strp;
24272 ripley 518 
    SEXP tmp, lab;
9205 ripley 519 
 
40748 ripley 520 
    if (DE->nboxchars > 0) return DE->nboxchars;
521 
    if (col <= DE->xmaxused) {
522 
	tmp = VECTOR_ELT(DE->work, col - 1);
24272 ripley 523 
	if (isNull(tmp)) return fw;
524 
	/* don't use NA labels */
40748 ripley 525 
	lab = STRING_ELT(DE->names, col - 1);
24272 ripley 526 
	if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
9079 ripley 527 
	PrintDefaults(R_NilValue);
40748 ripley 528 
	for (i = 0; i < INTEGER(DE->lens)[col - 1]; i++) {
34294 ripley 529 
	    strp = EncodeElement(tmp, i, 0, '.');
9079 ripley 530 
	    w1 = strlen(strp);
531 
	    if (w1 > w) w = w1;
532 
	}
533 
	if(w < 5) w = 5;
534 
	if(w < 8) w++;
9837 ripley 535 
	if(w > 50) w = 50;
9079 ripley 536 
	return w;
537 
    }
9205 ripley 538 
    return fw;
9079 ripley 539 
}
540 
 
40748 ripley 541 
static CellType get_col_type(DEstruct DE, int col)
9079 ripley 542 
{
543 
    SEXP tmp;
544 
    CellType res = UNKNOWNN;
9095 ripley 545 
 
40748 ripley 546 
    if (col <= DE->xmaxused) {
547 
	tmp = VECTOR_ELT(DE->work, col - 1);
9079 ripley 548 
	if(TYPEOF(tmp) == REALSXP) res = NUMERIC;
549 
	if(TYPEOF(tmp) == STRSXP) res = CHARACTER;
550 
    }
551 
    return res;
552 
}
553 
 
554 
 
9044 ripley 555 
/* whichcol is absolute col no, col is position on screen */
40748 ripley 556 
static void drawcol(DEstruct DE, int whichcol)
9044 ripley 557 
{
45070 ripley 558 
    int i, src_x, src_y, len, col = whichcol - DE->colmin + 1,
40748 ripley 559 
	bw = BOXW(whichcol);
41783 ripley 560 
    const char *clab;
9044 ripley 561 
    SEXP tmp;
562 
 
40748 ripley 563 
    find_coords(DE, 0, col, &src_x, &src_y);
46784 murdoch 564 
    cleararea(DE, src_x, src_y, bw, DE->windowHeight, DE->p->guiColors[dataeditbg]);
40748 ripley 565 
    cleararea(DE, src_x, src_y, bw, DE->box_h, bbg);
566 
    for (i = 0; i < DE->nhigh; i++)
567 
	drawrectangle(DE, src_x, DE->hwidth + i * DE->box_h, bw, DE->box_h, 1, 1);
9044 ripley 568 
 
569 
    /* now fill it in if it is active */
40748 ripley 570 
    clab = get_col_name(DE, whichcol);
571 
    printstring(DE, clab, strlen(clab), 0, col, 0);
9095 ripley 572 
 
45070 ripley 573 
    if (DE->xmaxused >= whichcol) {
40748 ripley 574 
	tmp = VECTOR_ELT(DE->work, whichcol - 1);
24272 ripley 575 
	if (!isNull(tmp)) {
40748 ripley 576 
	    len = min(DE->rowmax, INTEGER(DE->lens)[whichcol - 1]);
577 
	    for (i = (DE->rowmin - 1); i < len; i++)
578 
		printelt(DE, tmp, i, i - DE->rowmin + 2, col);
9044 ripley 579 
	}
580 
    }
581 
}
582 
 
9048 ripley 583 
 
584 
/* whichrow is absolute row no */
40748 ripley 585 
static void drawrow(DEstruct DE, int whichrow)
9044 ripley 586 
{
40748 ripley 587 
    int i, src_x, src_y, row = whichrow - DE->rowmin + 1, w;
9044 ripley 588 
    char rlab[15];
589 
    SEXP tvec;
590 
 
40748 ripley 591 
    find_coords(DE, row, 0, &src_x, &src_y);
45070 ripley 592 
    cleararea(DE, src_x, src_y, DE->windowWidth, DE->box_h,
46784 murdoch 593 
	      (whichrow > 0) ? DE->p->guiColors[dataeditbg] : bbg);
40748 ripley 594 
    drawrectangle(DE, src_x, src_y, DE->boxw[0], DE->box_h, 1, 1);
9095 ripley 595 
 
40748 ripley 596 
    sprintf(rlab, DE->labform, whichrow);
597 
    printstring(DE, rlab, strlen(rlab), row, 0, 0);
9044 ripley 598 
 
40748 ripley 599 
    w = DE->bwidth + DE->boxw[0];
600 
    for (i = DE->colmin; i <= DE->colmax; i++) {
601 
	drawrectangle(DE, w, src_y, BOXW(i), DE->box_h, 1, 1);
9095 ripley 602 
	w += BOXW(i);
9079 ripley 603 
    }
604 
 
40748 ripley 605 
    for (i = DE->colmin; i <= DE->colmax; i++) {
606 
	if (i > DE->xmaxused) break;
607 
	if (!isNull(tvec = VECTOR_ELT(DE->work, i - 1)))
608 
	    if (whichrow <= INTEGER(DE->lens)[i - 1])
609 
		printelt(DE, tvec, whichrow - 1, row, i - DE->colmin + 1);
9044 ripley 610 
    }
611 
}
612 
 
613 
/* printelt: print the correct value from vector[vrow] into the
614 
   spreadsheet in row ssrow and col sscol */
615 
 
616 
/* WARNING: This has no check that you're not beyond the end of the
617 
   vector. Caller must check. */
618 
 
40748 ripley 619 
static void printelt(DEstruct DE, SEXP invec, int vrow, int ssrow, int sscol)
9044 ripley 620 
{
41861 ripley 621 
    const char *strp;
9044 ripley 622 
    PrintDefaults(R_NilValue);
623 
    if (TYPEOF(invec) == REALSXP) {
40748 ripley 624 
	strp = EncodeElement(invec, vrow, 0, '.');
625 
	printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
9044 ripley 626 
    }
627 
    else if (TYPEOF(invec) == STRSXP) {
40748 ripley 628 
	if (STRING_ELT(invec, vrow) != DE->ssNA_STRING) {
34294 ripley 629 
	    strp = EncodeElement(invec, vrow, 0, '.');
40748 ripley 630 
	    printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
9044 ripley 631 
	}
632 
    }
633 
    else
33001 ripley 634 
	error(G_("dataentry: internal memory error"));
9044 ripley 635 
}
636 
 
637 
 
40748 ripley 638 
static void drawelt(DEstruct DE, int whichrow, int whichcol)
9044 ripley 639 
{
640 
    int i;
41783 ripley 641 
    const char *clab;
9044 ripley 642 
    SEXP tmp;
643 
 
9079 ripley 644 
    if (whichrow == 0) {
40748 ripley 645 
	clab = get_col_name(DE, whichcol + DE->colmin - 1);
646 
	printstring(DE, clab, strlen(clab), 0, whichcol, 0);
9079 ripley 647 
    } else {
40748 ripley 648 
	if (DE->xmaxused >= whichcol + DE->colmin - 1) {
649 
	    tmp = VECTOR_ELT(DE->work, whichcol + DE->colmin - 2);
650 
	    if (!isNull(tmp) && (i = DE->rowmin + whichrow - 2) <
651 
		INTEGER(DE->lens)[whichcol + DE->colmin - 2] )
652 
		printelt(DE, tmp, i, whichrow, whichcol);
9079 ripley 653 
	} else
40748 ripley 654 
	    printstring(DE, "", 0, whichrow,  whichcol, 0);
9044 ripley 655 
    }
656 
}
657 
 
40748 ripley 658 
static void jumppage(DEstruct DE, int dir)
9044 ripley 659 
{
9095 ripley 660 
    int i, w, oldcol, wcol;
661 
 
9044 ripley 662 
    switch (dir) {
663 
    case UP:
40748 ripley 664 
	DE->rowmin--;
665 
	DE->rowmax--;
666 
	copyarea(DE, 0, DE->hwidth + DE->box_h, 0, DE->hwidth + 2 * DE->box_h);
667 
	drawrow(DE, DE->rowmin);
668 
	gchangescrollbar(DE->de, VWINSB, (DE->rowmin - 1)/DE->yScrollbarScale,
669 
			 DE->ymaxused/DE->yScrollbarScale,
670 
			 max(DE->nhigh/DE->yScrollbarScale, 1), 0);
9044 ripley 671 
	break;
672 
    case DOWN:
45528 ripley 673 
	// if (DE->rowmax >= 65535) return;
40748 ripley 674 
	DE->rowmin++;
675 
	DE->rowmax++;
676 
	copyarea(DE, 0, DE->hwidth + 2 * DE->box_h, 0, DE->hwidth + DE->box_h);
677 
	drawrow(DE, DE->rowmax);
678 
	gchangescrollbar(DE->de, VWINSB, (DE->rowmin - 1)/DE->yScrollbarScale,
679 
			 DE->ymaxused/DE->yScrollbarScale,
680 
			 max(DE->nhigh/DE->yScrollbarScale, 1), 0);
9044 ripley 681 
	break;
682 
    case LEFT:
40748 ripley 683 
	DE->colmin--;
684 
	doHscroll(DE, DE->colmin + 1);
9044 ripley 685 
	break;
686 
    case RIGHT:
40748 ripley 687 
	oldcol = DE->colmin;
688 
	wcol = DE->colmin + DE->ccol + 1; /* column to be selected */
45070 ripley 689 
	/* There may not be room to fit the next column in */
40748 ripley 690 
	w = DE->p->w - DE->boxw[0] - BOXW(DE->colmax + 1);
691 
	for (i = DE->colmax; i >= oldcol; i--) {
9095 ripley 692 
	    w -= BOXW(i);
693 
	    if(w < 0) {
40748 ripley 694 
		DE->colmin = i + 1;
9095 ripley 695 
		break;
27357 murdoch 696 
	    }
9095 ripley 697 
	}
40748 ripley 698 
	DE->ccol = wcol - DE->colmin;
699 
	doHscroll(DE, oldcol);
9044 ripley 700 
	break;
9048 ripley 701 
    }
9044 ripley 702 
}
703 
/* draw a rectangle, used to highlight/downlight the current box */
704 
 
40748 ripley 705 
static void printrect(DEstruct DE, int lwd, int fore)
9044 ripley 706 
{
9079 ripley 707 
    int x, y;
40748 ripley 708 
    find_coords(DE, DE->crow, DE->ccol, &x, &y);
709 
    drawrectangle(DE, x + lwd - 1, y + lwd - 1,
710 
		  BOXW(DE->ccol+DE->colmin-1) - lwd + 1,
711 
		  DE->box_h - lwd + 1, lwd, fore);
9044 ripley 712 
}
713 
 
40748 ripley 714 
static void downlightrect(DEstruct DE)
9044 ripley 715 
{
40748 ripley 716 
    printrect(DE, 2, 0);
717 
    printrect(DE, 1, 1);
9044 ripley 718 
}
719 
 
40748 ripley 720 
static void highlightrect(DEstruct DE)
9044 ripley 721 
{
40750 ripley 722 
    if(DE->isEditor)
723 
	printrect(DE, 2, 1);
724 
    else
725 
	printrect(DE, 1, 1);
9044 ripley 726 
}
727 
 
728 
 
40748 ripley 729 
static Rboolean getccol(DEstruct DE)
9044 ripley 730 
{
731 
    SEXP tmp, tmp2;
732 
    int i, len, newlen, wcol, wrow;
733 
    SEXPTYPE type;
24272 ripley 734 
    char clab[25];
40748 ripley 735 
    Rboolean newcol = FALSE;
9044 ripley 736 
 
40748 ripley 737 
    wcol = DE->ccol + DE->colmin - 1;
738 
    wrow = DE->crow + DE->rowmin - 1;
739 
    if (wcol > DE->xmaxused) {
24272 ripley 740 
	/* extend work, names and lens */
40748 ripley 741 
	REPROTECT(DE->work = lengthgets(DE->work, wcol), DE->wpi);
742 
	REPROTECT(DE->names = lengthgets(DE->names, wcol), DE->npi);
743 
	for (i = DE->xmaxused; i < wcol; i++) {
24272 ripley 744 
	    sprintf(clab, "var%d", i + 1);
40748 ripley 745 
	    SET_STRING_ELT(DE->names, i, mkChar(clab));
24272 ripley 746 
	}
40748 ripley 747 
	REPROTECT(DE->lens = lengthgets(DE->lens, wcol), DE->lpi);
748 
	DE->xmaxused = wcol;
9044 ripley 749 
    }
40748 ripley 750 
    if (isNull(VECTOR_ELT(DE->work, wcol - 1))) {
24272 ripley 751 
	newcol = TRUE;
45070 ripley 752 
	SET_VECTOR_ELT(DE->work, wcol - 1,
40748 ripley 753 
		       ssNewVector(DE, REALSXP, max(100, wrow)));
754 
	INTEGER(DE->lens)[wcol - 1] = 0;
24272 ripley 755 
    }
40748 ripley 756 
    if (!isVector(tmp = VECTOR_ELT(DE->work, wcol - 1)))
33001 ripley 757 
	error(G_("internal type error in dataentry"));
40748 ripley 758 
    len = INTEGER(DE->lens)[wcol - 1];
24272 ripley 759 
    type = TYPEOF(tmp);
9044 ripley 760 
    if (len < wrow) {
10217 pd 761 
	for (newlen = max(len * 2, 10) ; newlen < wrow ; newlen *= 2)
9044 ripley 762 
	    ;
40748 ripley 763 
	tmp2 = ssNewVector(DE, type, newlen);
9044 ripley 764 
	for (i = 0; i < len; i++)
765 
	    if (type == REALSXP)
24272 ripley 766 
		REAL(tmp2)[i] = REAL(tmp)[i];
9044 ripley 767 
	    else if (type == STRSXP)
24272 ripley 768 
		SET_STRING_ELT(tmp2, i, STRING_ELT(tmp, i));
9044 ripley 769 
	    else
33001 ripley 770 
		error(G_("internal type error in dataentry"));
40748 ripley 771 
	SET_VECTOR_ELT(DE->work, wcol - 1, tmp2);
9044 ripley 772 
    }
40748 ripley 773 
    return newcol;
9044 ripley 774 
}
775 
 
46038 murdoch 776 
static SEXP processEscapes(SEXP x)
777 
{
778 
    SEXP newval, pattern, replacement, expr;
779 
    ParseStatus status;
780 
 
781 
    /* We process escape sequences in a scalar string by escaping
782 
       unescaped quotes, then quoting the whole thing and parsing it.  This
783 
       is supposed to be equivalent to the R code
784 
 
785 
       newval <- gsub(perl=TRUE, "(?<!\\\\)((\\\\\\\\)*)\"", "\\1\\\\\"", x)
786 
       newval <- sub('(^.*$)', '"\1"', newval)
787 
       newval <- eval(parse(text=newval))
788 
 
789 
       We do it this way to avoid extracting the escape handling
790 
       code from the parser.  We need it in C code because this may be executed
791 
       numerous times from C in dataentry.c */
792 
 
793 
    PROTECT( pattern = mkString("(?<!\\\\)((\\\\\\\\)*)\"") );
794 
    PROTECT( replacement = mkString("\\1\\\\\"") );
795 
    PROTECT( expr = lang5(install("gsub"), ScalarLogical(1), pattern, replacement, x) );
796 
    SET_TAG( CDR(expr), install("perl") );
797 
 
798 
    PROTECT( newval = eval(expr, R_BaseEnv) );
799 
    PROTECT( pattern = mkString("(^.*$)") );
800 
    PROTECT( replacement = mkString("\"\\1\"") );
801 
    PROTECT( expr = lang4(install("sub"), pattern, replacement, newval) );
802 
    PROTECT( newval = eval(expr, R_BaseEnv) );
803 
    PROTECT( expr = R_ParseVector( newval, 1, &status, R_NilValue) );
804 
 
805 
    /* We only handle the first entry. If this were available more generally,
806 
       we'd probably want to loop over all of expr */
807 
 
808 
    if (status == PARSE_OK && length(expr))
809 
	PROTECT( newval = eval(VECTOR_ELT(expr, 0), R_BaseEnv) );
810 
    else
811 
	PROTECT( newval = R_NilValue );  /* protect just so the count doesn't change */
812 
    UNPROTECT(10);
813 
    return newval;
814 
}
815 
 
9044 ripley 816 
/* close up the entry to a cell, put the value that has been entered
817 
   into the correct place and as the correct type */
818 
 
40748 ripley 819 
static void closerect(DEstruct DE)
9044 ripley 820 
{
24272 ripley 821 
    SEXP cvec;
45070 ripley 822 
    int wcol = DE->ccol + DE->colmin - 1, wrow = DE->rowmin + DE->crow - 1,
40748 ripley 823 
	wrow0;
824 
    Rboolean newcol;
9095 ripley 825 
 
40748 ripley 826 
    *(DE->bufp) = '\0';
9044 ripley 827 
 
40748 ripley 828 
    if (DE->CellModified || DE->CellEditable) {
829 
	if (DE->CellEditable) {
830 
	    strncpy(DE->buf, GA_gettext(DE->celledit), BUFSIZE-1);
831 
	    DE->clength = strlen(DE->buf);
832 
	    hide(DE->celledit);
833 
	    del(DE->celledit);
9053 ripley 834 
	}
40748 ripley 835 
	newcol = getccol(DE);
836 
	cvec = VECTOR_ELT(DE->work, wcol - 1);
837 
	wrow0 = INTEGER(DE->lens)[wcol - 1];
838 
	if (wrow > wrow0) INTEGER(DE->lens)[wcol - 1] = wrow;
839 
	DE->ymaxused = max(DE->ymaxused, wrow);
840 
	if (DE->clength != 0) {
9095 ripley 841 
	    /* do it this way to ensure NA, Inf, ...  can get set */
9053 ripley 842 
	    char *endp;
40748 ripley 843 
	    double new = R_strtod(DE->buf, &endp);
9095 ripley 844 
	    int warn = !isBlankString(endp);
46038 murdoch 845 
	    if (TYPEOF(cvec) == STRSXP) {
846 
	    	SEXP newval;
847 
	    	PROTECT( newval = mkString(DE->buf) );
848 
	    	PROTECT( newval = processEscapes(newval) );
849 
	    	if (TYPEOF(newval) == STRSXP && length(newval) == 1)
850 
		    SET_STRING_ELT(cvec, wrow - 1, STRING_ELT(newval, 0));
851 
		else
852 
		    warning(G_("dataentry: parse error on string"));
853 
		UNPROTECT(2);
854 
	    } else
9053 ripley 855 
		REAL(cvec)[wrow - 1] = new;
40748 ripley 856 
	    if (newcol && warn) {
9053 ripley 857 
		/* change mode to character */
40748 ripley 858 
		SEXP tmp = coerceVector(cvec, STRSXP);
859 
		SET_STRING_ELT(tmp, wrow - 1, mkChar(DE->buf));
860 
		SET_VECTOR_ELT(DE->work, wcol - 1, tmp);
9053 ripley 861 
	    }
9044 ripley 862 
	} else {
9095 ripley 863 
	    if (TYPEOF(cvec) == STRSXP)
10172 luke 864 
		SET_STRING_ELT(cvec, wrow - 1, NA_STRING);
9095 ripley 865 
	    else
9053 ripley 866 
		REAL(cvec)[wrow - 1] = NA_REAL;
9044 ripley 867 
	}
40748 ripley 868 
	drawelt(DE, DE->crow, DE->ccol);  /* to get the cell scrolling right */
869 
	if(wrow > wrow0) drawcol(DE, wcol); /* to fill in NAs */
9044 ripley 870 
    }
40748 ripley 871 
    DE->CellEditable = DE->CellModified = FALSE;
9044 ripley 872 
 
40748 ripley 873 
    downlightrect(DE);
874 
    gsetcursor(DE->de, ArrowCursor);
9044 ripley 875 
 
40748 ripley 876 
    DE->ndecimal = 0;
877 
    DE->nneg = 0;
878 
    DE->ne = 0;
879 
    DE->currentexp = 0;
880 
    DE->clength = 0;
881 
    DE->inSpecial = 0;
882 
    DE->bufp = DE->buf;
9044 ripley 883 
}
884 
 
885 
/* print a null terminated string, check to see if it is longer than
886 
   the print area and print it, left adjusted if necessary; clear the
887 
   area of previous text; */
888 
 
38332 murdoch 889 
/* This version will only display BUFSIZE chars, but the maximum col width
24276 ripley 890 
   will not allow that many */
45070 ripley 891 
static void printstring(DEstruct DE, const char *ibuf, int buflen,
41783 ripley 892 
			int row, int col, int left)
9044 ripley 893 
{
9837 ripley 894 
    int x_pos, y_pos, bw, fw, bufw;
38332 murdoch 895 
    char buf[BUFSIZE+1];
9044 ripley 896 
 
40748 ripley 897 
    find_coords(DE, row, col, &x_pos, &y_pos);
898 
    if (col == 0) bw = DE->boxw[0]; else bw = BOXW(col+DE->colmin-1);
899 
    cleararea(DE, x_pos + 1, y_pos + 1, bw - 1, DE->box_h - 1,
46784 murdoch 900 
	      (row==0 || col==0) ? bbg:DE->p->guiColors[dataeditbg]);
40748 ripley 901 
    fw = min(BUFSIZE, (bw - 8)/(DE->p->fw));
9837 ripley 902 
    bufw = min(fw, buflen);
903 
    strncpy(buf, ibuf, bufw);
904 
    buf[bufw] = '\0';
9079 ripley 905 
    if (buflen > fw) {
9048 ripley 906 
	if(left) {
9837 ripley 907 
	    strncpy(buf, ibuf + buflen - fw, fw);
29162 ripley 908 
	    buf[fw] = '\0';
9837 ripley 909 
	    *buf = '<';
9048 ripley 910 
	} else {
9837 ripley 911 
	    *(buf + fw - 1) = '>';
912 
	    *(buf + fw) = '\0';
9048 ripley 913 
	}
9044 ripley 914 
    }
40748 ripley 915 
    de_drawtext(DE, x_pos + DE->text_xoffset, y_pos - DE->text_yoffset, buf);
9044 ripley 916 
}
917 
 
40748 ripley 918 
static void clearrect(DEstruct DE)
9044 ripley 919 
{
9079 ripley 920 
    int x_pos, y_pos;
24276 ripley 921 
 
40748 ripley 922 
    find_coords(DE, DE->crow, DE->ccol, &x_pos, &y_pos);
45070 ripley 923 
    cleararea(DE, x_pos, y_pos, BOXW(DE->ccol+DE->colmin-1),
46784 murdoch 924 
	      DE->box_h, DE->p->guiColors[dataeditbg]);
9044 ripley 925 
}
926 
 
927 
/* handlechar has to be able to parse decimal numbers and strings,
928 
   depending on the current column type, only printing characters
929 
   should get this far */
930 
 
931 
/* --- Not true! E.g. ESC ends up in here... */
932 
 
43800 ripley 933 
static void handlechar(DEstruct DE, const char *text)
9044 ripley 934 
{
9079 ripley 935 
    int c = text[0];
9044 ripley 936 
 
937 
    if ( c == '\033' ) {
40748 ripley 938 
	DE->CellModified = FALSE;
939 
	DE->clength = 0;
940 
	drawelt(DE, DE->crow, DE->ccol);
941 
	gsetcursor(DE->de, ArrowCursor);
9044 ripley 942 
	return;
9079 ripley 943 
    } else {
40748 ripley 944 
	DE->CellModified = TRUE;
945 
	gsetcursor(DE->de, TextCursor);
9044 ripley 946 
    }
9095 ripley 947 
 
40748 ripley 948 
    if (DE->clength == 0) {
949 
	switch(get_col_type(DE, DE->ccol + DE->colmin - 1)) {
9079 ripley 950 
	case NUMERIC:
40748 ripley 951 
	    DE->currentexp = 1;
9079 ripley 952 
	    break;
953 
	default:
40748 ripley 954 
	    DE->currentexp = 2;
9079 ripley 955 
	}
40748 ripley 956 
	clearrect(DE);
957 
	highlightrect(DE);
9044 ripley 958 
    }
959 
 
40748 ripley 960 
    if (DE->currentexp == 1)	/* we are parsing a number */
9044 ripley 961 
	switch (c) {
962 
	case '-':
40748 ripley 963 
	    if (DE->nneg == 0)
964 
		DE->nneg++;
9044 ripley 965 
	    else
966 
		goto donehc;
967 
	    break;
968 
	case '.':
40748 ripley 969 
	    if (DE->ndecimal == 0)
970 
		DE->ndecimal++;
9044 ripley 971 
	    else
972 
		goto donehc;
973 
	    break;
974 
	case 'e':
975 
	case 'E':
40748 ripley 976 
	    if (DE->ne == 0) {
977 
		DE->nneg = DE->ndecimal = 0;	/* might have decimal in exponent */
978 
		DE->ne++;
9044 ripley 979 
	    }
980 
	    else
981 
		goto donehc;
982 
	    break;
40748 ripley 983 
	case 'N':
984 
	    if(DE->nneg) goto donehc;
985 
	case 'I':
986 
	    DE->inSpecial++;
987 
	    break;
9044 ripley 988 
	default:
40748 ripley 989 
	    if (!DE->inSpecial && !isdigit((int)text[0]))
9044 ripley 990 
		goto donehc;
991 
	    break;
992 
	}
993 
 
40748 ripley 994 
    if (DE->clength++ > 199) {
33001 ripley 995 
	warning(G_("dataentry: expression too long"));
40748 ripley 996 
	DE->clength--;
9044 ripley 997 
	goto donehc;
998 
    }
999 
 
40748 ripley 1000 
    *(DE->bufp)++ = text[0];
1001 
    printstring(DE, DE->buf, DE->clength, DE->crow, DE->ccol, 1);
9044 ripley 1002 
    return;
1003 
 
45070 ripley 1004 
donehc:
9044 ripley 1005 
    bell();
1006 
}
1007 
 
40748 ripley 1008 
static void printlabs(DEstruct DE)
9044 ripley 1009 
{
41783 ripley 1010 
    char clab[15];
1011 
    const char *p;
9044 ripley 1012 
    int i;
1013 
 
40748 ripley 1014 
    for (i = DE->colmin; i <= DE->colmax; i++) {
1015 
	p = get_col_name(DE, i);
1016 
	printstring(DE, p, strlen(p), 0, i - DE->colmin + 1, 0);
9079 ripley 1017 
    }
40748 ripley 1018 
    for (i = DE->rowmin; i <= DE->rowmax; i++) {
1019 
	sprintf(clab, DE->labform, i);
1020 
	printstring(DE, clab, strlen(clab), i - DE->rowmin + 1, 0, 0);
9044 ripley 1021 
    }
1022 
}
1023 
 
45070 ripley 1024 
	      /* ================ GraphApp-specific ================ */
9095 ripley 1025 
 
24276 ripley 1026 
static void bell(void)
9044 ripley 1027 
{
1028 
    gabeep();
1029 
}
1030 
 
40748 ripley 1031 
static void cleararea(DEstruct DE,
1032 
		      int xpos, int ypos, int width, int height, rgb col)
9044 ripley 1033 
{
40748 ripley 1034 
    gfillrect(DE->de, col, rect(xpos, ypos, width, height));
9044 ripley 1035 
}
1036 
 
40748 ripley 1037 
static void clearwindow(DEstruct DE)
9044 ripley 1038 
{
46784 murdoch 1039 
    gfillrect(DE->de, DE->p->guiColors[dataeditbg], rect(0, 0, DE->p->w, DE->p->h));
9044 ripley 1040 
}
1041 
 
1042 
 
45070 ripley 1043 
static void drawrectangle(DEstruct DE,
40748 ripley 1044 
			  int xpos, int ypos, int width, int height,
9044 ripley 1045 
			  int lwd, int fore)
1046 
{
12778 pd 1047 
    /* only used on screen, so always fast */
46784 murdoch 1048 
    gdrawrect(DE->de, lwd, 0, (fore==1)? DE->p->guiColors[dataedituser]: DE->p->guiColors[dataeditbg],
45070 ripley 1049 
	      rect(xpos, ypos, width, height), 1, PS_ENDCAP_SQUARE,
31630 ripley 1050 
	      PS_JOIN_BEVEL, 10);
9044 ripley 1051 
}
1052 
 
43800 ripley 1053 
static void de_drawtext(DEstruct DE, int xpos, int ypos, const char *text)
9044 ripley 1054 
{
46784 murdoch 1055 
    gdrawstr(DE->de, DE->p->f, DE->p->guiColors[dataeditfg], pt(xpos, ypos), text);
9044 ripley 1056 
}
1057 
 
1058 
/* Keypress callbacks */
1059 
 
9212 ripley 1060 
static void de_normalkeyin(control c, int k)
9044 ripley 1061 
{
1062 
    int i, st;
1063 
    char text[1];
40748 ripley 1064 
    DEstruct DE = getdata(c);
9044 ripley 1065 
 
1066 
    st = ggetkeystate();
40748 ripley 1067 
    if ((DE->p->chbrk) && (k == DE->p->chbrk) &&
1068 
	((!DE->p->modbrk) || ((DE->p->modbrk) && (st == DE->p->modbrk)))) {
1069 
	DE->p->fbrk(c);
9044 ripley 1070 
	return;
1071 
    }
9079 ripley 1072 
    if (st & CtrlKey) {
9044 ripley 1073 
	switch (k + 'A' - 1) {
1074 
	case 'B':
40748 ripley 1075 
	    i = DE->rowmin - DE->nhigh + 2;
1076 
	    jumpwin(DE, DE->colmin, max(i, 1));
9044 ripley 1077 
	    break;
1078 
	case 'F':
40748 ripley 1079 
	    jumpwin(DE, DE->colmin, DE->rowmax);
9044 ripley 1080 
	    break;
1081 
	case 'H':
40748 ripley 1082 
	    moveback(DE);
9044 ripley 1083 
	    break;
1084 
	case 'I':
40748 ripley 1085 
	    if (st & ShiftKey) advancerect(DE, LEFT);
1086 
	    else advancerect(DE, RIGHT);
9044 ripley 1087 
	    break;
1088 
	case 'N':
1089 
	case 'J':
40748 ripley 1090 
	    advancerect(DE, DOWN);
9044 ripley 1091 
	    break;
9079 ripley 1092 
	case 'C':
40748 ripley 1093 
	    de_copy(DE->de);
9079 ripley 1094 
	    break;
1095 
	case 'V':
40748 ripley 1096 
	    de_paste(DE->de);
9079 ripley 1097 
	    break;
1098 
	case 'L':
40748 ripley 1099 
	    for (i = DE->colmin; i < DE->colmax; i++)
1100 
		if (i < 100)
1101 
		    DE->boxw[i] = get_col_width(DE, i)*(DE->p->fw) + 8;
1102 
	    drawwindow(DE);
9079 ripley 1103 
	    break;
9044 ripley 1104 
	default:
1105 
	    bell();
1106 
	}
1107 
    } else if(k == '\b') {
40748 ripley 1108 
	moveback(DE);
9044 ripley 1109 
    } else if(k == '\n' || k == '\r') {
45070 ripley 1110 
	advancerect(DE, DOWN);
9044 ripley 1111 
    } else if(k == '\t') {
40748 ripley 1112 
	if (st & ShiftKey) advancerect(DE, LEFT);
1113 
	else advancerect(DE, RIGHT);
9044 ripley 1114 
    } else {
1115 
	text[0] = k;
40748 ripley 1116 
	handlechar(DE, text);
9044 ripley 1117 
    }
1118 
 
1119 
}
1120 
 
45067 ripley 1121 
static void de_im(control c, font *f, point *pt)
1122 
{
1123 
    DEstruct DE = getdata(c);
1124 
    int x, y;
1125 
 
1126 
    drawelt(DE, DE->crow, DE->ccol);
1127 
    gsetcursor(DE->de, ArrowCursor);
1128 
    find_coords(DE, DE->crow, DE->ccol, &x, &y);
1129 
    pt->x = x + DE->text_xoffset + DE->clength * fontwidth(consolefn);
1130 
    pt->y = y - DE->text_yoffset - 1;
1131 
    *f = consolefn;
1132 
}
1133 
 
9212 ripley 1134 
static void de_ctrlkeyin(control c, int key)
9044 ripley 1135 
{
1136 
    int st, i;
40748 ripley 1137 
    DEstruct DE = getdata(c);
9044 ripley 1138 
 
1139 
    st = ggetkeystate();
40748 ripley 1140 
    if ((DE->p->chbrk) && (key == DE->p->chbrk) &&
1141 
	((!DE->p->modbrk) || ((DE->p->modbrk) && (st == DE->p->modbrk)))) {
1142 
	DE->p->fbrk(c);
9044 ripley 1143 
	return;
1144 
    }
1145 
    switch (key) {
1146 
    case HOME:
40748 ripley 1147 
	jumpwin(DE, 1, 1);
1148 
	downlightrect(DE);
1149 
	DE->crow = DE->ccol = 1;
1150 
	highlightrect(DE);
9044 ripley 1151 
	break;
1152 
    case END:
40748 ripley 1153 
	i = DE->ymaxused - DE->nhigh + 2;
40750 ripley 1154 
	if(DE->isEditor)
1155 
	    jumpwin(DE, DE->xmaxused, max(i, 1));
40757 ripley 1156 
	else {
1157 
	    /* Try to work out which cols we can fit in */
1158 
	    int j, w = 0;
1159 
	    for(j = DE->xmaxused;j >= 0; j--) {
1160 
		w += BOXW(j);
1161 
		if(w > DE->p->w) break;
1162 
	    }
1163 
	    jumpwin(DE, min(j+2, DE->xmaxused), max(i, 1));
1164 
	}
40748 ripley 1165 
	downlightrect(DE);
1166 
	DE->crow = DE->ymaxused - DE->rowmin + 1;
1167 
	DE->ccol = 1;
1168 
	highlightrect(DE);
9044 ripley 1169 
	break;
1170 
    case PGUP:
40748 ripley 1171 
	i = DE->rowmin - DE->nhigh + 2;
1172 
	jumpwin(DE, DE->colmin, max(i, 1));
9044 ripley 1173 
	break;
1174 
    case PGDN:
40757 ripley 1175 
	i = DE->ymaxused - DE->nhigh + 2;
1176 
	if(DE->isEditor)
1177 
	    jumpwin(DE, DE->colmin, DE->rowmax);
1178 
	else
1179 
	    jumpwin(DE, DE->colmin, min(i, DE->rowmax));
9044 ripley 1180 
	break;
1181 
    case LEFT:
40748 ripley 1182 
	advancerect(DE, LEFT);
9044 ripley 1183 
	break;
1184 
    case RIGHT:
40748 ripley 1185 
	advancerect(DE, RIGHT);
9044 ripley 1186 
	break;
1187 
    case UP:
40748 ripley 1188 
	advancerect(DE, UP);
9044 ripley 1189 
	break;
1190 
    case DOWN:
40748 ripley 1191 
	advancerect(DE, DOWN);
9044 ripley 1192 
	break;
1193 
    case DEL:
40748 ripley 1194 
	moveback(DE);
9044 ripley 1195 
	break;
1196 
     case ENTER:
40748 ripley 1197 
	 advancerect(DE, DOWN);
9044 ripley 1198 
	 break;
1199 
    default:
1200 
	;
1201 
    }
1202 
}
1203 
 
1204 
/* mouse callbacks */
1205 
 
41861 ripley 1206 
static const char *get_cell_text(DEstruct DE)
9079 ripley 1207 
{
40748 ripley 1208 
    int  wrow = DE->rowmin + DE->crow - 2, wcol = DE->colmin + DE->ccol - 1;
41861 ripley 1209 
    const char *prev = "";
9079 ripley 1210 
    SEXP tvec;
1211 
 
40748 ripley 1212 
    if (wcol <= DE->xmaxused) {
1213 
	tvec = VECTOR_ELT(DE->work, wcol - 1);
1214 
	if (!isNull(tvec) && wrow < INTEGER(DE->lens)[wcol - 1]) {
9079 ripley 1215 
	    PrintDefaults(R_NilValue);
1216 
	    if (TYPEOF(tvec) == REALSXP) {
40748 ripley 1217 
		prev = EncodeElement(tvec, wrow, 0, '.');
9079 ripley 1218 
	    } else if (TYPEOF(tvec) == STRSXP) {
40748 ripley 1219 
		if (STRING_ELT(tvec, wrow) != DE->ssNA_STRING)
34294 ripley 1220 
		    prev = EncodeElement(tvec, wrow, 0, '.');
33001 ripley 1221 
	    } else error(G_("dataentry: internal memory error"));
9079 ripley 1222 
	}
1223 
    }
1224 
    return prev;
1225 
}
1226 
 
1227 
static int online, clickline;
1228 
 
9212 ripley 1229 
static void de_mousedown(control c, int buttons, point xy)
9044 ripley 1230 
{
9079 ripley 1231 
    int xw, yw, wcol=0, wrow, i, w;
40748 ripley 1232 
    DEstruct DE;
9095 ripley 1233 
 
9079 ripley 1234 
    if (buttons & LeftButton) {
40748 ripley 1235 
	DE = getdata(c);
9044 ripley 1236 
	xw = xy.x;
1237 
	yw = xy.y;
9095 ripley 1238 
 
40748 ripley 1239 
	closerect(DE);
9095 ripley 1240 
 
9044 ripley 1241 
	/* check to see if the click was in the header */
1242 
 
40748 ripley 1243 
	if (yw < DE->hwidth + DE->bwidth) {
9044 ripley 1244 
	    /* too high */
1245 
	    return;
1246 
	}
1247 
	/* translate to box coordinates */
1248 
 
40748 ripley 1249 
	wrow = (yw - DE->bwidth - DE->hwidth) / DE->box_h;
9044 ripley 1250 
 
1251 
	/* see if it is in the row labels */
40748 ripley 1252 
	if (xw < DE->bwidth + DE->boxw[0]) {
9044 ripley 1253 
	    bell();
40748 ripley 1254 
	    highlightrect(DE);
9044 ripley 1255 
	    return;
1256 
	}
40748 ripley 1257 
	w = DE->bwidth + DE->boxw[0];
1258 
	for (i = 1; i <= DE->nwide; i++)
1259 
	    if((w += BOXW(i+DE->colmin-1)) > xw) {
9079 ripley 1260 
		wcol = i;
1261 
		break;
45070 ripley 1262 
	    }
9095 ripley 1263 
 
1264 
	/* see if we selected a line */
40748 ripley 1265 
	w = DE->bwidth;
9079 ripley 1266 
	online = 0;
40748 ripley 1267 
	for (i = 0; i <= DE->nwide; i++) {
1268 
	    if(i == 0) w += DE->boxw[0]; else w += BOXW(i+DE->colmin-1);
9079 ripley 1269 
	    if (abs(w - xw) <= 2) {
1270 
		online = 1;
1271 
		clickline = i; /* between cols i and i+1 */
40748 ripley 1272 
		highlightrect(DE);
1273 
		gsetcursor(DE->de, HandCursor);
9079 ripley 1274 
		return;
1275 
	    }
1276 
	}
9044 ripley 1277 
 
1278 
	/* next check to see if it is in the column labels */
1279 
 
40748 ripley 1280 
	if (yw < DE->hwidth + DE->bwidth + DE->box_h) {
1281 
	    if (xw > DE->bwidth + DE->boxw[0]) {
1282 
		highlightrect(DE);
1283 
		de_popupmenu(DE, xw, yw, wcol);
9095 ripley 1284 
		return;
1285 
	    } else {
9044 ripley 1286 
		/* in 0th column */
40748 ripley 1287 
		highlightrect(DE);
9044 ripley 1288 
		bell();
1289 
	    }
40748 ripley 1290 
	} else if (wrow > DE->nhigh - 1 || wcol > DE->nwide - 1) {
45070 ripley 1291 
	    /* off the grid */
1292 
	    highlightrect(DE);
1293 
	    bell();
1294 
	    return;
9067 ripley 1295 
	} else if (buttons & DblClick) {
9095 ripley 1296 
	    int x, y, bw;
41861 ripley 1297 
	    const char *prev;
9053 ripley 1298 
	    rect rr;
9095 ripley 1299 
 
40748 ripley 1300 
	    DE->ccol = wcol;
1301 
	    DE->crow = wrow;
1302 
	    highlightrect(DE);
1303 
	    find_coords(DE, DE->crow, DE->ccol, &x, &y);
1304 
	    bw = BOXW(DE->ccol + DE->colmin - 1);
1305 
	    rr = rect(x + DE->text_xoffset, y - DE->text_yoffset - 1,
1306 
		      bw - DE->text_xoffset - 2,
1307 
		      DE->box_h - DE->text_yoffset - 2);
1308 
	    prev = get_cell_text(DE);
1309 
	    if (strlen(prev) * (DE->p->fw) > bw)
1310 
		rr.width = (strlen(prev) + 2) * (DE->p->fw);
1311 
	    addto(DE->de);
1312 
	    DE->celledit = newfield_no_border(prev, rr);
1313 
	    settextfont(DE->celledit, DE->p->f);
46784 murdoch 1314 
	    setbackground(DE->celledit, DE->p->guiColors[dataeditbg]);
1315 
	    setforeground(DE->celledit, DE->p->guiColors[dataedituser]);
1316 
 
40748 ripley 1317 
	    show(DE->celledit);
1318 
	    DE->CellEditable = TRUE;
9067 ripley 1319 
	} else if (buttons & LeftButton) {
40748 ripley 1320 
	    DE->ccol = wcol;
1321 
	    DE->crow = wrow;
9044 ripley 1322 
	}
40748 ripley 1323 
	highlightrect(DE);
9044 ripley 1324 
	return;
1325 
    }
1326 
}
1327 
 
9212 ripley 1328 
static void de_mouseup(control c, int buttons, point xy)
9079 ripley 1329 
{
1330 
    int xw, bw, i, w;
40748 ripley 1331 
    DEstruct DE;
9095 ripley 1332 
 
9079 ripley 1333 
    if (online) {
40748 ripley 1334 
	DE = getdata(c);
9079 ripley 1335 
	xw = xy.x;
40748 ripley 1336 
	w = DE->bwidth + DE->boxw[0];
1337 
	for(i = 1; i < clickline; i++) w+= BOXW(i+DE->colmin-1);
9079 ripley 1338 
	bw = xw - w;
40748 ripley 1339 
	if (bw < (DE->p->fw)*4 + 8) bw = (DE->p->fw)*4 + 8;
1340 
	if (bw > (DE->p->fw)*50) bw = (DE->p->fw)*50;
1341 
	if(clickline < 100) DE->boxw[clickline] = bw;
1342 
	gsetcursor(DE->de, ArrowCursor);
1343 
	deredraw(DE);
9079 ripley 1344 
    }
1345 
}
1346 
 
9212 ripley 1347 
static void de_redraw(control c, rect r)
9044 ripley 1348 
{
40748 ripley 1349 
    DEstruct DE = getdata(c);
1350 
    if (DE->p->w != DE->oldWIDTH || DE->p->h != DE->oldHEIGHT) drawwindow(DE);
1351 
    else deredraw(DE);
9044 ripley 1352 
}
1353 
 
40748 ripley 1354 
static void deredraw(DEstruct DE)
9095 ripley 1355 
{
9212 ripley 1356 
    int i;
9095 ripley 1357 
 
40748 ripley 1358 
    setcellwidths(DE);
9124 ripley 1359 
 
40748 ripley 1360 
    if(DE->hwidth > 0)
1361 
	gfillrect(DE->de, bbg, rect(0, 0, DE->p->w, DE->hwidth));
1362 
    gfillrect(DE->de, bbg, rect(0, 0, DE->boxw[0], DE->windowHeight));
9095 ripley 1363 
 
40748 ripley 1364 
    for (i = 1; i < DE->nhigh; i++)
45070 ripley 1365 
	drawrectangle(DE, 0, DE->hwidth + i * DE->box_h, DE->boxw[0],
40748 ripley 1366 
		      DE->box_h, 1, 1);
40750 ripley 1367 
    if(DE->isEditor) {
1368 
	DE->colmax = DE->colmin + (DE->nwide - 2);
1369 
	DE->rowmax = DE->rowmin + (DE->nhigh - 2);
1370 
    } else {
1371 
	DE->colmax = min(DE->xmaxused, DE->colmin + (DE->nwide - 2));
1372 
	DE->rowmax = min(DE->ymaxused, DE->rowmin + (DE->nhigh - 2));
1373 
    }
40748 ripley 1374 
    printlabs(DE);
1375 
    for (i = DE->colmin; i <= DE->colmax; i++) drawcol(DE,i);
46784 murdoch 1376 
    gfillrect(DE->de, DE->p->guiColors[dataeditbg], rect(DE->windowWidth+1, DE->hwidth,
40748 ripley 1377 
				      DE->p->w - DE->windowWidth-1,
1378 
				      DE->p->h - DE->hwidth));
1379 
    highlightrect(DE);
9095 ripley 1380 
}
1381 
 
40748 ripley 1382 
static void de_closewin(DEstruct DE)
9044 ripley 1383 
{
40748 ripley 1384 
    closerect(DE);
1385 
    hide(DE->de);
1386 
    del(DE->de);
9044 ripley 1387 
}
1388 
 
40748 ripley 1389 
static void copyarea(DEstruct DE, int src_x, int src_y, int dest_x, int dest_y)
9048 ripley 1390 
{
9095 ripley 1391 
    int mx = max(src_x, dest_x), my = max(src_y, dest_y);
40748 ripley 1392 
    copyrect(DE->de, pt(dest_x, dest_y),
1393 
	     rect(src_x, src_y, DE->windowWidth - mx, DE->windowHeight - my));
9048 ripley 1394 
}
1395 
 
40748 ripley 1396 
static void copyH(DEstruct DE, int src_x, int dest_x, int width)
9095 ripley 1397 
{
40748 ripley 1398 
    copyrect(DE->de, pt(dest_x, DE->hwidth),
1399 
	     rect(src_x, DE->hwidth, width, DE->windowHeight - DE->hwidth));
9095 ripley 1400 
}
1401 
 
41783 ripley 1402 
static Rboolean initwin(DEstruct DE, const char *title)
9095 ripley 1403 
{
40748 ripley 1404 
    int i, labdigs;
9044 ripley 1405 
    rect r;
9079 ripley 1406 
 
40750 ripley 1407 
    DE->de = newdataeditor(DE, title);
40748 ripley 1408 
    if(!DE->de) return TRUE;
1409 
    DE->oldWIDTH = DE->oldHEIGHT = 0;
1410 
    DE->nboxchars = 5;
9079 ripley 1411 
 
40748 ripley 1412 
    DE->nboxchars = asInteger(GetOption(install("de.cellwidth"), R_GlobalEnv));
1413 
    if (DE->nboxchars == NA_INTEGER || DE->nboxchars < 0) DE->nboxchars = 0;
1414 
    if (DE->nboxchars > 0) check(DE->de_mvw);
1415 
    DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
24272 ripley 1416 
    /* this used to presume 4 chars sufficed for row numbering */
40748 ripley 1417 
    labdigs = max(3, 1+floor(log10((double)DE->ymaxused)));
1418 
    DE->boxw[0] = (1+labdigs)*(DE->p->fw) + 8;
1419 
    sprintf(DE->labform, "%%%dd", labdigs);
1420 
    for(i = 1; i < 100; i++)
1421 
	DE->boxw[i] = get_col_width(DE, i) * (DE->p->fw) + 8;
1422 
    DE->box_h = (DE->p->fh) + 4;
1423 
    DE->text_xoffset = 5;
1424 
    DE->text_yoffset = -3;
1425 
    setcellwidths(DE);
1426 
    DE->nhigh = (DE->p->h - 2 * DE->bwidth - DE->hwidth - 3) / DE->box_h;
40750 ripley 1427 
    if(!DE->isEditor && DE->nhigh > DE->ymaxused+1) DE->nhigh = DE->ymaxused+1;
40748 ripley 1428 
    DE->windowHeight = DE->nhigh * DE->box_h + 2 * DE->bwidth + DE->hwidth;
1429 
    r = getrect(DE->de);
1430 
    r.width = DE->windowWidth + 3;
1431 
    r.height = DE->windowHeight + 3;
1432 
    resize(DE->de, r);
9079 ripley 1433 
 
40748 ripley 1434 
    DE->CellModified = DE->CellEditable = FALSE;
9229 ripley 1435 
    bbg = dialog_bg();
9044 ripley 1436 
    /* set the active cell to be the upper left one */
40748 ripley 1437 
    DE->crow = 1;
1438 
    DE->ccol = 1;
9095 ripley 1439 
    /* drawwindow(); done as repaint but
1440 
       decide if we need scrollbars here to avoid flashing*/
40748 ripley 1441 
    DE->nhigh = (DE->p->h - 2 * DE->bwidth - DE->hwidth) / DE->box_h;
1442 
    gchangescrollbar(DE->de, VWINSB, 0, DE->ymaxused/DE->yScrollbarScale,
1443 
		     max(DE->nhigh/DE->yScrollbarScale, 1), 0);
1444 
    setcellwidths(DE);
1445 
    gchangescrollbar(DE->de, HWINSB, 0, DE->xmaxused/DE->xScrollbarScale,
1446 
		     max(DE->nwide/DE->xScrollbarScale, 1), 0);
1447 
    show(DE->de);
1448 
    show(DE->de); /* a precaution, as PD reports transparent windows */
1449 
    BringToTop(DE->de, 0);
1450 
    DE->buf[BUFSIZE-1] = '\0';
24276 ripley 1451 
    return FALSE;
9044 ripley 1452 
}
1453 
 
1454 
/* Menus */
1455 
 
9205 ripley 1456 
static window wconf, devw;
9044 ripley 1457 
static radiobutton rb_num, rb_char;
1458 
static label lwhat, lrb;
1459 
static field varname;
1460 
static int isnumeric, popupcol;
1461 
 
1462 
static void popupclose(control c)
1463 
{
1464 
    SEXP tvec;
38332 murdoch 1465 
    char buf[BUFSIZE], clab[25];
24272 ripley 1466 
    int i;
40748 ripley 1467 
    DEstruct DE = getdata(c);
1468 
 
38332 murdoch 1469 
    buf[BUFSIZE-1] = '\0';
39274 ripley 1470 
    strncpy(buf, GA_gettext(varname), BUFSIZE-1);
9323 ripley 1471 
    if(!strlen(buf)) {
33093 ripley 1472 
	askok(G_("column names cannot be blank"));
9044 ripley 1473 
	return;
1474 
    }
40748 ripley 1475 
    if (popupcol > DE->xmaxused) {
24272 ripley 1476 
	/* extend work, names and lens */
40748 ripley 1477 
	REPROTECT(DE->work = lengthgets(DE->work, popupcol), DE->wpi);
1478 
	REPROTECT(DE->names = lengthgets(DE->names, popupcol), DE->npi);
24272 ripley 1479 
	/* Last col name is set later */
40748 ripley 1480 
	for (i = DE->xmaxused+1; i < popupcol - 1; i++) {
24272 ripley 1481 
	    sprintf(clab, "var%d", i + 1);
40748 ripley 1482 
	    SET_STRING_ELT(DE->names, i, mkChar(clab));
24272 ripley 1483 
	}
40748 ripley 1484 
	REPROTECT(DE->lens = lengthgets(DE->lens, popupcol), DE->lpi);
1485 
	DE->xmaxused = popupcol;
9044 ripley 1486 
    }
40748 ripley 1487 
    tvec = VECTOR_ELT(DE->work, popupcol - 1);
9044 ripley 1488 
    if(ischecked(rb_num) && !isnumeric) {
27357 murdoch 1489 
	if (isNull(tvec))
45070 ripley 1490 
	    SET_VECTOR_ELT(DE->work, popupcol - 1,
40748 ripley 1491 
			   ssNewVector(DE, REALSXP, 100));
24272 ripley 1492 
	else
40748 ripley 1493 
	    SET_VECTOR_ELT(DE->work, popupcol - 1, coerceVector(tvec, REALSXP));
9044 ripley 1494 
    } else if(ischecked(rb_char) && isnumeric) {
27357 murdoch 1495 
	if (isNull(tvec))
45070 ripley 1496 
	    SET_VECTOR_ELT(DE->work, popupcol - 1,
40748 ripley 1497 
			   ssNewVector(DE, STRSXP, 100));
24272 ripley 1498 
	else
40748 ripley 1499 
	    SET_VECTOR_ELT(DE->work, popupcol - 1, coerceVector(tvec, STRSXP));
9044 ripley 1500 
    }
40748 ripley 1501 
    SET_STRING_ELT(DE->names, popupcol - 1, mkChar(buf));
9044 ripley 1502 
    hide(wconf);
1503 
    del(wconf);
1504 
}
1505 
 
9205 ripley 1506 
static void nm_hit_key(window w, int key)
1507 
{
1508 
    if(key == '\n') popupclose(wconf);
1509 
}
1510 
 
40748 ripley 1511 
static void de_popupmenu(DEstruct DE, int x_pos, int y_pos, int col)
9044 ripley 1512 
{
41783 ripley 1513 
    const char *blah;
40748 ripley 1514 
    rect r = screen_coords(DE->de);
9044 ripley 1515 
 
40748 ripley 1516 
    popupcol = DE->colmin + col - 1;
1517 
    blah = get_col_name(DE, popupcol);
33093 ripley 1518 
    wconf = newwindow(G_("Variable editor"),
9044 ripley 1519 
		      rect(x_pos + r.x-150, y_pos + r.y-50, 300, 100),
11073 ripley 1520 
		      Titlebar | Closebox | Modal);
9044 ripley 1521 
    setclose(wconf, popupclose);
9212 ripley 1522 
    setbackground(wconf, bbg);
33093 ripley 1523 
    lwhat = newlabel(G_("variable name"), rect(10, 22, 90, 20), AlignLeft);
41793 ripley 1524 
    varname = newfield(blah, rect(100, 20, 120, 20));
33093 ripley 1525 
    lrb = newlabel(G_("type"), rect(50, 62, 50, 20), AlignLeft);
9044 ripley 1526 
    rb_num = newradiobutton("numeric", rect(100, 60 , 80, 20), NULL);
1527 
    rb_char = newradiobutton("character", rect(180, 60 , 80, 20), NULL);
40748 ripley 1528 
    isnumeric = (get_col_type(DE, popupcol) == NUMERIC);
9044 ripley 1529 
    if (isnumeric) check(rb_num); else check(rb_char);
9205 ripley 1530 
    setkeydown(wconf, nm_hit_key);
40748 ripley 1531 
    setdata(wconf, DE); /* for popupclose, nm_hit_key */
9044 ripley 1532 
    show(wconf);
1533 
}
9079 ripley 1534 
 
9212 ripley 1535 
static void de_copy(control c)
9079 ripley 1536 
{
40748 ripley 1537 
    DEstruct DE = getdata(c);
1538 
    copystringtoclipboard(get_cell_text(DE));
9079 ripley 1539 
}
1540 
 
9212 ripley 1541 
static void de_paste(control c)
9079 ripley 1542 
{
9212 ripley 1543 
    char *p;
40748 ripley 1544 
    DEstruct DE = getdata(c);
9079 ripley 1545 
 
40748 ripley 1546 
    closerect(DE);
9212 ripley 1547 
    if ( clipboardhastext() &&
40748 ripley 1548 
	 !getstringfromclipboard(DE->buf, BUFSIZE-1) ) {
9212 ripley 1549 
	/* set current cell to first line of clipboard */
40748 ripley 1550 
	DE->CellModified = TRUE;
1551 
	if ((p = strchr(DE->buf, '\n'))) *p = '\0';
1552 
	DE->clength = strlen(DE->buf);
1553 
	DE->bufp = DE->buf + DE->clength;
1554 
	closerect(DE);
9079 ripley 1555 
    }
40748 ripley 1556 
    highlightrect(DE);
9079 ripley 1557 
}
1558 
 
9212 ripley 1559 
static void de_delete(control c)
9205 ripley 1560 
{
40748 ripley 1561 
    DEstruct DE = getdata(c);
1562 
    DE->CellModified = TRUE;
1563 
    DE->buf[0] = '\0';
40869 ripley 1564 
    DE->clength = 0;
40748 ripley 1565 
    DE->bufp = DE->buf + DE->clength;
1566 
    closerect(DE);
1567 
    highlightrect(DE);
9205 ripley 1568 
}
1569 
 
9212 ripley 1570 
static void de_autosize(control c)
9079 ripley 1571 
{
40748 ripley 1572 
    DEstruct DE = getdata(c);
1573 
    int col = DE->ccol + DE->colmin - 1;
9837 ripley 1574 
 
40748 ripley 1575 
    closerect(DE);
9095 ripley 1576 
    if(col < 100) {
40748 ripley 1577 
	DE->boxw[col] = get_col_width(DE,col)*(DE->p->fw) + 8;
1578 
	deredraw(DE);
9095 ripley 1579 
    }
9079 ripley 1580 
}
1581 
 
27662 murdoch 1582 
static void de_stayontop(control c)
1583 
{
40748 ripley 1584 
    DEstruct DE = getdata(c);
1585 
    BringToTop(DE->de, 2);
27662 murdoch 1586 
}
1587 
 
9212 ripley 1588 
static void de_sbf(control c, int pos)
9079 ripley 1589 
{
40748 ripley 1590 
    DEstruct DE = getdata(c);
9079 ripley 1591 
    if (pos < 0) { /* horizontal */
40758 ripley 1592 
	DE->colmin = min(DE->xmaxused, -pos*DE->xScrollbarScale);
9079 ripley 1593 
    } else {
40748 ripley 1594 
	DE->rowmin = 1 + pos*DE->yScrollbarScale;
45070 ripley 1595 
	if(DE->rowmin > DE->ymaxused - DE->nhigh + 2)
40748 ripley 1596 
	    DE->rowmin = max(1,DE->ymaxused - DE->nhigh + 2);
48732 murdoch 1597 
/*	printf("pos %d, rowmin %d, scale %d\n", pos, DE->rowmin, DE->yScrollbarScale); */
9079 ripley 1598 
    }
40748 ripley 1599 
    drawwindow(DE);
9079 ripley 1600 
}
9205 ripley 1601 
 
1602 
static checkbox varwidths;
1603 
 
1604 
static void vw_close(control c)
1605 
{
1606 
    int x;
40748 ripley 1607 
    DEstruct DE = getdata(c);
9205 ripley 1608 
    if (ischecked(varwidths)) x = 0;
39274 ripley 1609 
    else x = atoi(GA_gettext(varname)); /* 0 if error */
9837 ripley 1610 
    x = min(x, 50);
40748 ripley 1611 
    if (x != DE->nboxchars) {
1612 
	DE->nboxchars = x;
1613 
	DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
1614 
	deredraw(DE);
9205 ripley 1615 
    }
1616 
    hide(devw);
1617 
    del(devw);
40748 ripley 1618 
    if (DE->nboxchars > 0) check(DE->de_mvw);
1619 
    else uncheck(DE->de_mvw);
1620 
    addto(DE->de);
9205 ripley 1621 
}
1622 
 
1623 
static void vw_hit_key(window w, int key)
1624 
{
1625 
    if(key == '\n') vw_close(w);
1626 
}
1627 
 
1628 
static void vw_callback(control c)
1629 
{
1630 
    if (ischecked(varwidths)) disable(varname);
1631 
    else enable(varname);
1632 
}
1633 
 
1634 
 
40748 ripley 1635 
static void de_popup_vw(DEstruct DE)
9205 ripley 1636 
{
1637 
    char blah[25];
1638 
 
33001 ripley 1639 
    devw = newwindow(G_("Cell width(s)"),
45070 ripley 1640 
		     rect(0, 0, 250, 60),
1641 
		     Titlebar | Centered | Closebox | Modal);
40748 ripley 1642 
    setdata(devw, DE);
9205 ripley 1643 
    setclose(devw, vw_close);
9212 ripley 1644 
    setbackground(devw, bbg);
33001 ripley 1645 
    lwhat = newlabel(G_("Cell width"), rect(10, 20, 70, 20), AlignLeft);
40748 ripley 1646 
    sprintf(blah, "%d", DE->nboxchars);
9205 ripley 1647 
    varname = newfield(blah, rect(80, 20, 40, 20));
33001 ripley 1648 
    varwidths = newcheckbox(G_("variable"), rect(150, 20, 80, 20), vw_callback);
40748 ripley 1649 
    if (DE->nboxchars == 0) {
9205 ripley 1650 
	check(varwidths);
1651 
	disable(varname);
1652 
    }
1653 
    setkeydown(devw, vw_hit_key);
1654 
    show(devw);
1655 
}
1656 
 
9212 ripley 1657 
static void menudecellwidth(control m)
9205 ripley 1658 
{
40748 ripley 1659 
    de_popup_vw(getdata(m));
9205 ripley 1660 
}
9212 ripley 1661 
 
1662 
static void deldataeditor(control m)
1663 
{
40748 ripley 1664 
    DEstruct DE = getdata(m);
1665 
    freeConsoleData(DE->p);
9212 ripley 1666 
}
1667 
 
1668 
static void declose(control m)
1669 
{
40748 ripley 1670 
    DEstruct DE = getdata(m);
1671 
 
1672 
    de_closewin(DE);
9212 ripley 1673 
    show(RConsole);
24276 ripley 1674 
    R_de_up = FALSE;
9212 ripley 1675 
}
1676 
 
1677 
static void deresize(console c, rect r)
32606 ripley 1678 
{
40748 ripley 1679 
    DEstruct DE = getdata(c);
1680 
    if (((DE->p->w  == r.width) &&
1681 
	 (DE->p->h == r.height)) ||
9212 ripley 1682 
	(r.width == 0) || (r.height == 0) ) /* minimize */
45070 ripley 1683 
	return;;
40748 ripley 1684 
    DE->p->w = r.width;
1685 
    DE->p->h = r.height;
32606 ripley 1686 
}
9212 ripley 1687 
 
32606 ripley 1688 
 
9212 ripley 1689 
static void menudehelp(control m)
1690 
{
33001 ripley 1691 
    char s[] = GN_("Navigation.\n  Keyboard: cursor keys move selection\n\tTab move right, Shift+Tab moves left\n\tPgDn or Ctrl+F: move down one screenful\n\tPgUp or Ctrl+B: move up one screenful\n\tHome: move to (1,1) cell\n\tEnd: show last rows of last column.\n   Mouse: left-click in a cell, use the scrollbar(s).\n\nEditing.\n  Type in the currently hightlighted cell\n  Double-click in a cell for an editable field\n\nMisc.\n  Ctrl-L redraws the screen, auto-resizing the columns\n  Ctrl-C copies selected cell\n  Ctrl-V pastes to selected cell\n  Right-click menu for copy, paste, autosize currently selected column\n\n");
1692 
    askok(G_(s));
9212 ripley 1693 
}
1694 
 
1695 
 
1696 
static MenuItem DePopup[28] = {
33001 ripley 1697 
    {GN_("Help"), menudehelp, 0},
9212 ripley 1698 
    {"-", 0, 0},
33001 ripley 1699 
    {GN_("Copy selected cell"), de_copy, 0},
1700 
    {GN_("Paste to selected cell"), de_paste, 0},
1701 
    {GN_("Autosize column"), de_autosize, 0},
9212 ripley 1702 
    {"-", 0, 0},
33001 ripley 1703 
    {GN_("Stay on top"), de_stayontop, 0},
27662 murdoch 1704 
    {"-", 0, 0},
33001 ripley 1705 
    {GN_("Close"), declose, 0},
9212 ripley 1706 
    LASTMENUITEM
1707 
};
1708 
 
1709 
static void demenuact(control m)
1710 
{
1711 
    /* use this to customize the menu */
1712 
}
1713 
 
1714 
static void depopupact(control m)
1715 
{
40748 ripley 1716 
    DEstruct DE = getdata(m);
9212 ripley 1717 
    /* use this to customize the menu */
45070 ripley 1718 
 
27662 murdoch 1719 
    if (ismdi())
45070 ripley 1720 
	disable(DePopup[6].m);
27686 murdoch 1721 
    else {
45070 ripley 1722 
	if (isTopmost(DE->de))
1723 
	    check(DePopup[6].m);
1724 
	else
1725 
	    uncheck(DePopup[6].m);
27686 murdoch 1726 
    }
9212 ripley 1727 
}
1728 
 
1729 
 
1730 
#define MCHECK(a) if (!(a)) {del(c);return NULL;}
1731 
 
44201 ripley 1732 
RECT *RgetMDIsize(void); /* in rui.c */
24283 ripley 1733 
 
41783 ripley 1734 
static dataeditor newdataeditor(DEstruct DE, const char *title)
9212 ripley 1735 
{
1736 
    int w, h, x, y;
1737 
    dataeditor c;
1738 
    menuitem m;
27357 murdoch 1739 
 
40748 ripley 1740 
    DE->p = newconsoledata((consolefn) ? consolefn : FixedFont,
45070 ripley 1741 
			   pagerrow, pagercol, 0, 0,
46784 murdoch 1742 
			   guiColors,
51948 murdoch 1743 
			   DATAEDITOR, 0, 0);
40748 ripley 1744 
    if (!DE->p) return NULL;
9212 ripley 1745 
 
40748 ripley 1746 
    w = DE->p->w ;
1747 
    h = DE->p->h;
9212 ripley 1748 
    if (ismdi()) {
1749 
	RECT *pR = RgetMDIsize();
1750 
	x = (pR->right - w) / 3; x = x > 20 ? x:20;
1751 
	y = (pR->bottom - h) / 3; y = y > 20 ? y:20;
1752 
    } else {
1753 
	x = (devicewidth(NULL) - w) / 3;
1754 
	y = (deviceheight(NULL) - h) / 3 ;
1755 
    }
41793 ripley 1756 
    c = (dataeditor) newwindow(title, rect(x, y, w, h),
24265 ripley 1757 
			       Document | StandardWindow | Menubar |
1758 
			       VScrollbar | HScrollbar | TrackMouse);
9212 ripley 1759 
    if (!c) {
45070 ripley 1760 
	freeConsoleData(DE->p);
1761 
	return NULL;
9212 ripley 1762 
    }
40748 ripley 1763 
    setdata(c, DE);
1764 
    if(h == 0) DE->p->h = getheight(c);
1765 
    if(w == 0) DE->p->w  = getwidth(c);
1766 
    (DE->p->cols) = DE->p->w / (DE->p->fw) - 1;
1767 
    (DE->p->rows) = DE->p->h / (DE->p->fh) - 1;
1768 
    DE->p->right = (DE->p->w - (DE->p->cols)*(DE->p->fw)) / 2;
1769 
    DE->p->top = (DE->p->h - (DE->p->rows)*(DE->p->fh)) / 2;
9212 ripley 1770 
    gsetcursor(c, ArrowCursor);
46784 murdoch 1771 
    setbackground(c, guiColors[dataeditbg]);
9212 ripley 1772 
    if (ismdi() && (RguiMDI & RW_TOOLBAR)) {
1773 
	/* blank toolbar to stop windows jumping around */
45070 ripley 1774 
	int btsize = 24;
1775 
	control tb;
1776 
	addto(c);
1777 
	MCHECK(tb = newtoolbar(btsize + 4));
9212 ripley 1778 
	gsetcursor(tb, ArrowCursor);
1779 
    }
40750 ripley 1780 
    if(DE->isEditor) {
1781 
	MCHECK(m = gpopup(depopupact, DePopup));
1782 
	setdata(m, DE);
1783 
	setdata(DePopup[2].m, DE);
1784 
	setdata(DePopup[3].m, DE);
1785 
	setdata(DePopup[4].m, DE);
1786 
	setdata(DePopup[6].m, DE);
1787 
	setdata(DePopup[8].m, DE);
1788 
    }
9212 ripley 1789 
    MCHECK(m = newmenubar(demenuact));
33001 ripley 1790 
    MCHECK(newmenu(G_("File")));
9212 ripley 1791 
/*    MCHECK(m = newmenuitem("-", 0, NULL));*/
33001 ripley 1792 
    MCHECK(m = newmenuitem(G_("Close"), 0, declose));
40748 ripley 1793 
    setdata(m, DE);
40750 ripley 1794 
    if(DE->isEditor) {
1795 
	newmdimenu();
1796 
	MCHECK(newmenu(G_("Edit")));
1797 
	MCHECK(m = newmenuitem(G_("Copy  \tCTRL+C"), 0, de_copy));
1798 
	setdata(m, DE);
1799 
	MCHECK(m = newmenuitem(G_("Paste \tCTRL+V"), 0, de_paste));
1800 
	setdata(m, DE);
1801 
	MCHECK(m = newmenuitem(G_("Delete\tDEL"), 0, de_delete));
1802 
	setdata(m, DE);
1803 
	MCHECK(m = newmenuitem("-", 0, NULL));
45070 ripley 1804 
	MCHECK(m = DE->de_mvw = newmenuitem(G_("Cell widths ..."), 0,
40750 ripley 1805 
					    menudecellwidth));
1806 
	setdata(m, DE);
1807 
	MCHECK(m = newmenu(G_("Help")));
1808 
	MCHECK(newmenuitem(G_("Data editor"), 0, menudehelp));
1809 
    }
45070 ripley 1810 
 
40748 ripley 1811 
    setdata(c, DE); /* Why the repeat? */
9212 ripley 1812 
    setresize(c, deresize);
1813 
    setredraw(c, de_redraw);
1814 
    setdel(c, deldataeditor);
1815 
    setclose(c, declose);
1816 
    sethit(c, de_sbf);
1817 
    setkeyaction(c, de_ctrlkeyin);
40750 ripley 1818 
    if(DE->isEditor) {
1819 
	setkeydown(c, de_normalkeyin);
45067 ripley 1820 
	setim(c, de_im);
40750 ripley 1821 
	setmousedown(c, de_mousedown);
1822 
	setmouseup(c, de_mouseup);
1823 
    }
9212 ripley 1824 
    return(c);
1825 
}
40750 ripley 1826 
 
40757 ripley 1827 
static void dv_closewin_cend(void *data)
40750 ripley 1828 
{
40757 ripley 1829 
    DEstruct DE = (DEstruct) data;
1830 
    R_ReleaseObject(DE->lens);
1831 
    R_ReleaseObject(DE->work);
1832 
    de_closewin(DE);
40750 ripley 1833 
    free(DE);
1834 
}
1835 
 
1836 
SEXP do_dataviewer(SEXP call, SEXP op, SEXP args, SEXP rho)
1837 
{
40757 ripley 1838 
    SEXP stitle;
40750 ripley 1839 
    SEXPTYPE type;
1840 
    int i, nprotect;
1841 
    RCNTXT cntxt;
1842 
    DEstruct DE = (DEstruct) malloc(sizeof(destruct));
1843 
 
1844 
    checkArity(op, args);
1845 
    DE->isEditor = FALSE;
1846 
    nprotect = 0;/* count the PROTECT()s */
40757 ripley 1847 
    DE->work = CAR(args);
1848 
    DE->names = getAttrib(DE->work, R_NamesSymbol);
40750 ripley 1849 
 
1850 
    if (TYPEOF(DE->work) != VECSXP)
1851 
	errorcall(call, G_("invalid argument"));
1852 
    stitle = CADR(args);
1853 
    if (!isString(stitle) || LENGTH(stitle) != 1)
1854 
	errorcall(call, G_("invalid argument"));
1855 
 
1856 
    /* initialize the constants */
1857 
 
1858 
    DE->bufp = DE->buf;
1859 
    DE->ne = 0;
1860 
    DE->currentexp = 0;
1861 
    DE->nneg = 0;
1862 
    DE->ndecimal = 0;
1863 
    DE->clength = 0;
1864 
    DE->inSpecial = 0;
1865 
    DE->ccol = 1;
1866 
    DE->crow = 1;
1867 
    DE->colmin = 1;
1868 
    DE->rowmin = 1;
45070 ripley 1869 
    PROTECT(DE->ssNA_STRING = duplicate(NA_STRING));
40750 ripley 1870 
    nprotect++;
1871 
    DE->bwidth = 0;
1872 
    DE->hwidth = 5;
1873 
 
40757 ripley 1874 
    /* setup lens  */
40750 ripley 1875 
    DE->xmaxused = length(DE->work); DE->ymaxused = 0;
1876 
    PROTECT_WITH_INDEX(DE->lens = allocVector(INTSXP, DE->xmaxused), &DE->lpi);
1877 
    nprotect++;
1878 
 
1879 
    for (i = 0; i < DE->xmaxused; i++) {
1880 
	int len = LENGTH(VECTOR_ELT(DE->work, i));
1881 
	INTEGER(DE->lens)[i] = len;
1882 
	DE->ymaxused = max(len, DE->ymaxused);
1883 
	type = TYPEOF(VECTOR_ELT(DE->work, i));
40757 ripley 1884 
	if (type != STRSXP && type != REALSXP)
1885 
	    errorcall(call, G_("invalid argument"));
40750 ripley 1886 
    }
1887 
 
45528 ripley 1888 
    DE->xScrollbarScale = DE->yScrollbarScale = 1;
40750 ripley 1889 
 
1890 
    /* start up the window, more initializing in here */
1891 
    if (initwin(DE, CHAR(STRING_ELT(stitle, 0))))
1892 
	errorcall(call, G_("invalid device"));
1893 
 
1894 
    /* set up a context which will close the window if there is an error */
1895 
    begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_BaseEnv, R_BaseEnv,
1896 
		 R_NilValue, R_NilValue);
1897 
    cntxt.cend = &dv_closewin_cend;
1898 
    cntxt.cenddata = (void *)DE;
1899 
 
40757 ripley 1900 
    R_PreserveObject(DE->work); /* also preserves names */
1901 
    R_PreserveObject(DE->lens);
40750 ripley 1902 
    UNPROTECT(nprotect);
1903 
    return R_NilValue;
1904 
}