The R Project SVN – R – Diff – /trunk/src/gnuwin32/dataentry.c


/*
 *  R : A Computer Langage for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 1998--2003  Robert Gentleman, Ross Ihaka and the
 *                            R Development Core Team
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
/* TODO
   - spreadsheet copy and paste?
 */
 
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
 
#include "Defn.h"
#include "Print.h"
 
#include "graphapp/ga.h"
#include "console.h"
#include "consolestructs.h"
#include "rui.h"
 
static dataeditor de;
static ConsoleData p;
 
typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;
 
static Rboolean R_de_up;
 
#ifndef max
#define max(a, b) (((a)>(b))?(a):(b))
#endif
#ifndef min
#define min(a, b) (((a)<(b))?(a):(b))
#endif
#define BOXW(x) (min(((x<100 && nboxchars==0)?boxw[x]:box_w),WIDTH-boxw[0]-2*bwidth-2))
 
#define FIELDWIDTH 10
 
/* Local Function Definitions */
 
static void advancerect(int);
static void bell();
static void cleararea(int, int, int, int, rgb);
static void clearrect(void);
static void closerect(void);
static void clearwindow(void);
static void de_closewin(void);
static void copyarea(int, int, int, int);
static void copyH(int, int, int);
static void deredraw(void);
static void eventloop(void);
static void downlightrect(void);
static void drawwindow(void);
static void drawcol(int);
/* static void de_drawline(int, int, int, int);*/
static void de_drawtext(int, int, char *);
static void drawrectangle(int, int, int, int, int, int);
static void drawrow(int);
static void find_coords(int, int, int*, int*);
static void handlechar(char*);
static void highlightrect(void);
static Rboolean initwin(void);
static void jumppage(int);
static void jumpwin(int, int);
static void de_popupmenu(int, int, int);
static void printlabs(void);
static void printrect(int, int);
static void printstring(char*, int, int, int, int);
static void printelt(SEXP, int, int, int);
static void setcellwidths(void);
 
static dataeditor newdataeditor();
static void de_copy(control c);
static void de_paste(control c);
static void de_delete(control c);
static menuitem de_mvw;
 
static SEXP work, names, lens;
static PROTECT_INDEX wpi, npi, lpi;
static SEXP ssNA_STRING;
static double ssNA_REAL;
 
/* Global variables needed for the graphics */
 
static int box_w;                       /* width of a box */
static int boxw[100];                   /* widths of cells */
static int box_h;                       /* height of a box */
static int windowWidth;                 /* current width of the window */
static int windowHeight;                /* current height of the window */
static int currentexp;                  /* boolean: whether an cell is active */
static int crow;                        /* current row */
static int ccol;                        /* current column */
static int nwide, nhigh;
static int colmax, colmin, rowmax, rowmin;
static int ndecimal;                    /* count decimal points */
static int ne;                          /* count exponents */
static int nneg;			/* indicate whether its a negative */
static int clength;                     /* number of characters currently entered */
static char buf[30];
static char *bufp;
static int bwidth;			/* width of the border */
static int hwidth;			/* width of header  */
static int text_xoffset, text_yoffset;
static field celledit;
static Rboolean newcol, CellModified, CellEditable;
static int xmaxused, ymaxused;
static int oldWIDTH=0, oldHEIGHT=0;
static int nboxchars=0;
static int labdigs=4;
static char labform[6];
static int xScrollbarScale=1, yScrollbarScale=1;
 
#include <windows.h> /* for Sleep */
 
 /*
  Underlying assumptions (for this version R >= 1.8.0)
 
  The data are stored in a list `work', with unused columns having
  NULL entries.  The names for the list are in `names', which should
  have a name for all displayable columns (up to xmaxused).
  The *used* lengths of the columns are in `lens': this needs only be
  set for non-NULL columns.
 
  If the list was originally length(0), that should work with
  0 pre-defined cols.  (It used to have 1 pre-defined numeric column.)
 
  All row and col numbers are 1-based.
 
  BDR May 2003
 */
 
/*
   ssNewVector is just an interface to allocVector but it lets us
   set the fields to NA. We need to have a special NA for reals and
   strings so that we can differentiate between uninitialized elements
   in the vectors and user supplied NA's; hence ssNA_REAL and ssNA_STRING
 */
 
static SEXP ssNewVector(SEXPTYPE type, int vlen)
{
    SEXP tvec;
    int j;
 
    tvec = allocVector(type, vlen);
    for (j = 0; j < vlen; j++)
	if (type == REALSXP)
	    REAL(tvec)[j] = ssNA_REAL;
	else if (type == STRSXP)
	    SET_STRING_ELT(tvec, j, STRING_ELT(ssNA_STRING, 0));
    SETLEVELS(tvec, 0);
    return (tvec);
}
static void eventloop()
{
    while (R_de_up) {
	/* avoid consuming 100% CPU time here */
	Sleep(10);
	R_ProcessEvents();
    }
}
 
static void de_closewin_cend(void *data)
{
    de_closewin();
}
 
SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP colmodes, tnames, tvec, tvec2, work2;
    SEXPTYPE type;
    int i, j, cnt, len, nprotect;
    RCNTXT cntxt;
    char clab[25];
 
    nprotect = 0;/* count the PROTECT()s */
    PROTECT_WITH_INDEX(work = duplicate(CAR(args)), &wpi); nprotect++;
    colmodes = CADR(args);
    tnames = getAttrib(work, R_NamesSymbol);
 
    if (TYPEOF(work) != VECSXP || TYPEOF(colmodes) != VECSXP)
	errorcall(call, "invalid argument");
 
    /* initialize the constants */
 
    bufp = buf;
    ne = 0;
    currentexp = 0;
    nneg = 0;
    ndecimal = 0;
    clength = 0;
    ccol = 1;
    crow = 1;
    colmin = 1;
    rowmin = 1;
    ssNA_REAL = -NA_REAL;
    tvec = allocVector(REALSXP, 1);
    REAL(tvec)[0] = ssNA_REAL;
    PROTECT(ssNA_STRING = coerceVector(tvec, STRSXP)); nprotect++;
    bwidth = 0;
    hwidth = 5;
 
    /* setup work, names, lens  */
    xmaxused = length(work); ymaxused = 0;
    PROTECT_WITH_INDEX(lens = allocVector(INTSXP, xmaxused), &lpi);
    nprotect++;
 
    if (isNull(tnames)) {
	PROTECT_WITH_INDEX(names = allocVector(STRSXP, xmaxused), &npi);
	for(i = 0; i < xmaxused; i++) {
	    sprintf(clab, "var%d", i);
	    SET_STRING_ELT(names, i, mkChar(clab));
	}
    } else
	PROTECT_WITH_INDEX(names = duplicate(tnames), &npi);
    nprotect++;
    for (i = 0; i < xmaxused; i++) {
	int len = LENGTH(VECTOR_ELT(work, i));
	INTEGER(lens)[i] = len;
	ymaxused = max(len, ymaxused);
	type = TYPEOF(VECTOR_ELT(work, i));
	if (LENGTH(colmodes) > 0 && !isNull(VECTOR_ELT(colmodes, i)))
	    type = str2type(CHAR(STRING_ELT(VECTOR_ELT(colmodes, i), 0)));
	if (type != STRSXP) type = REALSXP;
	if (isNull(VECTOR_ELT(work, i))) {
	    if (type == NILSXP) type = REALSXP;
	    SET_VECTOR_ELT(work, i, ssNewVector(type, 100));
	} else if (!isVector(VECTOR_ELT(work, i)))
	    errorcall(call, "invalid type for value");
	else {
	    if (TYPEOF(VECTOR_ELT(work, i)) != type)
		SET_VECTOR_ELT(work, i,
			       coerceVector(VECTOR_ELT(work, i), type));
	}
    }
 
    /* scale scrollbars as needed */
    if (xmaxused > 10000) xScrollbarScale = xmaxused/1000;
    if (ymaxused > 10000) yScrollbarScale = ymaxused/1000;
 
    /* 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, CTXT_CCODE, R_NilValue, R_NilValue, R_NilValue,
		 R_NilValue, R_NilValue);
    cntxt.cend = &de_closewin_cend;
    cntxt.cenddata = NULL;
 
    highlightrect();
 
    eventloop();
 
    endcontext(&cntxt);
 
    /* drop out unused columns */
    for(i = 0, cnt = 0; i < xmaxused; i++)
	if(!isNull(VECTOR_ELT(work, i))) cnt++;
    if (cnt < xmaxused) {
	PROTECT(work2 = allocVector(VECSXP, cnt)); nprotect++;
	for(i = 0, j = 0; i < xmaxused; i++) {
	    if(!isNull(VECTOR_ELT(work, i))) {
		SET_VECTOR_ELT(work2, j, VECTOR_ELT(work, i));
		INTEGER(lens)[j] = INTEGER(lens)[i];
		SET_STRING_ELT(names, j, STRING_ELT(names, i));
		j++;
	    }
	}
	REPROTECT(names = lengthgets(names, cnt), npi);
    } else work2 = work;
 
    for (i = 0; i < LENGTH(work2); i++) {
	len = INTEGER(lens)[i];
	tvec = VECTOR_ELT(work2, i);
	if (LENGTH(tvec) != len) {
	    tvec2 = ssNewVector(TYPEOF(tvec), len);
	    for (j = 0; j < len; j++) {
		if (TYPEOF(tvec) == REALSXP) {
		    if (REAL(tvec)[j] != ssNA_REAL)
			REAL(tvec2)[j] = REAL(tvec)[j];
		    else
			REAL(tvec2)[j] = NA_REAL;
		} else if (TYPEOF(tvec) == STRSXP) {
		    if (!streql(CHAR(STRING_ELT(tvec, j)),
				CHAR(STRING_ELT(ssNA_STRING, 0))))
			SET_STRING_ELT(tvec2, j, STRING_ELT(tvec, j));
		    else
			SET_STRING_ELT(tvec2, j, NA_STRING);
		} else
		    error("dataentry: internal memory problem");
	    }
	    SET_VECTOR_ELT(work2, i, tvec2);
	}
    }
 
    setAttrib(work2, R_NamesSymbol, names);
    UNPROTECT(nprotect);
    return work2;
}
 
/* Window Drawing Routines */
 
static rgb bbg;
 
static void setcellwidths(void)
{
    int i, w, dw;
 
    windowWidth = w = 2*bwidth + boxw[0] + BOXW(colmin);
    nwide = 2;
    for (i = 2; i < 100; i++) { /* 100 on-screen columns cannot occur */
	dw = BOXW(i + colmin - 1);
	if((w += dw) > WIDTH) {
	    nwide = i;
	    windowWidth = w - dw;
	    break;
	}
    }
}
 
 
static void drawwindow(void)
{
    /* might have resized */
    setcellwidths();
    nhigh = (HEIGHT - 2 * bwidth - hwidth - 3) / box_h;
    windowHeight = nhigh * box_h + 2 * bwidth + hwidth;
    oldWIDTH = WIDTH;
    oldHEIGHT = HEIGHT;
 
    clearwindow();
    deredraw();
    /* row/col 1 = pos 0 */
    gchangescrollbar(de, VWINSB, (rowmin - 1)/yScrollbarScale,
		     ymaxused/yScrollbarScale,
		     max(nhigh/yScrollbarScale, 1), 0);
    gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,
		     xmaxused/xScrollbarScale,
		     max(nwide/xScrollbarScale, 1), 0);
}
 
