The R Project SVN R

/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 1997--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
 */

#ifndef __AQUA_DATA_ENTRY__
#define __AQUA_DATA_ENTRY__


#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#include <Defn.h>

#include <R.h>
#include <R_ext/Boolean.h>
#include <R_ext/Rdynload.h>
#include <Rdefines.h>
#include <Rinternals.h>

#include "Print.h"

#ifdef HAVE_AQUA
#define __DEBUGGING__

# include <Carbon/Carbon.h>

#include "Raqua.h"

extern RAquaPrefs CurrentPrefs;

#include <limits.h>


#ifndef kDataBrowserListViewAppendColumn
#define kDataBrowserListViewAppendColumn ULONG_MAX
#endif

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

typedef enum {UNKNOWNN, NUMERIC, CHARACTER} CellType;

/* EXPORTS : */
SEXP Raqua_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho);


static void ConfigureDataEntry(ControlRef);
static void CreateDataEntry(WindowRef, ControlRef*);
static ControlRef GetDataBrowserFromWindow(WindowRef window);
static void InstallDataEntryCallbacks(ControlRef);

static CellType get_col_type(int col);

static pascal OSStatus deGetSetItemData(ControlRef browser, 
    DataBrowserItemID itemID, DataBrowserPropertyID property, 
    DataBrowserItemDataRef itemData, Boolean changeValue);
    
static pascal void deItemNotification(
    ControlRef browser, 
    DataBrowserItemID itemID, 
    DataBrowserItemNotification message);
static pascal Boolean deItemComparison(
    ControlRef browser, DataBrowserItemID itemOneID, 
    DataBrowserItemID itemTwoID, DataBrowserPropertyID sortProperty);
static pascal void deCustomDrawProc( ControlRef browser, DataBrowserItemID item, 
        DataBrowserPropertyID property, DataBrowserItemState itemState, 
        const Rect *theRect, SInt16 gdDepth, Boolean colorDevice);
static pascal Boolean deCustomHitTestProc(ControlRef browser, DataBrowserItemID item, 
        DataBrowserPropertyID property, const Rect *theRect, const Rect *mouseRect);
static pascal Boolean deCustomEditTextProc(ControlRef browser, DataBrowserItemID item,
        DataBrowserPropertyID property, CFStringRef theString, Rect *maxEditTextRect, 
        Boolean *shrinkToFit);



pascal OSStatus deEventHandler(EventHandlerCallRef, EventRef, void*);
    
    
Boolean OpenDataEntry(void);
void CloseDataEntry(void);


Boolean isDataEntryOpen = false;
WindowRef DataEntryWindow = NULL;
ControlRef DataEntryControl = NULL;
CGContextRef        deContext;

int NumOfRows=0;
DataBrowserItemID *RowID;

static SEXP work, names, lens;
static PROTECT_INDEX wpi, npi, lpi;
static SEXP ssNA_STRING;
static double ssNA_REAL;

static SEXP ssNewVector(SEXPTYPE, int);
extern bool     DataEntryFinished;
extern void Raqua_ProcessEvents(void);

extern TXNControlTag    RReadOnlyTag[];
extern TXNControlData   RReadOnlyData[];
extern TXNObject    RConsoleInObject;

static char *get_col_name(int col);
static int xmaxused, ymaxused;


 
   

/*
  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 rows.  (It used to have 1 pre-defined numeric column.)

  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.

 */


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







Rect deBounds = { 400, 400, 600, 800 };

/*
  id : integer, id number in the browser
  isroot : boolean, this id is a root item
  iscont : boolean, is container?
  numofit : integer, number of items
  parid   : parent id number
  name   : char, name of objects
  type   : type, class or mode
  objsize: can be dim, length or number of levels 
*/

/* The following are local copies of the above */

                                /* We do not check for this */ 
void EmptyDataEntry(void);





static const EventTypeSpec  RCloseWinEvent[] = 
{
        { kEventClassWindow, kEventWindowClose }        
};

extern OSStatus DoCloseHandler( EventHandlerCallRef inCallRef, EventRef inEvent, void* inUserData );




