The R Project SVN R

/*

 *  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

 */

#ifdef HAVE_CONFIG_H

#include <config.h>

#endif

#include <stdlib.h>

#include "Defn.h"

#include "Print.h"

/* don't use X11 function prototypes (which tend to ...): */

#define NeedFunctionPrototypes 0

#include <X11/X.h>

#include <X11/Xlib.h>

#include <X11/Xutil.h>

#include <X11/keysym.h>

#include <X11/cursorfont.h>

#define KeySym int

#define DEEvent XEvent

typedef enum { UP, DOWN, LEFT, RIGHT } DE_DIRECTION;

typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;

/* EXPORTS : */

SEXP RX11_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho);

/* Local Function Definitions */

static void advancerect(DE_DIRECTION);

static int  CheckControl(DEEvent*);

static int  CheckShift(DEEvent*);

static int  checkquit(int);

static void clearrect(void);

static void clearwindow(void);

static void closerect(void);

static void closewin(void);

static void copycell(void);

static void doControl(DEEvent*);

static int  doMouseDown(DEEvent*);

static void eventloop(void);

static void doSpreadKey(int, DEEvent*);

static void downlightrect(void);

static void drawwindow(void);

static void drawcol(int);

static void drawrow(int);

static void find_coords(int, int, int*, int*);

static int  findcell(void);

static char GetCharP(DEEvent*);

static KeySym GetKey(DEEvent*);

static void handlechar(char*);

static void highlightrect(void);

static Rboolean initwin(void);

static void jumppage(DE_DIRECTION);

static void jumpwin(int, int);

static void pastecell(int, int);

static void popdownmenu(void);

static void popupmenu(int, 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 RefreshKeyboardMapping(DEEvent*);

/* Functions to hide Xlib calls */

static void bell(void);

static void cleararea(int, int, int, int);

static void copyH(int, int, int);

static void copyarea(int, int, int, int);

static void doConfigure(DEEvent *ioevent);

#if 0

static void drawline(int, int, int, int);

#endif

static void drawrectangle(int, int, int, int, int, int);

static void drawtext(int, int, char*, int);

static int  NextEvent(DEEvent *ioevent);

static void RefreshKeyboardMapping(DEEvent *ioevent);

static void Rsync(void);

static int textwidth(char*, int);

static int WhichEvent(DEEvent ioevent);

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];

static int box_h;                       /* height of a box */

static int windowWidth;                 /* current width of the window */

static int fullwindowWidth;

static int windowHeight;                /* current height of the window */

static int fullwindowHeight;

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_offset;

static SEXP inputlist;  /* each element is a vector for that row */

static SEXP ssNewVector(SEXPTYPE, int);

static SEXP ssNA_STRING;

static double ssNA_REAL;

static Atom _XA_WM_PROTOCOLS, protocol;

static Rboolean newcol, CellModified;

static int nboxchars;

static int xmaxused, ymaxused;

static int box_coords[6];

static char copycontents[30] = "";

static int labdigs=4;

static char labform[6];

/* Xwindows Globals */

static Display          *iodisplay;

static Window           iowindow, menuwindow, menupanes[4];

static GC               iogc;

static XSizeHints       iohint;

static char             *font_name="9x15";

static XFontStruct      *font_info;

#define mouseDown 	ButtonPress

#define keyDown		KeyPress

#define activateEvt	MapNotify

#define updateEvt	Expose

#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), fullwindowWidth-boxw[0]-2*bwidth-2))

/*

  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 

  All row and col numbers are 1-based.

  BDR May 2003

 */

/*

   The spreadsheet function returns a list of vectors. The types of

   these vectors can be specified by the user as can their names. It

   the names are specified they are set during initialization. The

   user can change these via a menu interface, they can also change

   the type.

   The vectors are created too long and if they need to be increased

   this is done by using the next higher power of 2. They start 100

   long. To cut them to the correct length for return you need to know

   the largest row number that was assigned to. LEVELS (sxpinfo.gp) is

   used to keep track of this, separately for each vector. Vectors are

   initialized to NA when they are created so that NA is returned for

   any cell that was not set by the user.  So that coercion back and

   forth maintains values of ssNA_REAL and ssNA_STRING I have set

   ssNA_STRING to be coerceVector(ssNA_REAL), very weird but easy.

   In Macintosh we needed to call the main event loop to get

   events. This ensures that the spreadsheet interacts well with the

   other windows. Under X windows we let the window manager handle

   those sorts of details.

 */

static char *menu_label[] =

{

    "Real",

    "Character",

    "Change Name",

};