static void doHscroll(int oldcol)
{
    int i, dw;
    int oldnwide = nwide, oldwindowWidth = windowWidth;
 
    /* horizontal re-position */
    setcellwidths();
    colmax = colmin + (nwide - 2);
    if (oldcol < colmin) { /* drop oldcol...colmin - 1 */
	dw = boxw[0];
	for (i = oldcol; i < colmin; i++) dw += BOXW(i);
	copyH(dw, boxw[0], oldwindowWidth - dw + 1);
	dw = oldwindowWidth - BOXW(oldcol) + 1;
	cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);
	/* oldnwide includes the row labels */
	for (i = oldcol+oldnwide-1; i <= colmax; i++) drawcol(i);
    } else {
	/* move one or more cols left */
	dw = BOXW(colmin);
	copyH(boxw[0], boxw[0] + dw, windowWidth - dw + 1);
	dw = windowWidth + 1;
	cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);
	drawcol(colmin);
    }
    gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,
		     xmaxused/xScrollbarScale,
		     max(nwide/xScrollbarScale, 1), 0);
    highlightrect();
}
 
/* find_coords finds the coordinates of the upper left corner of the
   given cell on the screen: row and col are on-screen coords */
 
static void find_coords(int row, int col, int *xcoord, int *ycoord)
{
    int i, w;
    w = bwidth;
    if (col > 0) w += boxw[0];
    for(i = 1; i < col; i ++) w += BOXW(i + colmin - 1);
    *xcoord = w;
    *ycoord = bwidth + hwidth + box_h * row;
}
 
/* draw the window with the top left box at column wcol and row wrow */
 
static void jumpwin(int wcol, int wrow)
{
    if (wcol < 0 || wrow < 0) {
	bell();
	return;
    }
    closerect();
    if (colmin != wcol || rowmin != wrow) {
	colmin = wcol;
	rowmin = wrow;
	deredraw();
    } else highlightrect();
}
 
static void advancerect(int which)
{
 
    /* if we are in the header, changing a name then only down is
       allowed */
    if (crow < 1 && which != DOWN) {
	bell();
	return;
    }
 
    closerect();
 
    switch (which) {
    case UP:
	if (crow == 1) {
	    if (rowmin == 1)
		bell();
	    else
		jumppage(UP);
	} else
	    crow--;
	break;
    case DOWN:
	if (crow == (nhigh - 1))
	    jumppage(DOWN);
	else
	    crow++;
	break;
    case RIGHT:
	if (ccol == (nwide - 1))
	    jumppage(RIGHT);
	else
	    ccol++;
	break;
    case LEFT:
	if (ccol == 1) {
	    if (colmin == 1)
		bell();
	    else
		jumppage(LEFT);
	} else
	    ccol--;
	break;
    default:
	UNIMPLEMENTED("advancerect");
    }
 
    highlightrect();
}
 
static char *get_col_name(int col)
{
    static char clab[25];
    if (col <= xmaxused) {
	/* don't use NA labels */
	SEXP tmp = STRING_ELT(names, col - 1);
	if(tmp != NA_STRING) return(CHAR(tmp));
    }
    sprintf(clab, "var%d", col);
    return clab;
}
 
static int get_col_width(int col)
{
    int i, w = 0, w1, fw = FIELDWIDTH;
    char *strp;
    SEXP tmp, lab;
 
    if (nboxchars > 0) return nboxchars;
    if (col <= xmaxused) {
	tmp = VECTOR_ELT(work, col - 1);
	if (isNull(tmp)) return fw;
	/* don't use NA labels */
	lab = STRING_ELT(names, col - 1);
	if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
	PrintDefaults(R_NilValue);
	for (i = 0; i < INTEGER(lens)[col - 1]; i++) {
	    strp = EncodeElement(tmp, i, 0);
	    w1 = strlen(strp);
	    if (w1 > w) w = w1;
	}
	if(w < 5) w = 5;
	if(w < 8) w++;
	if(w > 50) w = 50;
	return w;
    }
    return fw;
}
 
static CellType get_col_type(int col)
{
    SEXP tmp;
    CellType res = UNKNOWNN;
 
    if (col <= xmaxused) {
	tmp = VECTOR_ELT(work, col - 1);
	if(TYPEOF(tmp) == REALSXP) res = NUMERIC;
	if(TYPEOF(tmp) == STRSXP) res = CHARACTER;
    }
    return res;
}
 
 
/* whichcol is absolute col no, col is position on screen */
static void drawcol(int whichcol)
{
    int i, src_x, src_y, len, col = whichcol - colmin + 1, bw = BOXW(whichcol);
    char *clab;
    SEXP tmp;
 
    find_coords(0, col, &src_x, &src_y);
    cleararea(src_x, src_y, bw, windowHeight, p->bg);
    cleararea(src_x, src_y, bw, box_h, bbg);
    for (i = 0; i < nhigh; i++)
	drawrectangle(src_x, hwidth + i * box_h, bw, box_h, 1, 1);
 
    /* now fill it in if it is active */
    clab = get_col_name(whichcol);
    printstring(clab, strlen(clab), 0, col, 0);
 
   if (xmaxused >= whichcol) {
	tmp = VECTOR_ELT(work, whichcol - 1);
	if (!isNull(tmp)) {
	    len = min(rowmax, INTEGER(lens)[whichcol - 1]);
	    for (i = (rowmin - 1); i < len; i++)
		printelt(tmp, i, i - rowmin + 2, col);
	}
    }
}
 
 
/* whichrow is absolute row no */
static void drawrow(int whichrow)
{
    int i, src_x, src_y, row = whichrow - rowmin + 1, w;
    char rlab[15];
    SEXP tvec;
 
    find_coords(row, 0, &src_x, &src_y);
    cleararea(src_x, src_y, windowWidth, box_h, (whichrow > 0)?p->bg:bbg);
    drawrectangle(src_x, src_y, boxw[0], box_h, 1, 1);
 
    sprintf(rlab, labform, whichrow);
    printstring(rlab, strlen(rlab), row, 0, 0);
 
    w = bwidth + boxw[0];
    for (i = colmin; i <= colmax; i++) {
	drawrectangle(w, src_y, BOXW(i), box_h, 1, 1);
	w += BOXW(i);
    }
 
    for (i = colmin; i <= colmax; i++) {
	if (i > xmaxused) break;
	if (!isNull(tvec = VECTOR_ELT(work, i - 1)))
	    if (whichrow <= INTEGER(lens)[i - 1])
		printelt(tvec, whichrow - 1, row, i - colmin + 1);
    }
}
 
/* printelt: print the correct value from vector[vrow] into the
   spreadsheet in row ssrow and col sscol */
 
/* WARNING: This has no check that you're not beyond the end of the
   vector. Caller must check. */
 
static void printelt(SEXP invec, int vrow, int ssrow, int sscol)
{
    char *strp;
    PrintDefaults(R_NilValue);
    if (TYPEOF(invec) == REALSXP) {
	if (REAL(invec)[vrow] != ssNA_REAL) {
	    strp = EncodeElement(invec, vrow, 0);
	    printstring(strp, strlen(strp), ssrow, sscol, 0);
	}
    }
    else if (TYPEOF(invec) == STRSXP) {
	if (!streql(CHAR(STRING_ELT(invec, vrow)),
		    CHAR(STRING_ELT(ssNA_STRING, 0)))) {
	    strp = EncodeElement(invec, vrow, 0);
	    printstring(strp, strlen(strp), ssrow, sscol, 0);
	}
    }
    else
	error("dataentry: internal memory error");
}
 
 
static void drawelt(int whichrow, int whichcol)
{
    int i;
    char *clab;
    SEXP tmp;
 
    if (whichrow == 0) {
	clab = get_col_name(whichcol + colmin - 1);
	printstring(clab, strlen(clab), 0, whichcol, 0);
    } else {
	if (xmaxused >= whichcol + colmin - 1) {
	    tmp = VECTOR_ELT(work, whichcol + colmin - 2);
	    if (!isNull(tmp) && (i = rowmin + whichrow - 2) <
		INTEGER(lens)[whichcol + colmin - 2] )
		printelt(tmp, i, whichrow, whichcol);
	} else
	    printstring("", 0, whichrow,  whichcol, 0);
    }
}
 
static void jumppage(int dir)
{
    int i, w, oldcol, wcol;
 
    switch (dir) {
    case UP:
	rowmin--;
	rowmax--;
	copyarea(0, hwidth + box_h, 0, hwidth + 2 * box_h);
	drawrow(rowmin);
	gchangescrollbar(de, VWINSB, (rowmin - 1)/yScrollbarScale,
			 ymaxused/yScrollbarScale,
			 max(nhigh/yScrollbarScale, 1), 0);
	break;
    case DOWN:
	if (rowmax >= 65535) return;
	rowmin++;
	rowmax++;
	copyarea(0, hwidth + 2 * box_h, 0, hwidth + box_h);
	drawrow(rowmax);
	gchangescrollbar(de, VWINSB, (rowmin - 1)/yScrollbarScale,
			 ymaxused/yScrollbarScale,
			 max(nhigh/yScrollbarScale, 1), 0);
	break;
    case LEFT:
	colmin--;
	doHscroll(colmin+1);
	break;
    case RIGHT:
	oldcol = colmin;
	wcol = colmin + ccol + 1; /* column to be selected */
        /* There may not be room to fit the next column in */
	w = WIDTH - boxw[0] - BOXW(colmax + 1);
	for (i = colmax; i >= oldcol; i--) {
	    w -= BOXW(i);
	    if(w < 0) {
		colmin = i + 1;
		break;
	    }
	}
	ccol = wcol - colmin;
	doHscroll(oldcol);
	break;
    }
}
/* draw a rectangle, used to highlight/downlight the current box */
 
static void printrect(int lwd, int fore)
{
    int x, y;
    find_coords(crow, ccol, &x, &y);
    drawrectangle(x + lwd - 1, y + lwd - 1,
		  BOXW(ccol+colmin-1) - lwd + 1,
		  box_h - lwd + 1, lwd, fore);
}
 
static void downlightrect(void)
{
    printrect(2, 0);
    printrect(1, 1);
}
 
static void highlightrect(void)
{
    printrect(2, 1);
}
 
 
static void getccol()
{
    SEXP tmp, tmp2;
    int i, len, newlen, wcol, wrow;
    SEXPTYPE type;
    char clab[25];
 
    wcol = ccol + colmin - 1;
    wrow = crow + rowmin - 1;
    if (wcol > xmaxused) {
	/* extend work, names and lens */
	REPROTECT(work = lengthgets(work, wcol), wpi);
	REPROTECT(names = lengthgets(names, wcol), npi);
	for (i = xmaxused; i < wcol; i++) {
	    sprintf(clab, "var%d", i + 1);
	    SET_STRING_ELT(names, i, mkChar(clab));
	}
	REPROTECT(lens = lengthgets(lens, wcol), lpi);
	xmaxused = wcol;
    }
    newcol = FALSE;
    if (isNull(VECTOR_ELT(work, wcol - 1))) {
	newcol = TRUE;
	SET_VECTOR_ELT(work, wcol - 1, ssNewVector(REALSXP, max(100, wrow)));
	INTEGER(lens)[wcol - 1] = 0;
    }
    if (!isVector(tmp = VECTOR_ELT(work, wcol - 1)))
	error("internal type error in dataentry");
    len = INTEGER(lens)[wcol - 1];
    type = TYPEOF(tmp);
    if (len < wrow) {
	for (newlen = max(len * 2, 10) ; newlen < wrow ; newlen *= 2)
	    ;
	tmp2 = ssNewVector(type, newlen);
	for (i = 0; i < len; i++)
	    if (type == REALSXP)
		REAL(tmp2)[i] = REAL(tmp)[i];
	    else if (type == STRSXP)
		SET_STRING_ELT(tmp2, i, STRING_ELT(tmp, i));
	    else
		error("internal type error in dataentry");
	SET_VECTOR_ELT(work, wcol - 1, tmp2);
    }
}
 