Boolean OpenDataEntry(void)
{
    OSStatus err = noErr;
    int i,j,k;
        Rect    bounds;
        EventTypeSpec deEvents[] = {
        { kEventClassCommand,   kEventCommandProcess }, 
        { kEventClassCommand,   kEventCommandUpdateStatus }, 
        { kEventClassWindow,    kEventWindowGetIdealSize },
        { kEventClassWindow,    kEventWindowBoundsChanged }, 
        { kEventClassWindow,    kEventWindowGetClickActivation},
/*                { kEventClassMouse,   kEventMouseDown} */
        };
    
     CreateNewWindow(kDocumentWindowClass,  kWindowStandardHandlerAttribute |
            kWindowStandardDocumentAttributes, &deBounds, &DataEntryWindow);

    if(DataEntryWindow == NULL)
     return(FALSE);
     
     CreateCGContextForPort( GetWindowPort(DataEntryWindow), &deContext );
    
     InstallWindowEventHandler(DataEntryWindow, 
            NewEventHandlerUPP(deEventHandler), 
            sizeof(deEvents)/sizeof(EventTypeSpec), deEvents, NULL, NULL);
     
     InstallWindowEventHandler( DataEntryWindow, NewEventHandlerUPP(DoCloseHandler), 
                                          1,
                                          RCloseWinEvent, (void *)DataEntryWindow, NULL);
                    
 
     SetWindowTitleWithCFString(DataEntryWindow, CFSTR("R DataEntryWindow"));
     
     
    
    /* Create the DataBrowser */
     CreateDataEntry(DataEntryWindow, &DataEntryControl);
    /* Configure the DataBrowser */
    
    ConfigureDataEntry(DataEntryControl);
    err = SetDataBrowserTarget(DataEntryControl, 1);
    
    /* Set the keyboard focus */
    SetKeyboardFocus(DataEntryWindow, DataEntryControl, kControlDataBrowserPart);
    
    /* Store DB as a window property */
    SetWindowProperty(DataEntryWindow,'RMAC', 'RDEY',sizeof(DataEntryControl), &DataEntryControl);

    InstallDataEntryCallbacks(DataEntryControl);

    
    
    if(DataEntryControl == NULL){              
     CloseDataEntry();   
     return;
    }
    
     
   NumOfRows = ymaxused;    
   RowID = (DataBrowserItemID*)malloc(NumOfRows * sizeof(DataBrowserItemID));
   for(i=1;i<=NumOfRows;i++)
    RowID[i-1] = i;
    
  AddDataBrowserItems(DataEntryControl, kDataBrowserNoItem, 
                NumOfRows, RowID, kDataBrowserItemNoProperty);

 

    SetDataBrowserSelectionFlags( DataEntryControl, kDataBrowserSelectOnlyOne );
//SetAutomaticControlDragTrackingEnabledForWindow( DataEntryWindow, true ); 
    ShowWindow(DataEntryWindow);

    GetPortBounds(GetWindowPort(DataEntryWindow), &bounds);
    SizeControl(DataEntryControl, bounds.right - bounds.left, bounds.bottom - bounds.top);

}



void EmptyDataEntry(void)
{
  RemoveDataBrowserItems (DataEntryControl, kDataBrowserNoItem, 0, 
          NULL, kDataBrowserItemNoProperty);
} 

void CloseDataEntry(void)
{

    if(DataEntryWindow){
     if( GetWindowBounds(DataEntryWindow,kWindowStructureRgn,&deBounds) != noErr)
      SetRect(&deBounds, 400, 400, 600, 800);
    }
    else 
     SetRect(&deBounds, 400, 400, 600, 800);
      
    
    CGContextRelease( deContext );    
    DisposeWindow(DataEntryWindow);
    DataEntryWindow = NULL;
    
    
    DataEntryControl = NULL;
    if(RowID)
     free(RowID);
    
} 

static void CreateDataEntry(WindowRef window, ControlRef *browser)
{
    Rect bounds;
    Boolean frameAndFocus = false;
    
    /* Create a DataBrowser */
    GetWindowBounds(window, kWindowContentRgn, &bounds);

    bounds.top = bounds.left = 0;
    bounds.right = bounds.right - bounds.left;
    bounds.bottom = bounds.bottom - bounds.top;
    
    CreateDataBrowserControl(window, 
        &bounds, kDataBrowserListView, browser);

    /* Turn off DB's focus frame */
    SetControlData(
        *browser, kControlNoPart, 
        kControlDataBrowserIncludesFrameAndFocusTag,
        sizeof(frameAndFocus), &frameAndFocus);
}