/*

   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 closewin_cend(void *data)

{

    closewin();

}

SEXP RX11_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 = 5;

    hwidth = 30;

    /* 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));

	}

    }

    /* 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 = &closewin_cend;

    cntxt.cenddata = NULL;

    highlightrect();

    eventloop();

    endcontext(&cntxt);

    closewin();

    /* 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 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) > fullwindowWidth) {

	    nwide = i;

	    windowWidth = w - dw;

	    break;

	}

    }

}

static void drawwindow(void)

{

    int i, st;

    XWindowAttributes attribs;

    /* if there is an active cell enter the data in it */

    closerect();

    /* now set up the window with the new dimensions */

    XGetWindowAttributes(iodisplay, iowindow, &attribs);

    bwidth = attribs.border_width;

    fullwindowWidth = attribs.width;

    fullwindowHeight = attribs.height;

    setcellwidths();

    nhigh = (fullwindowHeight - 2 * bwidth - hwidth) / box_h;

    windowHeight = nhigh * box_h + 2 * bwidth;

    clearwindow();

    for (i = 1; i < nhigh; i++)

	drawrectangle(0, hwidth + i * box_h, boxw[0], box_h, 1, 1);

     /* so row 0 and col 0 are reserved for labels */

    colmax = colmin + (nwide - 2);

    rowmax = rowmin + (nhigh - 2);

    printlabs();

    if (inputlist != R_NilValue)

	for (i = colmin; i <= colmax; i++) drawcol(i);

    /* draw the quit etc boxes */

    i = textwidth("Quit", 4);

    box_coords[0] = st = fullwindowWidth - 6 - bwidth;

    box_coords[1] = st - i;

    drawrectangle(st - i, 3, i + 4, hwidth - 6, 1, 1);

    drawtext(st + 2 - i, hwidth - 7, "Quit", 4);

    box_coords[4] = st = st - 5*i;

    i = textwidth("Paste", 5);

    box_coords[5] = st - i;

    drawrectangle(st - i, 3, i + 4, hwidth - 6, 1, 1);

    drawtext(st + 2 - i, hwidth - 7, "Paste", 5);

    box_coords[2] = st = st - 2*i;

    i = textwidth("Copy", 4);

    box_coords[3] = st - i;

    drawrectangle(st - i, 3, i + 4, hwidth - 6, 1, 1);

    drawtext(st + 2 - i, hwidth - 7, "Copy", 4);

    highlightrect();

    Rsync();

}

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, fullwindowWidth-dw, fullwindowHeight);

	/* 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, fullwindowWidth-dw, fullwindowHeight);

	drawcol(colmin);

    }

    highlightrect();

    Rsync();

}

/* 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;

	drawwindow();

    } else highlightrect();

}

static void advancerect(DE_DIRECTION 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;

    char *strp;

    SEXP tmp, lab;

    if (nboxchars > 0) return box_w;

    if (col <= xmaxused) {

	tmp = VECTOR_ELT(work, col - 1);

	if (isNull(tmp)) return box_w;

	/* don't use NA labels */

	lab = STRING_ELT(names, col - 1);

	if(lab != NA_STRING) strp = CHAR(lab); else strp = "var12";

	PrintDefaults(R_NilValue);

	w = textwidth(strp, strlen(strp));

	for (i = 0; i < INTEGER(lens)[col - 1]; i++) {

	    strp = EncodeElement(tmp, i, 0);

	    w1 = textwidth(strp, strlen(strp));

	    if (w1 > w) w = w1;

	}

	if(w < 0.5*box_w) w = 0.5*box_w;

	if(w < 0.8*box_w) w+= 0.1*box_w;

	if(w > 600) w = 600;

	return w+8;

    }

    return box_w;

}

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);

    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);

	}

    }

    Rsync();

}

/* 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);

    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);

    }

    Rsync();

}

/* 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);

    }

    Rsync();

}

static void jumppage(DE_DIRECTION dir)

{

    int i, w, oldcol, wcol;

    switch (dir) {

    case UP:

	rowmin--;

	rowmax--;

	copyarea(0, hwidth + box_h, 0, hwidth + 2 * box_h);

	drawrow(rowmin);

	break;

    case DOWN:

	if (rowmax >= 65535) return;

	rowmin++;

	rowmax++;

	copyarea(0, hwidth + 2 * box_h, 0, hwidth + box_h);

	drawrow(rowmax);

	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 = fullwindowWidth - 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);

    Rsync();

}

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 i, wcol = ccol + colmin - 1, wrow = rowmin + crow - 1, wrow0;

    char clab[25];

    *bufp = '\0';

    /* first check to see if anything has been entered */

    if (CellModified) {

	if (crow == 0) {

	    if (clength != 0) {

		/* then we are entering a new column name */

		if (xmaxused < wcol) {

		    /* extend work, names and lens */

		    REPROTECT(work = lengthgets(work, wcol), wpi);

		    REPROTECT(names = lengthgets(names, wcol), npi);

		    for (i = xmaxused; i < wcol - 1; i++) {

			sprintf(clab, "var%d", i + 1);

			SET_STRING_ELT(names, i, mkChar(clab));

		    }

		    REPROTECT(lens = lengthgets(lens, wcol), lpi);

		    xmaxused = wcol;

		}

		SET_STRING_ELT(names, wcol - 1, mkChar(buf));

		printstring(buf, strlen(buf), 0, wcol, 0);

	    } else {

		sprintf(buf, "var%d", ccol);

		printstring(buf, strlen(buf), 0, wcol, 0);

	    }

	} else {

	    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);

		Rboolean 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 */

	}

    }

    CellModified = FALSE;

    downlightrect();

    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 i, x_pos, y_pos, bw, bufw;

    char pbuf[201], *pc = pbuf;

    find_coords(row, col, &x_pos, &y_pos);

    if (col == 0) bw = boxw[0]; else bw = BOXW(col+colmin-1);

    cleararea(x_pos + 2, y_pos + 2, bw - 3, box_h - 3);

    bufw = (buflen > 200) ? 200 : buflen;

    strncpy(pbuf, ibuf, bufw);

    if(left) {

	for (i = bufw; i > 1; i--) {

	    if (textwidth(pc, i) < (bw - text_offset)) break;

	    *(++pc) = '<';

	}

    } else {

	for (i = bufw; i > 1; i--) {

	    if (textwidth(pbuf, i) < (bw - text_offset)) break;

	    *(pbuf + i - 2) = '>';

	}

    }

    drawtext(x_pos + text_offset, y_pos + box_h - text_offset, pc, i);

    Rsync();

}

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);

    Rsync();

}

/* 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;

        bufp = buf;

	drawelt(crow, ccol);

	return;

    } else

	CellModified = TRUE;

    if (clength == 0) {

	if (crow == 0)	                        /* variable name */

	    currentexp = 3;

	else

	    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++;