/* close up the entry to a cell, put the value that has been entered
   into the correct place and as the correct type */
 
static void closerect(void)
{
    SEXP cvec;
    int wcol = ccol + colmin - 1, wrow = rowmin + crow - 1, wrow0;
 
    *bufp = '\0';
 
    if (CellModified || CellEditable) {
	if (CellEditable) {
	    strcpy(buf, gettext(celledit));
	    clength = strlen(buf);
	    hide(celledit);
	    del(celledit);
	}
	getccol();
	cvec = VECTOR_ELT(work, wcol - 1);
	wrow0 = INTEGER(lens)[wcol - 1];
	if (wrow > wrow0) INTEGER(lens)[wcol - 1] = wrow;
	ymaxused = max(ymaxused, wrow);
	if (clength != 0) {
	    /* do it this way to ensure NA, Inf, ...  can get set */
	    char *endp;
	    double new = R_strtod(buf, &endp);
	    int warn = !isBlankString(endp);
	    if (TYPEOF(cvec) == STRSXP)
		SET_STRING_ELT(cvec, wrow - 1, mkChar(buf));
	    else
		REAL(cvec)[wrow - 1] = new;
	    if (newcol & warn) {
		/* change mode to character */
		SET_VECTOR_ELT(work, wcol - 1, coerceVector(cvec, STRSXP));
		SET_STRING_ELT(VECTOR_ELT(work, wcol - 1), wrow - 1,
			       mkChar(buf));
	    }
	} else {
	    if (TYPEOF(cvec) == STRSXP)
		SET_STRING_ELT(cvec, wrow - 1, NA_STRING);
	    else
		REAL(cvec)[wrow - 1] = NA_REAL;
	}
	drawelt(crow, ccol);  /* to get the cell scrolling right */
	if(wrow > wrow0) drawcol(wcol); /* to fill in NAs */
    }
    CellEditable = CellModified = FALSE;
 
    downlightrect();
    gsetcursor(de, ArrowCursor);
 
    ndecimal = 0;
    nneg = 0;
    ne = 0;
    currentexp = 0;
    clength = 0;
    bufp = buf;
}
 
/* print a null terminated string, check to see if it is longer than
   the print area and print it, left adjusted if necessary; clear the
   area of previous text; */
 
/* This version will only display 200 chars, but the maximum col width
   will not allow that many */
static void printstring(char *ibuf, int buflen, int row, int col, int left)
{
    int x_pos, y_pos, bw, fw, bufw;
    char buf[201];
 
    find_coords(row, col, &x_pos, &y_pos);
    if (col == 0) bw = boxw[0]; else bw = BOXW(col+colmin-1);
    cleararea(x_pos + 1, y_pos + 1, bw - 1, box_h - 1,
	      (row==0 || col==0) ? bbg:p->bg);
    fw = min(200, (bw - 8)/FW);
    bufw = min(fw, buflen);
    strncpy(buf, ibuf, bufw);
    buf[bufw] = '\0';
    if (buflen > fw) {
	if(left) {
	    strncpy(buf, ibuf + buflen - fw, fw);
	    buf[fw + 1] = '\0';
	    *buf = '<';
	} else {
	    *(buf + fw - 1) = '>';
	    *(buf + fw) = '\0';
	}
    }
    de_drawtext(x_pos + text_xoffset, y_pos - text_yoffset, buf);
}
 
static void clearrect(void)
{
    int x_pos, y_pos;
 
    find_coords(crow, ccol, &x_pos, &y_pos);
    cleararea(x_pos, y_pos, BOXW(ccol+colmin-1), box_h, p->bg);
}
 
/* handlechar has to be able to parse decimal numbers and strings,
   depending on the current column type, only printing characters
   should get this far */
 
/* --- Not true! E.g. ESC ends up in here... */
 
static void handlechar(char *text)
{
    int c = text[0];
 
    if ( c == '\033' ) {
	CellModified = FALSE;
	clength = 0;
	drawelt(crow, ccol);
	gsetcursor(de, ArrowCursor);
	return;
    } else {
	CellModified = TRUE;
	gsetcursor(de, TextCursor);
    }
 
    if (clength == 0) {
	switch(get_col_type(ccol + colmin - 1)) {
	case NUMERIC:
	    currentexp = 1;
	    break;
	default:
	    currentexp = 2;
	}
	clearrect();
	highlightrect();
    }
 
    if (currentexp == 1)	/* we are parsing a number */
	switch (c) {
	case '-':
	    if (nneg == 0)
		nneg++;
	    else
		goto donehc;
	    break;
	case '.':
	    if (ndecimal == 0)
		ndecimal++;
	    else
		goto donehc;
	    break;
	case 'e':
	case 'E':
	    if (ne == 0) {
		nneg = ndecimal = 0;	/* might have decimal in exponent */
		ne++;
	    }
	    else
		goto donehc;
	    break;
	default:
	    if (!isdigit((int)text[0]))
		goto donehc;
	    break;
	}
 
    if (clength++ > 29) {
	warning("dataentry: expression too long");
	clength--;
	goto donehc;
    }
 
    *bufp++ = text[0];
    printstring(buf, clength, crow, ccol, 1);
    return;
 
 donehc:
    bell();
}
 
static void printlabs(void)
{
    char clab[15], *p;
    int i;
 
    for (i = colmin; i <= colmax; i++) {
	p = get_col_name(i);
	printstring(p, strlen(p), 0, i - colmin + 1, 0);
    }
    for (i = rowmin; i <= rowmax; i++) {
	sprintf(clab, labform, i);
	printstring(clab, strlen(clab), i - rowmin + 1, 0, 0);
    }
}
 
              /* ================ GraphApp-specific ================ */
 
static void bell(void)
{
    gabeep();
}
 
static void cleararea(int xpos, int ypos, int width, int height, rgb col)
{
    gfillrect(de, col, rect(xpos, ypos, width, height));
}
 
static void clearwindow(void)
{
    gfillrect(de, p->bg, rect(0, 0, WIDTH, HEIGHT));
}
 
#if 0
static void de_drawline(int fromx, int fromy, int tox, int toy)
{
    gdrawline(de, 1, 0, p->ufg, pt(fromx, fromy), pt(tox, toy));
}
#endif
 
static void drawrectangle(int xpos, int ypos, int width, int height,
			  int lwd, int fore)
{
    /* only used on screen, so always fast */
    gdrawrect(de, lwd, 0, (fore==1)? p->ufg: p->bg,
	      rect(xpos, ypos, width, height), 1);
}
 
static void de_drawtext(int xpos, int ypos, char *text)
{
    gdrawstr(de, p->f, p->fg, pt(xpos, ypos), text);
}
 
/* Keypress callbacks */
 
static void de_normalkeyin(control c, int k)
{
    int i, st;
    char text[1];
 
    st = ggetkeystate();
    if ((p->chbrk) && (k == p->chbrk) &&
	((!p->modbrk) || ((p->modbrk) && (st == p->modbrk)))) {
	p->fbrk(c);
	return;
    }
    if (st & CtrlKey) {
	switch (k + 'A' - 1) {
	case 'B':
	    i = rowmin - nhigh + 2;
	    jumpwin(colmin, max(i, 1));
	    break;
	case 'F':
	    jumpwin(colmin, rowmax);
	    break;
	case 'H':
	    if (clength > 0) {
		clength--;
		bufp--;
		printstring(buf, clength, crow, ccol, 1);
	    } else bell();
	    break;
	case 'I':
	    if (st & ShiftKey) advancerect(LEFT);
	    else advancerect(RIGHT);
	    break;
	case 'N':
	case 'J':
	    advancerect(DOWN);
	    break;
	case 'C':
	    de_copy(de);
	    break;
	case 'V':
	    de_paste(de);
	    break;
	case 'L':
	    for (i = colmin; i < colmax; i++)
		if (i < 100) boxw[i] = get_col_width(i)*FW + 8;
	    drawwindow();
	    break;
	default:
	    bell();
	}
    } else if(k == '\b') {
	    if (clength > 0) {
		clength--;
		bufp--;
		printstring(buf, clength, crow, ccol, 1);
	    } else bell();
    } else if(k == '\n' || k == '\r') {
	    advancerect(DOWN);
    } else if(k == '\t') {
	if (st & ShiftKey) advancerect(LEFT);
	else advancerect(RIGHT);
    } else {
	text[0] = k;
	handlechar(text);
    }
 
}
 
static void de_ctrlkeyin(control c, int key)
{
    int st, i;
 
    st = ggetkeystate();
    if ((p->chbrk) && (key == p->chbrk) &&
	((!p->modbrk) || ((p->modbrk) && (st == p->modbrk)))) {
	p->fbrk(c);
	return;
    }
    switch (key) {
    case HOME:
	jumpwin(1, 1);
	downlightrect();
	crow = ccol = 1;
	highlightrect();
	break;
    case END:
	i = ymaxused - nhigh + 2;
	jumpwin(xmaxused, max(i, 1));
	downlightrect();
	crow = ymaxused - rowmin + 1;
	ccol = 1;
	highlightrect();
	break;
    case PGUP:
	i = rowmin - nhigh + 2;
	jumpwin(colmin, max(i, 1));
	break;
    case PGDN:
	jumpwin(colmin, rowmax);
	break;
    case LEFT:
	advancerect(LEFT);
	break;
    case RIGHT:
	advancerect(RIGHT);
	break;
    case UP:
	advancerect(UP);
	break;
    case DOWN:
	advancerect(DOWN);
	break;
    case DEL:
	if (clength > 0) {
	    clength--;
	    bufp--;
	    printstring(buf, clength, crow, ccol, 1);
	} else de_delete(de);
	break;
     case ENTER:
	 advancerect(DOWN);
	 break;
    default:
	;
    }
}
 
/* mouse callbacks */
 
static char *get_cell_text(void)
{
    int  wrow = rowmin + crow - 2, wcol = colmin + ccol - 1;
    char *prev = "";
    SEXP tvec;
 
    if (wcol <= xmaxused) {
	tvec = VECTOR_ELT(work, wcol - 1);
	if (!isNull(tvec) && wrow < INTEGER(lens)[wcol - 1]) {
	    PrintDefaults(R_NilValue);
	    if (TYPEOF(tvec) == REALSXP) {
		if (REAL(tvec)[wrow] != ssNA_REAL)
		    prev = EncodeElement(tvec, wrow, 0);
	    } else if (TYPEOF(tvec) == STRSXP) {
		if (!streql(CHAR(STRING_ELT(tvec, wrow)),
			    CHAR(STRING_ELT(ssNA_STRING, 0))))
		    prev = EncodeElement(tvec, wrow, 0);
	    } else error("dataentry: internal memory error");
	}
    }
    return prev;
}
 