static void ConfigureDataEntry(ControlRef browser)
{
    Rect insetRect;
    DataBrowserViewStyle viewStyle;
        int i;
        
    GetDataBrowserViewStyle(browser, &viewStyle);
    
    GetDataBrowserScrollBarInset(browser, &insetRect);
    
    insetRect.right = 16 - 1;
    SetDataBrowserScrollBarInset(browser, &insetRect);

    switch (viewStyle)
    {
        case kDataBrowserListView:
        {   DataBrowserListViewColumnDesc columnDesc;
            
                        columnDesc.headerBtnDesc.titleOffset = 0;
            
            columnDesc.headerBtnDesc.version = 
                kDataBrowserListViewLatestHeaderDesc;
                
            columnDesc.headerBtnDesc.btnFontStyle.flags = 
                kControlUseFontMask | kControlUseJustMask;
            
            columnDesc.headerBtnDesc.btnContentInfo.contentType = kControlNoContent;
            
                        columnDesc.headerBtnDesc.minimumWidth = 30;
            columnDesc.headerBtnDesc.maximumWidth = 200;
            
            columnDesc.headerBtnDesc.btnFontStyle.just = teFlushRight;
            
            columnDesc.headerBtnDesc.btnFontStyle.font = kControlFontViewSystemFont;
            columnDesc.headerBtnDesc.btnFontStyle.style = normal;
        
            columnDesc.propertyDesc.propertyType = kDataBrowserCustomType;
            columnDesc.propertyDesc.propertyFlags = kDataBrowserPropertyIsMutable |                                         kDataBrowserListViewDefaultColumnFlags;
            for(i=0;i<=xmaxused;i++){
                     
            columnDesc.propertyDesc.propertyID = i+2000;
            if(i>=0) columnDesc.propertyDesc.propertyType = kDataBrowserTextType;
            //columnDesc.headerBtnDesc.btnContentInfo.contentType = kControlContentIconRef;
        
                        if(i==0)
                          columnDesc.headerBtnDesc.titleString = CFStringCreateWithCString(
                CFAllocatorGetDefault(),"Row Labels", kCFStringEncodingMacRoman);
                        else
                         columnDesc.headerBtnDesc.titleString = CFStringCreateWithCString(
                CFAllocatorGetDefault(), get_col_name(i), kCFStringEncodingMacRoman);
            
            AddDataBrowserListViewColumn(browser, 
                &columnDesc, kDataBrowserListViewAppendColumn);
            
                        
            SetDataBrowserListViewDisclosureColumn(browser, columnDesc.propertyDesc.propertyID, false);
                        }
                        
                             
                                                
//          ReleaseIconRef(columnDesc.headerBtnDesc.btnContentInfo.u.iconRef);
        }   break;
    }
       }


static ControlRef GetDataBrowserFromWindow(WindowRef window)
{
    ControlRef browser = NULL;
    
    if (window != NULL)
        GetWindowProperty(window, 'RMAC', 
        'RDEY', sizeof(browser), NULL, &browser);
    
    return browser;
}


void InstallDataEntryCallbacks(ControlRef browser)
{
    DataBrowserCallbacks myCallbacks;
    DataBrowserCustomCallbacks dbCustomCallbacks;

    myCallbacks.version = kDataBrowserLatestCallbacks;
    InitDataBrowserCallbacks(&myCallbacks);
    
    myCallbacks.u.v1.itemDataCallback = 
        NewDataBrowserItemDataUPP(deGetSetItemData);
    

    myCallbacks.u.v1.itemNotificationCallback = 
        NewDataBrowserItemNotificationUPP(deItemNotification);
     
    myCallbacks.u.v1.itemCompareCallback = 
        NewDataBrowserItemCompareUPP(deItemComparison);
    
    SetDataBrowserCallbacks(browser, &myCallbacks);

    dbCustomCallbacks.version   = kDataBrowserLatestCallbacks;
    InitDataBrowserCustomCallbacks( &dbCustomCallbacks );
    dbCustomCallbacks.u.v1.drawItemCallback = NewDataBrowserDrawItemUPP( deCustomDrawProc );
    dbCustomCallbacks.u.v1.hitTestCallback = NewDataBrowserHitTestUPP( deCustomHitTestProc );
    dbCustomCallbacks.u.v1.editTextCallback = NewDataBrowserEditItemUPP( deCustomEditTextProc );
    
    SetDataBrowserCustomCallbacks(browser, &dbCustomCallbacks);

}