static int online, clickline;
 
static void de_mousedown(control c, int buttons, point xy)
{
    int xw, yw, wcol=0, wrow, i, w;
 
    if (buttons & LeftButton) {
	xw = xy.x;
	yw = xy.y;
 
	closerect();
 
	/* check to see if the click was in the header */
 
	if (yw < hwidth + bwidth) {
	    /* too high */
	    return;
	}
	/* translate to box coordinates */
 
	wrow = (yw - bwidth - hwidth) / box_h;
 
	/* see if it is in the row labels */
	if (xw < bwidth + boxw[0]) {
	    bell();
	    highlightrect();
	    return;
	}
	w = bwidth + boxw[0];
	for (i = 1; i <= nwide; i++)
	    if((w += BOXW(i+colmin-1)) > xw) {
		wcol = i;
		break;
	}
 
	/* see if we selected a line */
	w = bwidth;
	online = 0;
	for (i = 0; i <= nwide; i++) {
	    if(i == 0) w += boxw[0]; else w += BOXW(i+colmin-1);
	    if (abs(w - xw) <= 2) {
		online = 1;
		clickline = i; /* between cols i and i+1 */
		highlightrect();
		gsetcursor(de, HandCursor);
		return;
	    }
	}
 
	/* next check to see if it is in the column labels */
 
	if (yw < hwidth + bwidth + box_h) {
	    if (xw > bwidth + boxw[0]) {
		highlightrect();
		de_popupmenu(xw, yw, wcol);
		return;
	    } else {
		/* in 0th column */
		highlightrect();
		bell();
	    }
	} else if (wrow > nhigh - 1 || wcol > nwide - 1) {
		/* off the grid */
		highlightrect();
		bell();
		return;
	} else if (buttons & DblClick) {
	    int x, y, bw;
	    char *prev;
	    rect rr;
 
	    ccol = wcol;
	    crow = wrow;
	    highlightrect();
	    find_coords(crow, ccol, &x, &y);
	    bw = BOXW(ccol + colmin - 1);
	    rr = rect(x + text_xoffset, y - text_yoffset - 1,
		      bw - text_xoffset - 2,
		      box_h - text_yoffset - 2);
	    prev = get_cell_text();
	    if (strlen(prev) * FW > bw)
		rr.width = (strlen(prev) + 2) * FW;
	    addto(de);
	    celledit = newfield_no_border(prev, rr);
	    setbackground(celledit, p->bg);
	    setforeground(celledit, p->ufg);
	    settextfont(celledit, p->f);
	    show(celledit);
	    CellEditable = TRUE;
	} else if (buttons & LeftButton) {
	    ccol = wcol;
	    crow = wrow;
	}
	highlightrect();
	return;
    }
}
 
static void de_mouseup(control c, int buttons, point xy)
{
    int xw, bw, i, w;
 
    if (online) {
	xw = xy.x;
	w = bwidth + boxw[0];
	for(i = 1; i < clickline; i++) w+= BOXW(i+colmin-1);
	bw = xw - w;
	if (bw < FW*4 + 8) bw = FW*4 + 8;
	if (bw > FW*50) bw = FW*50;
	if(clickline < 100) boxw[clickline] = bw;
	gsetcursor(de, ArrowCursor);
	deredraw();
    }
}
 
static void de_redraw(control c, rect r)
{
    if (WIDTH != oldWIDTH || HEIGHT != oldHEIGHT) drawwindow();
    else deredraw();
}
 
static void deredraw(void)
{
    int i;
 
    setcellwidths();
 
    if(hwidth > 0) gfillrect(de, bbg, rect(0, 0, WIDTH, hwidth));
    gfillrect(de, bbg, rect(0, 0, boxw[0], windowHeight));
 
    for (i = 1; i < nhigh; i++)
	drawrectangle(0, hwidth + i * box_h, boxw[0], box_h, 1, 1);
    colmax = colmin + (nwide - 2);
    rowmax = rowmin + (nhigh - 2);
    printlabs();
    /* if (!isNull(work) I don't think it can be null */
    for (i = colmin; i <= colmax; i++) drawcol(i);
    gfillrect(de, p->bg, rect(windowWidth+1, hwidth, WIDTH-windowWidth-1,
			      HEIGHT - hwidth));
    highlightrect();
}
 
static void de_closewin(void)
{
    closerect();
    hide(de);
    del(de);
}
 
static void copyarea(int src_x, int src_y, int dest_x, int dest_y)
{
    int mx = max(src_x, dest_x), my = max(src_y, dest_y);
    copyrect(de, pt(dest_x, dest_y),
	     rect(src_x, src_y, windowWidth - mx, windowHeight - my));
}
 
static void copyH(int src_x, int dest_x, int width)
{
    copyrect(de, pt(dest_x, hwidth),
	     rect(src_x, hwidth, width, windowHeight - hwidth));
}
 
static Rboolean initwin(void)
{
    int i;
    rect r;
 
    de = newdataeditor();
    if(!de) return TRUE;
    p = getdata(de);
 
    nboxchars = asInteger(GetOption(install("de.cellwidth"), R_GlobalEnv));
    if (nboxchars == NA_INTEGER || nboxchars < 0) nboxchars = 0;
    if (nboxchars > 0) check(de_mvw);
    box_w = ((nboxchars >0)?nboxchars:FIELDWIDTH)*FW + 8;
    /* this used to presume 4 chars sufficed for row numbering */
    labdigs = max(3, 1+floor(log10((double)ymaxused)));
    boxw[0] = (1+labdigs)*FW + 8;
    sprintf(labform, "%%%dd", labdigs);
    for(i = 1; i < 100; i++) boxw[i] = get_col_width(i)*FW + 8;
    box_h = FH + 4;
    text_xoffset = 5;
    text_yoffset = -3;
    setcellwidths();
    nhigh = (HEIGHT - 2 * bwidth - hwidth - 3) / box_h;
    windowHeight = nhigh * box_h + 2 * bwidth + hwidth;
    r = getrect(de);
    r.width = windowWidth + 3;
    r.height = windowHeight + 3;
    resize(de, r);
 
    CellModified = CellEditable = FALSE;
    bbg = dialog_bg();
    /* set the active cell to be the upper left one */
    crow = 1;
    ccol = 1;
    /* drawwindow(); done as repaint but
       decide if we need scrollbars here to avoid flashing*/
    nhigh = (HEIGHT - 2 * bwidth - hwidth) / box_h;
    gchangescrollbar(de, VWINSB, 0, ymaxused/yScrollbarScale,
		     max(nhigh/yScrollbarScale, 1), 0);
    setcellwidths();
    gchangescrollbar(de, HWINSB, 0, xmaxused/xScrollbarScale,
		     max(nwide/xScrollbarScale, 1), 0);
    show(de);
    show(de); /* a precaution, as PD reports transparent windows */
    BringToTop(de, 0);
    R_de_up = TRUE;
    return FALSE;
}
 
/* Menus */
 
static window wconf, devw;
static radiobutton rb_num, rb_char;
static label lwhat, lrb;
static field varname;
static int isnumeric, popupcol;
 
static void popupclose(control c)
{
    SEXP tvec;
    char buf[30], clab[25];
    int i;
 
    strcpy(buf, gettext(varname));
    if(!strlen(buf)) {
	askok("column names cannot be blank");
	return;
    }
    if (popupcol > xmaxused) {
	/* extend work, names and lens */
	REPROTECT(work = lengthgets(work, popupcol), wpi);
	REPROTECT(names = lengthgets(names, popupcol), npi);
	/* Last col name is set later */
	for (i = xmaxused+1; i < popupcol - 1; i++) {
	    sprintf(clab, "var%d", i + 1);
	    SET_STRING_ELT(names, i, mkChar(clab));
	}
	REPROTECT(lens = lengthgets(lens, popupcol), lpi);
	xmaxused = popupcol;
    }
    tvec = VECTOR_ELT(work, popupcol - 1);
    if(ischecked(rb_num) && !isnumeric) {
	if (isNull(tvec))
	    SET_VECTOR_ELT(work, popupcol - 1, ssNewVector(REALSXP, 100));
	else
	    SET_VECTOR_ELT(work, popupcol - 1, coerceVector(tvec, REALSXP));
    } else if(ischecked(rb_char) && isnumeric) {
	if (isNull(tvec))
	    SET_VECTOR_ELT(work, popupcol - 1, ssNewVector(STRSXP, 100));
	else
	    SET_VECTOR_ELT(work, popupcol - 1, coerceVector(tvec, STRSXP));
    }
    SET_STRING_ELT(names, popupcol - 1, mkChar(buf));
    hide(wconf);
    del(wconf);
}
 
static void nm_hit_key(window w, int key)
{
    if(key == '\n') popupclose(wconf);
}
 
static void de_popupmenu(int x_pos, int y_pos, int col)
{
    char *blah;
    rect r = screen_coords(de);
 
    popupcol = colmin + col - 1;
    blah = get_col_name(popupcol);
    wconf = newwindow("Variable editor",
		      rect(x_pos + r.x-150, y_pos + r.y-50, 300, 100),
		      Titlebar | Closebox | Modal);
    setclose(wconf, popupclose);
    setbackground(wconf, bbg);
    lwhat = newlabel("variable name", rect(10, 22, 90, 20), AlignLeft);
    varname = newfield(blah, rect(100, 20, 120, 20));
    lrb = newlabel("type", rect(50, 62, 50, 20), AlignLeft);
    rb_num = newradiobutton("numeric", rect(100, 60 , 80, 20), NULL);
    rb_char = newradiobutton("character", rect(180, 60 , 80, 20), NULL);
    isnumeric = (get_col_type(popupcol) == NUMERIC);
    if (isnumeric) check(rb_num); else check(rb_char);
    setkeydown(wconf, nm_hit_key);
    show(wconf);
}
 
static void de_copy(control c)
{
    copystringtoclipboard(get_cell_text());
}
 
static void de_paste(control c)
{
    char *p;
 
    closerect();
    if ( clipboardhastext() &&
	 !getstringfromclipboard(buf, 29) ) {
	/* set current cell to first line of clipboard */
	CellModified = TRUE;
	if ((p = strchr(buf, '\n'))) *p = '\0';
	clength = strlen(buf);
	bufp = buf + clength;
	closerect();
    }
    highlightrect();
}
 
static void de_delete(control c)
{
    CellModified = TRUE;
    buf[0] = '\0';
    clength = -1;
    bufp = buf + clength;
    closerect();
    highlightrect();
}
 
static void de_autosize(control c)
{
    int col = ccol + colmin - 1;
 
    closerect();
    if(col < 100) {
	boxw[col] = get_col_width(col)*FW + 8;
	deredraw();
    }
}
 
static void de_stayontop(control c)
{
 
 
    BringToTop(de, 2);
 
 
 
 
}
 