void printelt(SEXP invec, int vrow, char *str);


static pascal OSStatus deGetSetItemData(ControlRef browser, 
    DataBrowserItemID itemID, DataBrowserPropertyID property, 
    DataBrowserItemDataRef itemData, Boolean changeValue)
{
#pragma unused (browser)
    Str255 pascalString;
    OSStatus err = noErr;
        CFStringRef text,value;
    SEXP tmp;
        int i,col,row=-1;
        char buf[1000];

      if(property>=2000 & property<10000){
          col = property-2000;
          row = itemID;
         }

        if(!changeValue) {
       
       
         if(property==2000){
             sprintf(buf,"%d",row);
             CopyCStringToPascal(buf,pascalString);
             text = CFStringCreateWithPascalString(CFAllocatorGetDefault(), pascalString, kCFStringEncodingMacRoman);
             err = SetDataBrowserItemDataText(itemData, text); 
             CFRelease(text); 
         }
         
         if(property>2000 & row>0 & row<=ymaxused){          
          tmp = VECTOR_ELT(work, col-1);
          if (!isNull(tmp)) {
             strcpy(buf,"     ");
             if(LENGTH(tmp)>row-1)
              printelt(tmp, row-1, buf);
             } 
             CopyCStringToPascal(buf,pascalString);
             text = CFStringCreateWithPascalString(CFAllocatorGetDefault(), pascalString, kCFStringEncodingMacRoman);
             err = SetDataBrowserItemDataText(itemData, text); 
             CFRelease(text); 
                       
     
        }   
        switch (property)
    {
        case kDataBrowserItemIsEditableProperty:
        {   err = SetDataBrowserItemDataBooleanValue(itemData, true);
        }   break;
        
        

        default:
        {   err = errDataBrowserPropertyNotSupported;
        }   break;
    }
    }
    else {
        
          if(property>2000 & row>0 & row<=ymaxused){          
            err = GetDataBrowserItemDataText(itemData, &text); 
            CFStringGetCString (text, buf, 1000,  kCFStringEncodingMacRoman);
            if(strlen(buf)>0){
                tmp = VECTOR_ELT(work, col-1);
                    if(get_col_type(col) == CHARACTER)
                        SET_STRING_ELT(tmp, row-1, mkChar(buf));
                    else {
                        char *endp;
                        double new = R_strtod(buf, &endp);
                        if(isBlankString(endp))
                            REAL(tmp)[row - 1] = new;
                    }
             } else { 
                if(get_col_type(col) == CHARACTER)
                    SET_STRING_ELT(tmp, row - 1, NA_STRING);
                else
                    REAL(tmp)[row - 1] = NA_REAL;
            }
        SetWindowModified(DataEntryWindow, true);
            CFRelease(text); 
          }             
     


    }
        
    return err;
}
 
 
void printelt(SEXP invec, int vrow, char *strp)
{

    if(!strp)
     return;
     
     
    PrintDefaults(R_NilValue);
    if (TYPEOF(invec) == REALSXP) {
    if (REAL(invec)[vrow] != ssNA_REAL) {
        strcpy(strp, EncodeElement(invec, vrow, 0));
        return;
    }
    }
    else if (TYPEOF(invec) == STRSXP) {
    if(CHAR(STRING_ELT(invec, vrow))){
    if (!streql(CHAR(STRING_ELT(invec, vrow)),
            CHAR(STRING_ELT(ssNA_STRING, 0)))) {
        strcpy(strp, EncodeElement(invec, vrow, 0));
        return;
    }
    }
    }
    else
    error("dataentry: internal memory error");
}

  
 static pascal void deItemNotification(
    ControlRef browser, 
    DataBrowserItemID itemID, 
    DataBrowserItemNotification message)
{
    UInt32 i;
    UInt32 numSelectedItems;
    UInt16 j;
        OSStatus err;
        DataBrowserItemID tempid;
         CFMutableStringRef text;
         char buf[1000];
        
    switch (message)
    {
        case kDataBrowserItemSelected:
        {   Handle handle = NewHandle(0);
            GetDataBrowserItems(browser, 
                kDataBrowserNoItem, true, kDataBrowserItemIsSelected, handle);
            numSelectedItems = GetHandleSize(handle)/sizeof(DataBrowserItemID);
              // fprintf(stderr,"\n notif. id=%d",itemID);       
                }   
                break;
                
          
    }
}

Boolean MouseClicked = false;

pascal OSStatus deEventHandler(
    EventHandlerCallRef a, EventRef inEvent, void*b)
{
    OSStatus result = noErr;
    EventRef    REvent;
                            
    switch (GetEventClass(inEvent))
    {
        default:
        {   result = eventNotHandledErr;
        }   break;
        

        
        case kEventClassMouse:
             if( GetEventKind(inEvent) == kEventMouseDown){
             if(!MouseClicked){
              MouseClicked = true;
              result = eventNotHandledErr;
             } 
             
             
             }
            break;
            
            case kEventClassWindow:
        {
            WindowRef window = NULL;
            GetEventParameter(inEvent, 
                kEventParamDirectObject, typeWindowRef, 
                NULL, sizeof(window), NULL, &window);

            switch (GetEventKind(inEvent))
            {
                default:
                {   result = eventNotHandledErr;
                }   break;
                
                
                        case kEventWindowBoundsChanged:
                {   ControlRef browser = GetDataBrowserFromWindow(window);
                    Rect bounds; GetPortBounds(GetWindowPort(window), &bounds);
                    SizeControl(browser, bounds.right - bounds.left, bounds.bottom - bounds.top);
                }   break;
                
                            
                 
            }
        }   break;
    }
       
    return result;
}