static void de_sbf(control c, int pos)
{
    if (pos < 0) { /* horizontal */
	colmin = 1 + (-pos*xScrollbarScale - 1);
    } else {
	rowmin = 1 + pos*yScrollbarScale;
	if(rowmin > ymaxused - nhigh + 2) rowmin = ymaxused - nhigh + 2;
    }
    drawwindow();
}
 
static checkbox varwidths;
 
static void vw_close(control c)
{
    int x;
    if (ischecked(varwidths)) x = 0;
    else x = atoi(gettext(varname)); /* 0 if error */
    x = min(x, 50);
    if (x != nboxchars) {
	nboxchars = x;
	box_w = ((nboxchars >0)?nboxchars:FIELDWIDTH)*FW + 8;
	deredraw();
    }
    hide(devw);
    del(devw);
    if (nboxchars > 0) check(de_mvw);
    else uncheck(de_mvw);
    addto(de);
}
 
static void vw_hit_key(window w, int key)
{
    if(key == '\n') vw_close(w);
}
 
static void vw_callback(control c)
{
    if (ischecked(varwidths)) disable(varname);
    else enable(varname);
}
 
 
static void de_popup_vw(void)
{
    char blah[25];
 
    devw = newwindow("Cell width(s)",
		      rect(0, 0, 250, 60),
		      Titlebar | Centered | Closebox | Modal);
    setclose(devw, vw_close);
    setbackground(devw, bbg);
    lwhat = newlabel("Cell width", rect(10, 20, 70, 20), AlignLeft);
    sprintf(blah, "%d", nboxchars);
    varname = newfield(blah, rect(80, 20, 40, 20));
    varwidths = newcheckbox("variable", rect(150, 20, 80, 20), vw_callback);
    if (nboxchars == 0) {
	check(varwidths);
	disable(varname);
    }
    setkeydown(devw, vw_hit_key);
    show(devw);
}
 
static void menudecellwidth(control m)
{
    de_popup_vw();
}
 
static void deldataeditor(control m)
{
    freeConsoleData(getdata(m));
}
 
static void declose(control m)
{
    de_closewin();
    show(RConsole);
    R_de_up = FALSE;
}
 
static void deresize(console c, rect r)
FBEGIN
    if (((WIDTH  == r.width) &&
	 (HEIGHT == r.height)) ||
	(r.width == 0) || (r.height == 0) ) /* minimize */
        FVOIDRETURN;
    WIDTH = r.width;
    HEIGHT = r.height;
FVOIDEND
 
static void menudehelp(control m)
{
    char s[] = "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";
    askok(s);
}
 
 
static MenuItem DePopup[28] = {
    {"Help", menudehelp, 0},
    {"-", 0, 0},
    {"Copy selected cell", de_copy, 0},
    {"Paste to selected cell", de_paste, 0},
    {"Autosize column", de_autosize, 0},
    {"-", 0, 0},
    {"Stay on top", de_stayontop, 0},
    {"-", 0, 0},
    {"Close", declose, 0},
    LASTMENUITEM
};
 
static void demenuact(control m)
{
    /* use this to customize the menu */
}
 
static void depopupact(control m)
{
    /* use this to customize the menu */
    if (ismdi())
    	disable(DePopup[6].m);
    else {
    	if (isTopmost(de))
    	    check(DePopup[6].m);
    	else
    	    uncheck(DePopup[6].m);
    }
}
 
 
#define MCHECK(a) if (!(a)) {del(c);return NULL;}
 
RECT *RgetMDIsize(); /* in rui.c */
 
static dataeditor newdataeditor(void)
{
    ConsoleData p;
    int w, h, x, y;
    dataeditor c;
    menuitem m;
 
    p = newconsoledata((consolefn) ? consolefn : FixedFont,
		       pagerrow, pagercol, 0, 0,
		       consolefg, consoleuser, consolebg,
		       DATAEDITOR);
    if (!p) return NULL;
 
    w = WIDTH ;
    h = HEIGHT;
    if (ismdi()) {
	RECT *pR = RgetMDIsize();
	x = (pR->right - w) / 3; x = x > 20 ? x:20;
	y = (pR->bottom - h) / 3; y = y > 20 ? y:20;
    } else {
	x = (devicewidth(NULL) - w) / 3;
	y = (deviceheight(NULL) - h) / 3 ;
    }
    c = (dataeditor) newwindow(" Data Editor", rect(x, y, w, h),
			       Document | StandardWindow | Menubar |
			       VScrollbar | HScrollbar | TrackMouse);
    if (!c) {
         freeConsoleData(p);
         return NULL;
    }
    setdata(c, p);
    if(h == 0) HEIGHT = getheight(c);
    if(w == 0) WIDTH  = getwidth(c);
    COLS = WIDTH / FW - 1;
    ROWS = HEIGHT / FH - 1;
    BORDERX = (WIDTH - COLS*FW) / 2;
    BORDERY = (HEIGHT - ROWS*FH) / 2;
    gsetcursor(c, ArrowCursor);
    setbackground(c, consolebg);
    if (ismdi() && (RguiMDI & RW_TOOLBAR)) {
	/* blank toolbar to stop windows jumping around */
        int btsize = 24;
        control tb;
        addto(c);
        MCHECK(tb = newtoolbar(btsize + 4));
	gsetcursor(tb, ArrowCursor);
    }
    MCHECK(gpopup(depopupact, DePopup));
    MCHECK(m = newmenubar(demenuact));
    MCHECK(newmenu("File"));
/*    MCHECK(m = newmenuitem("-", 0, NULL));*/
    MCHECK(m = newmenuitem("Close", 0, declose));
    newmdimenu();
    MCHECK(newmenu("Edit"));
    MCHECK(m = newmenuitem("Copy  \tCTRL+C", 0, de_copy));
    MCHECK(m = newmenuitem("Paste \tCTRL+V", 0, de_paste));
    MCHECK(m = newmenuitem("Delete\tDEL", 0, de_delete));
    MCHECK(m = newmenuitem("-", 0, NULL));
    MCHECK(de_mvw = newmenuitem("Cell widths ...", 0, menudecellwidth));
    MCHECK(m = newmenu("Help"));
    MCHECK(newmenuitem("Data editor", 0, menudehelp));
 
    setdata(c, p);
    setresize(c, deresize);
    setredraw(c, de_redraw);
    setdel(c, deldataeditor);
    setclose(c, declose);
    sethit(c, de_sbf);
    setkeyaction(c, de_ctrlkeyin);
    setkeydown(c, de_normalkeyin);
    setmousedown(c, de_mousedown);
    setmouseup(c, de_mouseup);
    return(c);
}