SEXP Raqua_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 */

    ssNA_REAL = -NA_REAL;
    tvec = allocVector(REALSXP, 1);
    REAL(tvec)[0] = ssNA_REAL;
    PROTECT(ssNA_STRING = coerceVector(tvec, STRSXP)); nprotect++;
    
    /* 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 */
   
    TXNSetTXNObjectControls(RConsoleInObject, false, 1, RReadOnlyTag, RReadOnlyData);
    DataEntryFinished = false;
    OpenDataEntry();
    while(!DataEntryFinished)
        Raqua_ProcessEvents();
    
    /* 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;
}




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





static pascal Boolean deItemComparison(
    ControlRef browser, DataBrowserItemID itemOneID, 
    DataBrowserItemID itemTwoID, DataBrowserPropertyID property)
{
    SInt16 compareResult = 0;
    char buf1[500], buf2[500];
    SEXP tmp;
        int row;
        
        row = max(itemOneID,itemTwoID);
     #define Compare(i1,i2,p) deItemComparison(browser,i1,i2,p)
     if(property>2000 & property<3000 & row>0 & row<=ymaxused){
            tmp = VECTOR_ELT(work, property-2000-1);
            if (!isNull(tmp)) {
                strcpy(buf1," ");
                strcpy(buf2," ");
                if(LENGTH(tmp)>itemOneID-1)
                    printelt(tmp, itemOneID-1, buf1);
                 if(LENGTH(tmp)>itemTwoID-1)
                    printelt(tmp, itemTwoID-1, buf2);
           
                if(get_col_type(property-2000) == CHARACTER)
                        compareResult = strcmp(buf1,buf2);
                    else {
                        char *endp1,*endp2;
                        double new1 = R_strtod(buf1, &endp1);
                        double new2 = R_strtod(buf2, &endp2);
                        if(isBlankString(endp1) & isBlankString(endp2))
                            if(new1 < new2) compareResult = -1;
                            else if(new1>new2) compareResult = 1;
                         }
                
                if (compareResult < 0) return true;
            else if (compareResult > 0) return false;
            else return Compare(itemOneID, itemTwoID, '????');
                }
        }
            
       
        return itemOneID < itemTwoID;      

                
}


struct WindowinfoStruct
{
    OSType          windowidentifier;
    CGContextRef        cgContext;
};
typedef struct WindowinfoStruct WindowinfoStruct;

DataBrowserItemID LastSelItem = 0;
DataBrowserPropertyID LastSelProp = 0;

static pascal void deCustomDrawProc( ControlRef browser, DataBrowserItemID item, DataBrowserPropertyID property, DataBrowserItemState itemState, const Rect *theRect, SInt16 gdDepth, Boolean colorDevice)
{
        CFStringRef text;
        RGBColor    fg = CurrentPrefs.FGOutputColor;
        RGBColor    bg = CurrentPrefs.BGOutputColor;        
    Str255 pascalString;
    SEXP tmp;
        int i,col,row=-1;
        char buf[1000];
        

       if(property>=2000 & property<10000){
          col = property-2000;
          row = item;
       }
    
       if(property==2000)
               text = CFStringCreateWithFormat( NULL, NULL, CFSTR("%d"), row );
       
//fprintf(stderr,"\n prop=%d, id=%d",property, item);
       if(property>2000 & row>0 & row<=ymaxused){          
          tmp = VECTOR_ELT(work, col-1);
          if (!isNull(tmp)) {
             strcpy(buf,"     ");
             if(LENGTH(tmp)>row-1)
              printelt(tmp, row-1, buf);
             } 
             CopyCStringToPascal(buf,pascalString);
             text = CFStringCreateWithPascalString(CFAllocatorGetDefault(), pascalString, kCFStringEncodingMacRoman);
        }   
//         fprintf(stderr,"\n it=%d, lastit=%d, pro=%d, lastpro=%d",item, LastSelItem, property, LastSelProp);
if( (property == LastSelProp) && (item == LastSelItem)){
//  if( (itemState == kDataBrowserItemIsSelected)  ){
           bg = CurrentPrefs.BGInputColor;
           fg = CurrentPrefs.FGInputColor;
    } 

        RGBForeColor( &bg );
        PaintRect( theRect );   //  First paint the hilite rect, then the text on top

        RGBForeColor( &fg );
    DrawThemeTextBox( text, kThemeApplicationFont, kThemeStateActive, true, theRect, teFlushRight, NULL );      
    if(text)
         CFRelease(text);
         
         if( (property == LastSelProp) && (item == LastSelItem))
          SetDataBrowserEditItem(browser,item,property);
         
  //     if(property!=1000)
  //       fprintf(stderr,"\nbuf=%s prop=%d, id=%d, top=%d, left=%d, bottom=%d, right=%d", buf, property, item, theRect->top, theRect->left, theRect->bottom, theRect->right);
}



static pascal Boolean deCustomHitTestProc(ControlRef browser, DataBrowserItemID item, DataBrowserPropertyID property,
const Rect *theRect, const Rect *mouseRect){

if(!MouseClicked)
 return(false);
if(  (theRect->top <= mouseRect->top) && (theRect->left <= mouseRect->left) && (theRect->bottom >= mouseRect->bottom) && (theRect->right >=mouseRect->right)) {
 //fprintf(stderr,"\n (dentro) prop=%d item=%d, moouse=%d",property,item,MouseClicked);
 SetDataBrowserSelectedItems (browser,1,&item,kDataBrowserItemsAssign);
 LastSelItem = item;
 LastSelProp = property;
 MouseClicked = false;
 return(true);
 }
else
 return(false);

}


static pascal Boolean deCustomEditTextProc(ControlRef browser, DataBrowserItemID item,
DataBrowserPropertyID property, CFStringRef theString, Rect *maxEditTextRect, Boolean *shrinkToFit){
char buf[200];

 theString = CFStringCreateWithFormat( NULL, NULL, CFSTR("%s"), "ciao" );
//if( CFStringGetCString (theString, buf, 150,  kCFStringEncodingMacRoman) == noErr)
// fprintf(stderr,"\n string=%s",buf);
//else
fprintf(stderr,"\n no string"); 

return(true);
}




#endif  /* HAVE_AQUA */

#endif /* __AQUA_DATA_ENTRY__ */