Rev 27662	Rev 27686
1	`/*`	1	`/*`
2	`* R : A Computer Langage for Statistical Data Analysis`	2	`* R : A Computer Langage for Statistical Data Analysis`
3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`	3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`
4	`* Copyright (C) 1998--2003 Robert Gentleman, Ross Ihaka and the`	4	`* Copyright (C) 1998--2003 Robert Gentleman, Ross Ihaka and the`
5	`* R Development Core Team`	5	`* R Development Core Team`
6	`*`	6	`*`
7	`* This program is free software; you can redistribute it and/or modify`	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`	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`	9	`* the Free Software Foundation; either version 2 of the License, or`
10	`* (at your option) any later version.`	10	`* (at your option) any later version.`
11	`*`	11	`*`
12	`* This program is distributed in the hope that it will be useful,`	12	`* This program is distributed in the hope that it will be useful,`
13	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`	13	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`
14	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`	14	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
15	`* GNU General Public License for more details.`	15	`* GNU General Public License for more details.`
16	`*`	16	`*`
17	`* You should have received a copy of the GNU General Public License`	17	`* You should have received a copy of the GNU General Public License`
18	`* along with this program; if not, write to the Free Software`	18	`* along with this program; if not, write to the Free Software`
19	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`	19	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`
20	`*/`	20	`*/`
21		21
22	`/* TODO`	22	`/* TODO`
23	`- spreadsheet copy and paste?`	23	`- spreadsheet copy and paste?`
24	`*/`	24	`*/`
25		25
26	`#ifdef HAVE_CONFIG_H`	26	`#ifdef HAVE_CONFIG_H`
27	`#include <config.h>`	27	`#include <config.h>`
28	`#endif`	28	`#endif`
29		29
30	`#include "Defn.h"`	30	`#include "Defn.h"`
31	`#include "Print.h"`	31	`#include "Print.h"`
32		32
33	`#include "graphapp/ga.h"`	33	`#include "graphapp/ga.h"`
34	`#include "console.h"`	34	`#include "console.h"`
35	`#include "consolestructs.h"`	35	`#include "consolestructs.h"`
36	`#include "rui.h"`	36	`#include "rui.h"`
37		37
38	`static dataeditor de;`	38	`static dataeditor de;`
39	`static ConsoleData p;`	39	`static ConsoleData p;`
40		40
41	`typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;`	41	`typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;`
42		42
43	`static Rboolean R_de_up;`	43	`static Rboolean R_de_up;`
44		44
45	`#ifndef max`	45	`#ifndef max`
46	`#define max(a, b) (((a)>(b))?(a):(b))`	46	`#define max(a, b) (((a)>(b))?(a):(b))`
47	`#endif`	47	`#endif`
48	`#ifndef min`	48	`#ifndef min`
49	`#define min(a, b) (((a)<(b))?(a):(b))`	49	`#define min(a, b) (((a)<(b))?(a):(b))`
50	`#endif`	50	`#endif`
51	`#define BOXW(x) (min(((x<100 && nboxchars==0)?boxw[x]:box_w),WIDTH-boxw[0]-2*bwidth-2))`	51	`#define BOXW(x) (min(((x<100 && nboxchars==0)?boxw[x]:box_w),WIDTH-boxw[0]-2*bwidth-2))`
52		52
53	`#define FIELDWIDTH 10`	53	`#define FIELDWIDTH 10`
54		54
55	`/* Local Function Definitions */`	55	`/* Local Function Definitions */`
56		56
57	`static void advancerect(int);`	57	`static void advancerect(int);`
58	`static void bell();`	58	`static void bell();`
59	`static void cleararea(int, int, int, int, rgb);`	59	`static void cleararea(int, int, int, int, rgb);`
60	`static void clearrect(void);`	60	`static void clearrect(void);`
61	`static void closerect(void);`	61	`static void closerect(void);`
62	`static void clearwindow(void);`	62	`static void clearwindow(void);`
63	`static void de_closewin(void);`	63	`static void de_closewin(void);`
64	`static void copyarea(int, int, int, int);`	64	`static void copyarea(int, int, int, int);`
65	`static void copyH(int, int, int);`	65	`static void copyH(int, int, int);`
66	`static void deredraw(void);`	66	`static void deredraw(void);`
67	`static void eventloop(void);`	67	`static void eventloop(void);`
68	`static void downlightrect(void);`	68	`static void downlightrect(void);`
69	`static void drawwindow(void);`	69	`static void drawwindow(void);`
70	`static void drawcol(int);`	70	`static void drawcol(int);`
71	`/* static void de_drawline(int, int, int, int);*/`	71	`/* static void de_drawline(int, int, int, int);*/`
72	`static void de_drawtext(int, int, char *);`	72	`static void de_drawtext(int, int, char *);`
73	`static void drawrectangle(int, int, int, int, int, int);`	73	`static void drawrectangle(int, int, int, int, int, int);`
74	`static void drawrow(int);`	74	`static void drawrow(int);`
75	`static void find_coords(int, int, int, int);`	75	`static void find_coords(int, int, int, int);`
76	`static void handlechar(char*);`	76	`static void handlechar(char*);`
77	`static void highlightrect(void);`	77	`static void highlightrect(void);`
78	`static Rboolean initwin(void);`	78	`static Rboolean initwin(void);`
79	`static void jumppage(int);`	79	`static void jumppage(int);`
80	`static void jumpwin(int, int);`	80	`static void jumpwin(int, int);`
81	`static void de_popupmenu(int, int, int);`	81	`static void de_popupmenu(int, int, int);`
82	`static void printlabs(void);`	82	`static void printlabs(void);`
83	`static void printrect(int, int);`	83	`static void printrect(int, int);`
84	`static void printstring(char*, int, int, int, int);`	84	`static void printstring(char*, int, int, int, int);`
85	`static void printelt(SEXP, int, int, int);`	85	`static void printelt(SEXP, int, int, int);`
86	`static void setcellwidths(void);`	86	`static void setcellwidths(void);`
87		87
88	`static dataeditor newdataeditor();`	88	`static dataeditor newdataeditor();`
89	`static void de_copy(control c);`	89	`static void de_copy(control c);`
90	`static void de_paste(control c);`	90	`static void de_paste(control c);`
91	`static void de_delete(control c);`	91	`static void de_delete(control c);`
92	`static menuitem de_mvw;`	92	`static menuitem de_mvw;`
93		93
94	`static SEXP work, names, lens;`	94	`static SEXP work, names, lens;`
95	`static PROTECT_INDEX wpi, npi, lpi;`	95	`static PROTECT_INDEX wpi, npi, lpi;`
96	`static SEXP ssNA_STRING;`	96	`static SEXP ssNA_STRING;`
97	`static double ssNA_REAL;`	97	`static double ssNA_REAL;`
98		98
99	`/* Global variables needed for the graphics */`	99	`/* Global variables needed for the graphics */`
100		100
101	`static int box_w; /* width of a box */`	101	`static int box_w; /* width of a box */`
102	`static int boxw[100]; /* widths of cells */`	102	`static int boxw[100]; /* widths of cells */`
103	`static int box_h; /* height of a box */`	103	`static int box_h; /* height of a box */`
104	`static int windowWidth; /* current width of the window */`	104	`static int windowWidth; /* current width of the window */`
105	`static int windowHeight; /* current height of the window */`	105	`static int windowHeight; /* current height of the window */`
106	`static int currentexp; /* boolean: whether an cell is active */`	106	`static int currentexp; /* boolean: whether an cell is active */`
107	`static int crow; /* current row */`	107	`static int crow; /* current row */`
108	`static int ccol; /* current column */`	108	`static int ccol; /* current column */`
109	`static int nwide, nhigh;`	109	`static int nwide, nhigh;`
110	`static int colmax, colmin, rowmax, rowmin;`	110	`static int colmax, colmin, rowmax, rowmin;`
111	`static int ndecimal; /* count decimal points */`	111	`static int ndecimal; /* count decimal points */`
112	`static int ne; /* count exponents */`	112	`static int ne; /* count exponents */`
113	`static int nneg; /* indicate whether its a negative */`	113	`static int nneg; /* indicate whether its a negative */`
114	`static int clength; /* number of characters currently entered */`	114	`static int clength; /* number of characters currently entered */`
115	`static char buf[30];`	115	`static char buf[30];`
116	`static char *bufp;`	116	`static char *bufp;`
117	`static int bwidth; /* width of the border */`	117	`static int bwidth; /* width of the border */`
118	`static int hwidth; /* width of header */`	118	`static int hwidth; /* width of header */`
119	`static int text_xoffset, text_yoffset;`	119	`static int text_xoffset, text_yoffset;`
120	`static field celledit;`	120	`static field celledit;`
121	`static Rboolean newcol, CellModified, CellEditable;`	121	`static Rboolean newcol, CellModified, CellEditable;`
122	`static int xmaxused, ymaxused;`	122	`static int xmaxused, ymaxused;`
123	`static int oldWIDTH=0, oldHEIGHT=0;`	123	`static int oldWIDTH=0, oldHEIGHT=0;`
124	`static int nboxchars=0;`	124	`static int nboxchars=0;`
125	`static int labdigs=4;`	125	`static int labdigs=4;`
126	`static char labform[6];`	126	`static char labform[6];`
127	`static int xScrollbarScale=1, yScrollbarScale=1;`	127	`static int xScrollbarScale=1, yScrollbarScale=1;`
128		128
129	`#include <windows.h> /* for Sleep */`	129	`#include <windows.h> /* for Sleep */`
130		130
131	`/*`	131	`/*`
132	`Underlying assumptions (for this version R >= 1.8.0)`	132	`Underlying assumptions (for this version R >= 1.8.0)`
133		133
134	The data are stored in a list `work', with unused columns having	134	The data are stored in a list `work', with unused columns having
135	NULL entries. The names for the list are in `names', which should	135	NULL entries. The names for the list are in `names', which should
136	`have a name for all displayable columns (up to xmaxused).`	136	`have a name for all displayable columns (up to xmaxused).`
137	The used lengths of the columns are in `lens': this needs only be	137	The used lengths of the columns are in `lens': this needs only be
138	`set for non-NULL columns.`	138	`set for non-NULL columns.`
139		139
140	`If the list was originally length(0), that should work with`	140	`If the list was originally length(0), that should work with`
141	`0 pre-defined cols. (It used to have 1 pre-defined numeric column.)`	141	`0 pre-defined cols. (It used to have 1 pre-defined numeric column.)`
142		142
143	`All row and col numbers are 1-based.`	143	`All row and col numbers are 1-based.`
144		144
145	`BDR May 2003`	145	`BDR May 2003`
146	`*/`	146	`*/`
147		147
148	`/*`	148	`/*`
149	`ssNewVector is just an interface to allocVector but it lets us`	149	`ssNewVector is just an interface to allocVector but it lets us`
150	`set the fields to NA. We need to have a special NA for reals and`	150	`set the fields to NA. We need to have a special NA for reals and`
151	`strings so that we can differentiate between uninitialized elements`	151	`strings so that we can differentiate between uninitialized elements`
152	`in the vectors and user supplied NA's; hence ssNA_REAL and ssNA_STRING`	152	`in the vectors and user supplied NA's; hence ssNA_REAL and ssNA_STRING`
153	`*/`	153	`*/`
154		154
155	`static SEXP ssNewVector(SEXPTYPE type, int vlen)`	155	`static SEXP ssNewVector(SEXPTYPE type, int vlen)`
156	`{`	156	`{`
157	`SEXP tvec;`	157	`SEXP tvec;`
158	`int j;`	158	`int j;`
159		159
160	`tvec = allocVector(type, vlen);`	160	`tvec = allocVector(type, vlen);`
161	`for (j = 0; j < vlen; j++)`	161	`for (j = 0; j < vlen; j++)`
162	`if (type == REALSXP)`	162	`if (type == REALSXP)`
163	`REAL(tvec)[j] = ssNA_REAL;`	163	`REAL(tvec)[j] = ssNA_REAL;`
164	`else if (type == STRSXP)`	164	`else if (type == STRSXP)`
165	`SET_STRING_ELT(tvec, j, STRING_ELT(ssNA_STRING, 0));`	165	`SET_STRING_ELT(tvec, j, STRING_ELT(ssNA_STRING, 0));`
166	`SETLEVELS(tvec, 0);`	166	`SETLEVELS(tvec, 0);`
167	`return (tvec);`	167	`return (tvec);`
168	`}`	168	`}`
169	`static void eventloop()`	169	`static void eventloop()`
170	`{`	170	`{`
171	`while (R_de_up) {`	171	`while (R_de_up) {`
172	`/* avoid consuming 100% CPU time here */`	172	`/* avoid consuming 100% CPU time here */`
173	`Sleep(10);`	173	`Sleep(10);`
174	`R_ProcessEvents();`	174	`R_ProcessEvents();`
175	`}`	175	`}`
176	`}`	176	`}`
177		177
178	`static void de_closewin_cend(void *data)`	178	`static void de_closewin_cend(void *data)`
179	`{`	179	`{`
180	`de_closewin();`	180	`de_closewin();`
181	`}`	181	`}`
182		182
183	`SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)`	183	`SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)`
184	`{`	184	`{`
185	`SEXP colmodes, tnames, tvec, tvec2, work2;`	185	`SEXP colmodes, tnames, tvec, tvec2, work2;`
186	`SEXPTYPE type;`	186	`SEXPTYPE type;`
187	`int i, j, cnt, len, nprotect;`	187	`int i, j, cnt, len, nprotect;`
188	`RCNTXT cntxt;`	188	`RCNTXT cntxt;`
189	`char clab[25];`	189	`char clab[25];`
190		190
191	`nprotect = 0;/* count the PROTECT()s */`	191	`nprotect = 0;/* count the PROTECT()s */`
192	`PROTECT_WITH_INDEX(work = duplicate(CAR(args)), &wpi); nprotect++;`	192	`PROTECT_WITH_INDEX(work = duplicate(CAR(args)), &wpi); nprotect++;`
193	`colmodes = CADR(args);`	193	`colmodes = CADR(args);`
194	`tnames = getAttrib(work, R_NamesSymbol);`	194	`tnames = getAttrib(work, R_NamesSymbol);`
195		195
196	`if (TYPEOF(work) != VECSXP \|\| TYPEOF(colmodes) != VECSXP)`	196	`if (TYPEOF(work) != VECSXP \|\| TYPEOF(colmodes) != VECSXP)`
197	`errorcall(call, "invalid argument");`	197	`errorcall(call, "invalid argument");`
198		198
199	`/* initialize the constants */`	199	`/* initialize the constants */`
200		200
201	`bufp = buf;`	201	`bufp = buf;`
202	`ne = 0;`	202	`ne = 0;`
203	`currentexp = 0;`	203	`currentexp = 0;`
204	`nneg = 0;`	204	`nneg = 0;`
205	`ndecimal = 0;`	205	`ndecimal = 0;`
206	`clength = 0;`	206	`clength = 0;`
207	`ccol = 1;`	207	`ccol = 1;`
208	`crow = 1;`	208	`crow = 1;`
209	`colmin = 1;`	209	`colmin = 1;`
210	`rowmin = 1;`	210	`rowmin = 1;`
211	`ssNA_REAL = -NA_REAL;`	211	`ssNA_REAL = -NA_REAL;`
212	`tvec = allocVector(REALSXP, 1);`	212	`tvec = allocVector(REALSXP, 1);`
213	`REAL(tvec)[0] = ssNA_REAL;`	213	`REAL(tvec)[0] = ssNA_REAL;`
214	`PROTECT(ssNA_STRING = coerceVector(tvec, STRSXP)); nprotect++;`	214	`PROTECT(ssNA_STRING = coerceVector(tvec, STRSXP)); nprotect++;`
215	`bwidth = 0;`	215	`bwidth = 0;`
216	`hwidth = 5;`	216	`hwidth = 5;`
217		217
218	`/* setup work, names, lens */`	218	`/* setup work, names, lens */`
219	`xmaxused = length(work); ymaxused = 0;`	219	`xmaxused = length(work); ymaxused = 0;`
220	`PROTECT_WITH_INDEX(lens = allocVector(INTSXP, xmaxused), &lpi);`	220	`PROTECT_WITH_INDEX(lens = allocVector(INTSXP, xmaxused), &lpi);`
221	`nprotect++;`	221	`nprotect++;`
222		222
223	`if (isNull(tnames)) {`	223	`if (isNull(tnames)) {`
224	`PROTECT_WITH_INDEX(names = allocVector(STRSXP, xmaxused), &npi);`	224	`PROTECT_WITH_INDEX(names = allocVector(STRSXP, xmaxused), &npi);`
225	`for(i = 0; i < xmaxused; i++) {`	225	`for(i = 0; i < xmaxused; i++) {`
226	`sprintf(clab, "var%d", i);`	226	`sprintf(clab, "var%d", i);`
227	`SET_STRING_ELT(names, i, mkChar(clab));`	227	`SET_STRING_ELT(names, i, mkChar(clab));`
228	`}`	228	`}`
229	`} else`	229	`} else`
230	`PROTECT_WITH_INDEX(names = duplicate(tnames), &npi);`	230	`PROTECT_WITH_INDEX(names = duplicate(tnames), &npi);`
231	`nprotect++;`	231	`nprotect++;`
232	`for (i = 0; i < xmaxused; i++) {`	232	`for (i = 0; i < xmaxused; i++) {`
233	`int len = LENGTH(VECTOR_ELT(work, i));`	233	`int len = LENGTH(VECTOR_ELT(work, i));`
234	`INTEGER(lens)[i] = len;`	234	`INTEGER(lens)[i] = len;`
235	`ymaxused = max(len, ymaxused);`	235	`ymaxused = max(len, ymaxused);`
236	`type = TYPEOF(VECTOR_ELT(work, i));`	236	`type = TYPEOF(VECTOR_ELT(work, i));`
237	`if (LENGTH(colmodes) > 0 && !isNull(VECTOR_ELT(colmodes, i)))`	237	`if (LENGTH(colmodes) > 0 && !isNull(VECTOR_ELT(colmodes, i)))`
238	`type = str2type(CHAR(STRING_ELT(VECTOR_ELT(colmodes, i), 0)));`	238	`type = str2type(CHAR(STRING_ELT(VECTOR_ELT(colmodes, i), 0)));`
239	`if (type != STRSXP) type = REALSXP;`	239	`if (type != STRSXP) type = REALSXP;`
240	`if (isNull(VECTOR_ELT(work, i))) {`	240	`if (isNull(VECTOR_ELT(work, i))) {`
241	`if (type == NILSXP) type = REALSXP;`	241	`if (type == NILSXP) type = REALSXP;`
242	`SET_VECTOR_ELT(work, i, ssNewVector(type, 100));`	242	`SET_VECTOR_ELT(work, i, ssNewVector(type, 100));`
243	`} else if (!isVector(VECTOR_ELT(work, i)))`	243	`} else if (!isVector(VECTOR_ELT(work, i)))`
244	`errorcall(call, "invalid type for value");`	244	`errorcall(call, "invalid type for value");`
245	`else {`	245	`else {`
246	`if (TYPEOF(VECTOR_ELT(work, i)) != type)`	246	`if (TYPEOF(VECTOR_ELT(work, i)) != type)`
247	`SET_VECTOR_ELT(work, i,`	247	`SET_VECTOR_ELT(work, i,`
248	`coerceVector(VECTOR_ELT(work, i), type));`	248	`coerceVector(VECTOR_ELT(work, i), type));`
249	`}`	249	`}`
250	`}`	250	`}`
251		251
252	`/* scale scrollbars as needed */`	252	`/* scale scrollbars as needed */`
253	`if (xmaxused > 10000) xScrollbarScale = xmaxused/1000;`	253	`if (xmaxused > 10000) xScrollbarScale = xmaxused/1000;`
254	`if (ymaxused > 10000) yScrollbarScale = ymaxused/1000;`	254	`if (ymaxused > 10000) yScrollbarScale = ymaxused/1000;`
255		255
256	`/* start up the window, more initializing in here */`	256	`/* start up the window, more initializing in here */`
257	`if (initwin())`	257	`if (initwin())`
258	`errorcall(call, "invalid device");`	258	`errorcall(call, "invalid device");`
259		259
260	`/* set up a context which will close the window if there is an error */`	260	`/* set up a context which will close the window if there is an error */`
261	`begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_NilValue, R_NilValue,`	261	`begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_NilValue, R_NilValue,`
262	`R_NilValue, R_NilValue);`	262	`R_NilValue, R_NilValue);`
263	`cntxt.cend = &de_closewin_cend;`	263	`cntxt.cend = &de_closewin_cend;`
264	`cntxt.cenddata = NULL;`	264	`cntxt.cenddata = NULL;`
265		265
266	`highlightrect();`	266	`highlightrect();`
267		267
268	`eventloop();`	268	`eventloop();`
269		269
270	`endcontext(&cntxt);`	270	`endcontext(&cntxt);`
271		271
272	`/* drop out unused columns */`	272	`/* drop out unused columns */`
273	`for(i = 0, cnt = 0; i < xmaxused; i++)`	273	`for(i = 0, cnt = 0; i < xmaxused; i++)`
274	`if(!isNull(VECTOR_ELT(work, i))) cnt++;`	274	`if(!isNull(VECTOR_ELT(work, i))) cnt++;`
275	`if (cnt < xmaxused) {`	275	`if (cnt < xmaxused) {`
276	`PROTECT(work2 = allocVector(VECSXP, cnt)); nprotect++;`	276	`PROTECT(work2 = allocVector(VECSXP, cnt)); nprotect++;`
277	`for(i = 0, j = 0; i < xmaxused; i++) {`	277	`for(i = 0, j = 0; i < xmaxused; i++) {`
278	`if(!isNull(VECTOR_ELT(work, i))) {`	278	`if(!isNull(VECTOR_ELT(work, i))) {`
279	`SET_VECTOR_ELT(work2, j, VECTOR_ELT(work, i));`	279	`SET_VECTOR_ELT(work2, j, VECTOR_ELT(work, i));`
280	`INTEGER(lens)[j] = INTEGER(lens)[i];`	280	`INTEGER(lens)[j] = INTEGER(lens)[i];`
281	`SET_STRING_ELT(names, j, STRING_ELT(names, i));`	281	`SET_STRING_ELT(names, j, STRING_ELT(names, i));`
282	`j++;`	282	`j++;`
283	`}`	283	`}`
284	`}`	284	`}`
285	`REPROTECT(names = lengthgets(names, cnt), npi);`	285	`REPROTECT(names = lengthgets(names, cnt), npi);`
286	`} else work2 = work;`	286	`} else work2 = work;`
287		287
288	`for (i = 0; i < LENGTH(work2); i++) {`	288	`for (i = 0; i < LENGTH(work2); i++) {`
289	`len = INTEGER(lens)[i];`	289	`len = INTEGER(lens)[i];`
290	`tvec = VECTOR_ELT(work2, i);`	290	`tvec = VECTOR_ELT(work2, i);`
291	`if (LENGTH(tvec) != len) {`	291	`if (LENGTH(tvec) != len) {`
292	`tvec2 = ssNewVector(TYPEOF(tvec), len);`	292	`tvec2 = ssNewVector(TYPEOF(tvec), len);`
293	`for (j = 0; j < len; j++) {`	293	`for (j = 0; j < len; j++) {`
294	`if (TYPEOF(tvec) == REALSXP) {`	294	`if (TYPEOF(tvec) == REALSXP) {`
295	`if (REAL(tvec)[j] != ssNA_REAL)`	295	`if (REAL(tvec)[j] != ssNA_REAL)`
296	`REAL(tvec2)[j] = REAL(tvec)[j];`	296	`REAL(tvec2)[j] = REAL(tvec)[j];`
297	`else`	297	`else`
298	`REAL(tvec2)[j] = NA_REAL;`	298	`REAL(tvec2)[j] = NA_REAL;`
299	`} else if (TYPEOF(tvec) == STRSXP) {`	299	`} else if (TYPEOF(tvec) == STRSXP) {`
300	`if (!streql(CHAR(STRING_ELT(tvec, j)),`	300	`if (!streql(CHAR(STRING_ELT(tvec, j)),`
301	`CHAR(STRING_ELT(ssNA_STRING, 0))))`	301	`CHAR(STRING_ELT(ssNA_STRING, 0))))`
302	`SET_STRING_ELT(tvec2, j, STRING_ELT(tvec, j));`	302	`SET_STRING_ELT(tvec2, j, STRING_ELT(tvec, j));`
303	`else`	303	`else`
304	`SET_STRING_ELT(tvec2, j, NA_STRING);`	304	`SET_STRING_ELT(tvec2, j, NA_STRING);`
305	`} else`	305	`} else`
306	`error("dataentry: internal memory problem");`	306	`error("dataentry: internal memory problem");`
307	`}`	307	`}`
308	`SET_VECTOR_ELT(work2, i, tvec2);`	308	`SET_VECTOR_ELT(work2, i, tvec2);`
309	`}`	309	`}`
310	`}`	310	`}`
311		311
312	`setAttrib(work2, R_NamesSymbol, names);`	312	`setAttrib(work2, R_NamesSymbol, names);`
313	`UNPROTECT(nprotect);`	313	`UNPROTECT(nprotect);`
314	`return work2;`	314	`return work2;`
315	`}`	315	`}`
316		316
317	`/* Window Drawing Routines */`	317	`/* Window Drawing Routines */`
318		318
319	`static rgb bbg;`	319	`static rgb bbg;`
320		320
321	`static void setcellwidths(void)`	321	`static void setcellwidths(void)`
322	`{`	322	`{`
323	`int i, w, dw;`	323	`int i, w, dw;`
324		324
325	`windowWidth = w = 2*bwidth + boxw[0] + BOXW(colmin);`	325	`windowWidth = w = 2*bwidth + boxw[0] + BOXW(colmin);`
326	`nwide = 2;`	326	`nwide = 2;`
327	`for (i = 2; i < 100; i++) { /* 100 on-screen columns cannot occur */`	327	`for (i = 2; i < 100; i++) { /* 100 on-screen columns cannot occur */`
328	`dw = BOXW(i + colmin - 1);`	328	`dw = BOXW(i + colmin - 1);`
329	`if((w += dw) > WIDTH) {`	329	`if((w += dw) > WIDTH) {`
330	`nwide = i;`	330	`nwide = i;`
331	`windowWidth = w - dw;`	331	`windowWidth = w - dw;`
332	`break;`	332	`break;`
333	`}`	333	`}`
334	`}`	334	`}`
335	`}`	335	`}`
336		336
337		337
338	`static void drawwindow(void)`	338	`static void drawwindow(void)`
339	`{`	339	`{`
340	`/* might have resized */`	340	`/* might have resized */`
341	`setcellwidths();`	341	`setcellwidths();`
342	`nhigh = (HEIGHT - 2 * bwidth - hwidth - 3) / box_h;`	342	`nhigh = (HEIGHT - 2 * bwidth - hwidth - 3) / box_h;`
343	`windowHeight = nhigh * box_h + 2 * bwidth + hwidth;`	343	`windowHeight = nhigh * box_h + 2 * bwidth + hwidth;`
344	`oldWIDTH = WIDTH;`	344	`oldWIDTH = WIDTH;`
345	`oldHEIGHT = HEIGHT;`	345	`oldHEIGHT = HEIGHT;`
346		346
347	`clearwindow();`	347	`clearwindow();`
348	`deredraw();`	348	`deredraw();`
349	`/* row/col 1 = pos 0 */`	349	`/* row/col 1 = pos 0 */`
350	`gchangescrollbar(de, VWINSB, (rowmin - 1)/yScrollbarScale,`	350	`gchangescrollbar(de, VWINSB, (rowmin - 1)/yScrollbarScale,`
351	`ymaxused/yScrollbarScale,`	351	`ymaxused/yScrollbarScale,`
352	`max(nhigh/yScrollbarScale, 1), 0);`	352	`max(nhigh/yScrollbarScale, 1), 0);`
353	`gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,`	353	`gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,`
354	`xmaxused/xScrollbarScale,`	354	`xmaxused/xScrollbarScale,`
355	`max(nwide/xScrollbarScale, 1), 0);`	355	`max(nwide/xScrollbarScale, 1), 0);`
356	`}`	356	`}`
357		357
358	`static void doHscroll(int oldcol)`	358	`static void doHscroll(int oldcol)`
359	`{`	359	`{`
360	`int i, dw;`	360	`int i, dw;`
361	`int oldnwide = nwide, oldwindowWidth = windowWidth;`	361	`int oldnwide = nwide, oldwindowWidth = windowWidth;`
362		362
363	`/* horizontal re-position */`	363	`/* horizontal re-position */`
364	`setcellwidths();`	364	`setcellwidths();`
365	`colmax = colmin + (nwide - 2);`	365	`colmax = colmin + (nwide - 2);`
366	`if (oldcol < colmin) { /* drop oldcol...colmin - 1 */`	366	`if (oldcol < colmin) { /* drop oldcol...colmin - 1 */`
367	`dw = boxw[0];`	367	`dw = boxw[0];`
368	`for (i = oldcol; i < colmin; i++) dw += BOXW(i);`	368	`for (i = oldcol; i < colmin; i++) dw += BOXW(i);`
369	`copyH(dw, boxw[0], oldwindowWidth - dw + 1);`	369	`copyH(dw, boxw[0], oldwindowWidth - dw + 1);`
370	`dw = oldwindowWidth - BOXW(oldcol) + 1;`	370	`dw = oldwindowWidth - BOXW(oldcol) + 1;`
371	`cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);`	371	`cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);`
372	`/* oldnwide includes the row labels */`	372	`/* oldnwide includes the row labels */`
373	`for (i = oldcol+oldnwide-1; i <= colmax; i++) drawcol(i);`	373	`for (i = oldcol+oldnwide-1; i <= colmax; i++) drawcol(i);`
374	`} else {`	374	`} else {`
375	`/* move one or more cols left */`	375	`/* move one or more cols left */`
376	`dw = BOXW(colmin);`	376	`dw = BOXW(colmin);`
377	`copyH(boxw[0], boxw[0] + dw, windowWidth - dw + 1);`	377	`copyH(boxw[0], boxw[0] + dw, windowWidth - dw + 1);`
378	`dw = windowWidth + 1;`	378	`dw = windowWidth + 1;`
379	`cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);`	379	`cleararea(dw, hwidth, WIDTH-dw, HEIGHT, p->bg);`
380	`drawcol(colmin);`	380	`drawcol(colmin);`
381	`}`	381	`}`
382	`gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,`	382	`gchangescrollbar(de, HWINSB, (colmin - 1)/xScrollbarScale,`
383	`xmaxused/xScrollbarScale,`	383	`xmaxused/xScrollbarScale,`
384	`max(nwide/xScrollbarScale, 1), 0);`	384	`max(nwide/xScrollbarScale, 1), 0);`
385	`highlightrect();`	385	`highlightrect();`
386	`}`	386	`}`
387		387
388	`/* find_coords finds the coordinates of the upper left corner of the`	388	`/* find_coords finds the coordinates of the upper left corner of the`
389	`given cell on the screen: row and col are on-screen coords */`	389	`given cell on the screen: row and col are on-screen coords */`
390		390
391	`static void find_coords(int row, int col, int xcoord, int ycoord)`	391	`static void find_coords(int row, int col, int xcoord, int ycoord)`
392	`{`	392	`{`
393	`int i, w;`	393	`int i, w;`
394	`w = bwidth;`	394	`w = bwidth;`
395	`if (col > 0) w += boxw[0];`	395	`if (col > 0) w += boxw[0];`
396	`for(i = 1; i < col; i ++) w += BOXW(i + colmin - 1);`	396	`for(i = 1; i < col; i ++) w += BOXW(i + colmin - 1);`
397	`*xcoord = w;`	397	`*xcoord = w;`
398	`ycoord = bwidth + hwidth + box_h row;`	398	`ycoord = bwidth + hwidth + box_h row;`
399	`}`	399	`}`
400		400
401	`/* draw the window with the top left box at column wcol and row wrow */`	401	`/* draw the window with the top left box at column wcol and row wrow */`
402		402
403	`static void jumpwin(int wcol, int wrow)`	403	`static void jumpwin(int wcol, int wrow)`
404	`{`	404	`{`
405	`if (wcol < 0 \|\| wrow < 0) {`	405	`if (wcol < 0 \|\| wrow < 0) {`
406	`bell();`	406	`bell();`
407	`return;`	407	`return;`
408	`}`	408	`}`
409	`closerect();`	409	`closerect();`
410	`if (colmin != wcol \|\| rowmin != wrow) {`	410	`if (colmin != wcol \|\| rowmin != wrow) {`
411	`colmin = wcol;`	411	`colmin = wcol;`
412	`rowmin = wrow;`	412	`rowmin = wrow;`
413	`deredraw();`	413	`deredraw();`
414	`} else highlightrect();`	414	`} else highlightrect();`
415	`}`	415	`}`
416		416
417	`static void advancerect(int which)`	417	`static void advancerect(int which)`
418	`{`	418	`{`
419		419
420	`/* if we are in the header, changing a name then only down is`	420	`/* if we are in the header, changing a name then only down is`
421	`allowed */`	421	`allowed */`
422	`if (crow < 1 && which != DOWN) {`	422	`if (crow < 1 && which != DOWN) {`
423	`bell();`	423	`bell();`
424	`return;`	424	`return;`
425	`}`	425	`}`
426		426
427	`closerect();`	427	`closerect();`
428		428
429	`switch (which) {`	429	`switch (which) {`
430	`case UP:`	430	`case UP:`
431	`if (crow == 1) {`	431	`if (crow == 1) {`
432	`if (rowmin == 1)`	432	`if (rowmin == 1)`
433	`bell();`	433	`bell();`
434	`else`	434	`else`
435	`jumppage(UP);`	435	`jumppage(UP);`
436	`} else`	436	`} else`
437	`crow--;`	437	`crow--;`
438	`break;`	438	`break;`
439	`case DOWN:`	439	`case DOWN:`
440	`if (crow == (nhigh - 1))`	440	`if (crow == (nhigh - 1))`
441	`jumppage(DOWN);`	441	`jumppage(DOWN);`
442	`else`	442	`else`
443	`crow++;`	443	`crow++;`
444	`break;`	444	`break;`
445	`case RIGHT:`	445	`case RIGHT:`
446	`if (ccol == (nwide - 1))`	446	`if (ccol == (nwide - 1))`
447	`jumppage(RIGHT);`	447	`jumppage(RIGHT);`
448	`else`	448	`else`
449	`ccol++;`	449	`ccol++;`
450	`break;`	450	`break;`
451	`case LEFT:`	451	`case LEFT:`
452	`if (ccol == 1) {`	452	`if (ccol == 1) {`
453	`if (colmin == 1)`	453	`if (colmin == 1)`
454	`bell();`	454	`bell();`
455	`else`	455	`else`
456	`jumppage(LEFT);`	456	`jumppage(LEFT);`
457	`} else`	457	`} else`
458	`ccol--;`	458	`ccol--;`
459	`break;`	459	`break;`
460	`default:`	460	`default:`
461	`UNIMPLEMENTED("advancerect");`	461	`UNIMPLEMENTED("advancerect");`
462	`}`	462	`}`
463		463
464	`highlightrect();`	464	`highlightrect();`
465	`}`	465	`}`
466		466
467	`static char *get_col_name(int col)`	467	`static char *get_col_name(int col)`
468	`{`	468	`{`
469	`static char clab[25];`	469	`static char clab[25];`
470	`if (col <= xmaxused) {`	470	`if (col <= xmaxused) {`
471	`/* don't use NA labels */`	471	`/* don't use NA labels */`
472	`SEXP tmp = STRING_ELT(names, col - 1);`	472	`SEXP tmp = STRING_ELT(names, col - 1);`
473	`if(tmp != NA_STRING) return(CHAR(tmp));`	473	`if(tmp != NA_STRING) return(CHAR(tmp));`
474	`}`	474	`}`
475	`sprintf(clab, "var%d", col);`	475	`sprintf(clab, "var%d", col);`
476	`return clab;`	476	`return clab;`
477	`}`	477	`}`
478		478
479	`static int get_col_width(int col)`	479	`static int get_col_width(int col)`
480	`{`	480	`{`
481	`int i, w = 0, w1, fw = FIELDWIDTH;`	481	`int i, w = 0, w1, fw = FIELDWIDTH;`
482	`char *strp;`	482	`char *strp;`
483	`SEXP tmp, lab;`	483	`SEXP tmp, lab;`
484		484
485	`if (nboxchars > 0) return nboxchars;`	485	`if (nboxchars > 0) return nboxchars;`
486	`if (col <= xmaxused) {`	486	`if (col <= xmaxused) {`
487	`tmp = VECTOR_ELT(work, col - 1);`	487	`tmp = VECTOR_ELT(work, col - 1);`
488	`if (isNull(tmp)) return fw;`	488	`if (isNull(tmp)) return fw;`
489	`/* don't use NA labels */`	489	`/* don't use NA labels */`
490	`lab = STRING_ELT(names, col - 1);`	490	`lab = STRING_ELT(names, col - 1);`
491	`if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;`	491	`if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;`
492	`PrintDefaults(R_NilValue);`	492	`PrintDefaults(R_NilValue);`
493	`for (i = 0; i < INTEGER(lens)[col - 1]; i++) {`	493	`for (i = 0; i < INTEGER(lens)[col - 1]; i++) {`
494	`strp = EncodeElement(tmp, i, 0);`	494	`strp = EncodeElement(tmp, i, 0);`
495	`w1 = strlen(strp);`	495	`w1 = strlen(strp);`
496	`if (w1 > w) w = w1;`	496	`if (w1 > w) w = w1;`
497	`}`	497	`}`
498	`if(w < 5) w = 5;`	498	`if(w < 5) w = 5;`
499	`if(w < 8) w++;`	499	`if(w < 8) w++;`
500	`if(w > 50) w = 50;`	500	`if(w > 50) w = 50;`

The R Project SVN R

(root)/trunk/src/gnuwin32/dataentry.c @ 28362 – Rev 27662 → 27686