The R Project SVN R

/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1998--1999  Tiki Wan, Ross Ihaka
 *
 *  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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 *  SYSTEM DEPENDENT CODE
 *
 *  This source file contains the platform dependent code for
 *  the Macintosh port of R.
 *
 *  The first group of functions is concerned with reading and
 *  writing to the system console.
 *
 *    int   R_ReadConsole(char *prompt, char *buf, int buflen, int hist)
 *
 *  This function prints the given prompt at the console and then
 *  does a gets(3)-like operation, transfering up to "buflen" characters
 *  into the buffer "buf".  The last two characters are set to "\n\0"
 *  to preserve sanity.  If "hist" is non-zero, then the line is added
 *  to any command history which is being maintained.  Note that this
 *  is one natural place from which to run an event loop.
 *
 *    void  R_WriteConsole(char *buf, int buflen)
 *
 *  This function writes the given buffer out to the console.  No
 *  special actions are required.  Under Unix the characters are
 *  just appended to stdout.
 *
 *    void  R_ResetConsole(void)
 *
 *  This function is called when the system is reset after an error.
 *  It probably isn't really needed.
 *
 *    void  R_FlushConsole(void)
 *
 *  This called to flush any output to the system console.  Under Unix
 *  this is just fflush(stdout).  Other systems may not need this.
 *
 *    void  R_ClearerrConsole(void)
 *
 *  This function clears any errors associated with reading from the
 *  console.  In Unix is is used to clear any EOF condition associated
 *  with stdin.
 *
 *    void  R_Suicide(char *msg)
 *
 *  This function displays the given message and the causes R to
 *  die immediately.  It is used for non-recoverable errors such as
 *  not having enough memory to launch etc.  The phrase "dialog box"
 *  springs to mind for non-unix platforms.
 *
 *    void  R_Busy(int which)
 *
 *  This function invokes actions (such as change of cursor) when
 *  R embarks on an extended computation (which=1) and when such a
 *  state terminates (which=0).
 *
 *    void  R_CleanUp(int ask)
 *
 *  This function invokes any actions which occur at system termination.
 *
 *    char* R_ExpandFileName(char *s)
 *
 *  This is a utility function which can be used to expand special
 *  characters in file names.  In Unix it's sole function is to expand
 *  and "~"s which occur in filenames (and then only when the readline
 *  library is available.  The minimal action is to return the argument
 *  unaltered.
 *
 *    void  R_InitialData(void)
 *    FILE* R_OpenInitFile(void)
 *    FILE* R_OpenLibraryFile(char *file)
 *    FILE* R_OpenSysInitFile(void)
 *
 *  The following two functions save and restore the user's global
 *  environment.  The system specific aspect of this what files
 *  are used for this.
 *
 *    void  R_RestoreGlobalEnv(void)
 *    void  R_SaveGlobalEnv(void)
 *
 *  Platform dependent functions.
 *
 *    SEXP  do_interactive(SEXP call, SEXP op, SEXP args, SEXP rho)
 *    SEXP  do_machine(SEXP call, SEXP op, SEXP args, SEXP rho)
 *    SEXP  do_proctime(SEXP call, SEXP op, SEXP args, SEXP rho)
 *    SEXP  do_quit(SEXP call, SEXP op, SEXP args, SEXP rho)
 *    SEXP  do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
 */

 

#include "Defn.h"
#include "Fileio.h"
#include "Graphics.h"
#include "RIntf.h"
#include "RFLaunch.h"
#include "TFLaunch.h"

#include "Defn.h" // Jago

#ifdef macintosh // Jago
 int     pclose(FILE *fp); 
 int pclose(FILE *fp){
  return(fclose(fp));
  }
#endif

void R_Suicide(char *s);


#include <unistd.h>
#include <errno.h>
//extern int errno;

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <time.h>
#include <unix.h>
#include <Files.h>
#include <Folders.h>

#include "pathname.h"
#include "helpers.h"

typedef struct _EnviromentPair {
    char *key;
    char *value;
} EnviromentPair;

FILE * FSp_fopen(ConstFSSpecPtr spec, const char * open_mode);
char *load_entry(FILE *file);
EnviromentPair *ParseLine(char *line);


//#include "devMacintosh.h"

static int DefaultSaveAction = 0;
static int DefaultRestoreAction = 1;

SA_TYPE SaveAction = SA_SAVEASK;
SA_TYPE RestoreAction = SA_RESTORE;
Rboolean UsingReadline = TRUE;
Rboolean LoadSiteFile = TRUE;
Rboolean LoadInitFile = TRUE;
Rboolean DebugInitFile = FALSE;

    /*--- I/O Support Code ---*/

    /* These routines provide hooks for supporting console I/O.
     * Under raw Unix these routines simply provide a
     * connection to the stdio library.
     * Under a Motif interface the routines would be
     * considerably more complex.
     */

long                   start_Time, last_Time;
SInt16                 gAppResFileRefNum;
char                   testBuf[ALLOW_INPUT_LENGTH];
extern WindowPtr       gWindowPtrArray[kMaxWindows + 2];
extern void            doGetPreferences(void);

extern char    InitFile[256];
extern WindowPtr Console_Window;
extern SInt16  gTextSize;
void  R_doErrorAlert(Str255 labelText);
void  StrToStr255(char* sourceText, Str255 targetText);
void R_ShowMessage(char *);


extern void R_Edit(char** lines, int nlines);
extern void main_1 ( void );
    /* Fill a text buffer with user typed console input. */
//extern void R_WriteConsole1(Ptr buf, SInt32 buflen);
//extern void R_ReadConsole1(char*, char*, int, int);
//extern void RWrite(char*);
//extern void DRWrite(long);


char *mac_getenv(const char *name);

void R_setStartTime(void);

int R_ReadConsole(char *prompt, unsigned char *buf, int len, int addtohistory)
{
  /* Fill a text buffer with user typed console input. */

  char buffo[1000];
   
  R_ReadConsole1(prompt, buf, len, addtohistory); 

  buf[strlen(buf)-1] = '\n';
  buf[strlen(buf)] = '\0';

  return 1;
}

    /* Write a text buffer to the console. */
    /* All system output is filtered through this routine. */

void R_WriteConsole(char *buf, int len)
{
  R_WriteConsole1(buf, len);
}


    /* Indicate that input is coming from the console */
    /* No longer used ??? */

void R_ResetConsole()
{
}

    /* Make sure that pending output is flushed */
    /* Unneeded for the Macintosh */

void R_FlushConsole()
{
}


    /* Clear Console EOF */
    /* Unneeded for the Macintosh */

void R_ClearerrConsole()
{
}


    /*--- File Handling Code ---*/


    /* Tab induced filename expansion */
    /* Unimplemented for the Macintosh */

char    *R_ExpandFileName(char *s)
{
    /* return the string unmodified */
    return s;
}


    /* RHOME is the Folder where the R binary resides */

FILE *R_OpenLibraryFile(char *file)
{
    /* This code finds where the R application was invoked */
    /* and descends from there to "library:base:R and opens */
    /* the specified file within that directory.  It returns */
    /* the resulting file pointer. */
    return R_OpenLibraryFile1(file);
    /* ... */
}

FILE *R_OpenSysInitFile(void)
{
    /* This code finds where the R application was invoked */
    /* and descends from there to the folder "library:base:R" */
    /* and opens the file "Rprofile" within that directory. */
    /* It returns the resulting file pointer. */
   
    return R_OpenSysInitFile1();
}

FILE *R_OpenSiteFile(void)
{
    /* This code finds where the R application was invoked */
    /* and descends from there to the folder "etc" and opens */
    /* the file "Rprofile" within that directory.  It returns */
    /* the resulting file pointer. */
}

FILE *R_OpenInitFile(void)
{
    /* This code attempts to open the file ".Rprofile" in the */
    /* current folder and returns the resulting file pointer. */
    /* Does thos make sense on the Mac.  Probably not. */
    return NULL;
}

#define MAC_FILE_SIZE FILENAME_MAX

static char R_HomeLocation[MAC_FILE_SIZE];

void GetHomeLocation(void);

void GetHomeLocation(void)
{
    getcwd(R_HomeLocation,MAC_FILE_SIZE); 
    R_HomeLocation[strlen(R_HomeLocation)-1]='\0';
}

char *R_HomeDir()
{
    return R_HomeLocation;
}

Rboolean R_HiddenFile(char *filename)
{
    int len = strlen(filename);
    if (filename[len - 1] == '\r')
        return 1;
  else
    return 0;
}
    /*--- Initialization Code ---*/

    /* NOTE: The timing code below will have to be adpated */
    /* to use the macintosh specific timing code. */

#include <sioux.h>

int Mac_initialize_R(int ac, char **av);

int main(int ac, char **av)
{
    int value;
    char *p;
    SInt16 a;
    gc_inhibit_torture = 1;
    

    SIOUXSettings.standalone = false;  // I only use SIOUX to have command line
    SIOUXSettings.setupmenus = false;  // I'll set up the menus
    SIOUXSettings.initializeTB = false;  // I manage the ToolBox
    
    ac = ccommand(&av);  // This must be the first  command after variables initializations !!!
    
    /* FIXME HERE: record the time at which the program started. */
    /* This is probably zero on the mac as we have direct */
    /* access to the number of ticks since process start */

    /* ... */

    /* FIXME HERE: Command line options are not available. */
    /* Application resources must be inspected here */
    /* and used to modify the compiled-in defaults. */
    /* Compare with the Unix code. */

    /* ... */

    /* Set up the file handling defaults. */

    R_Quiet = 0;
    R_Interactive = 1;      /* On the Mac we must be interactive */
//    R_Consolefile = NULL; /* We don't use a file for console input. */
//    R_Outputfile = NULL;  /* We don't use a file for console output. */
//    R_Sinkfile = NULL;        /* We begin writing to the console. */

   
 
//  R_HistoryFile = ".Rhistory";
    

    /* ... */

    /* Call the real R main program (in ../main/main.c) */
    
    
//    start_Time = last_Time = TickCount();


/* *** */    
    Mac_initialize_R ( ac, av );
    
/* *** */

    changeSize(Console_Window, gTextSize);
     
    mainloop();
   
    return 0;
}

int Mac_initialize_R(int ac, char **av)
{
    int i, ioff = 1, j, value, ierr;
    char *p, msg[1024], **avv;
    structRstart rstart;
    Rstart Rp = &rstart;

    if ( Initialize() == noErr ){
     
       gAppResFileRefNum = CurResFile();
       doGetPreferences();
       
       for(i=0;i<kMaxWindows+2;i++)
           gWindowPtrArray[i] = NULL;
     }
     else
      return(1);

    GetHomeLocation();
    
    if((R_Home = R_HomeDir()) == NULL)
    R_Suicide("R home directory is not defined");

//    process_global_Renviron();

#ifdef HAVE_TIMES
    R_setStartTime();
#endif
    R_DefParams(Rp);

    /* Store the command line arguments before they are processed
       by the R option handler. These are stored in Rp and then moved
       to the global variable CommandLineArgs in R_SetParams.
     */

    R_set_command_line_arguments(ac, av, Rp);

    /* first task is to select the GUI */
/*
    for(i = 0, avv = av; i < ac; i++, avv++) {
    if(!strncmp(*avv, "--gui", 5) || !strncmp(*avv, "-g", 2)) {
        if(!strncmp(*avv, "--gui", 5) && strlen(*avv) >= 7)
        p = &(*avv)[6];
        else {
        if(i+1 < ac) {
            avv++; p = *avv; ioff++;
        } else {
            sprintf(msg, "WARNING: --gui or -g without value ignored");
            R_ShowMessage(msg);
            p = "X11";
        }
        }
        if(!strcmp(p, "none"))
        useX11 = FALSE;
        else if(!strcmp(p, "gnome") || !strcmp(p, "GNOME"))
        usegnome = TRUE;
        else if(!strcmp(p, "X11") || !strcmp(p, "x11"))
        useX11 = TRUE;
        else {

        // now remove it/them 
        for(j = i; j < ac-ioff; j++) {
        av[j] = av[j + ioff];
        }
        ac -= ioff;
        break;
    }
    }
*/


    R_common_command_line(&ac, av, Rp);


    while (--ac) {
    if (**++av == '-') {
        if(!strcmp(*av, "--no-readline")) {
        UsingReadline = 0;
        } else {
        sprintf(msg, "WARNING: unknown option %s\n", *av);
        R_ShowMessage(msg);
        }
    } else {
        sprintf(msg, "ARGUMENT '%s' __ignored__\n", *av);
        R_ShowMessage(msg);
    }
    }
    R_SetParams(Rp);
    
   
    if(!Rp->NoRenviron) process_users_Renviron();
 
    /* On Unix the console is a file; we just use stdio to write on it */

    R_Interactive = isatty(0);

    R_Consolefile = NULL;   /* We don't use a file for console input. */
    R_Outputfile = NULL;    /* We don't use a file for console output. */
    R_Sinkfile = NULL;      /* We begin writing to the console. */

/*
 *  Since users' expectations for save/no-save will differ, we decided
 *  that they should be forced to specify in the non-interactive case.
 */
    if (!R_Interactive && SaveAction != SA_SAVE && SaveAction != SA_NOSAVE)
    R_Suicide("you must specify `--save', `--no-save' or `--vanilla'");

    if ((R_HistoryFile = getenv("R_HISTFILE")) == NULL)
     R_HistoryFile = ":etc:.Rhistory";
     
    R_HistorySize = 512;
    if ((p = getenv("R_HISTSIZE"))) {
    value = Decode2Long(p, &ierr);
    if (ierr != 0 || value < 0)
        REprintf("WARNING: invalid R_HISTSIZE ignored;");
    else
        R_HistorySize = value;
    }


 if (R_RestoreHistory)
    mac_loadhistory(R_HistoryFile);

    return(0);
}




void R_InitialData(void)
{
    R_RestoreGlobalEnv();
}

    /* R_CleanUp is invoked at the end of the session to give */
    /* the user the option of saving their data.  If ask=1 the */
    /* user is asked their preference, if ask=2 the answer is */
    /* assumed to be "no" and if ask=3 the answer is assumed to */
    /* be "yes".  When R is being used non-interactively, and */
    /* ask=1, the value is changed to 3.  The philosophy is */
    /* that saving unwanted data is less bad than non saving */
    /* data that is wanted. */
extern void MacFinalCleanup(void);

void R_CleanUp(SA_TYPE saveact, int status, int runLast)
{
    unsigned char buf[128];

    if(saveact == SA_DEFAULT) /* The normal case apart from R_Suicide */
    saveact = SaveAction;

    if(saveact == SA_SAVEASK) {
    if(R_Interactive) {
    qask:
        R_ClearerrConsole();
        R_FlushConsole();
        R_ReadConsole("Save workspace image? [y/n/c]: ", 
              buf, 128, 0);
        switch (buf[0]) {
        case 'y':
        case 'Y':
        saveact = SA_SAVE;
        break;
        case 'n':
        case 'N':
        saveact = SA_NOSAVE;
        break;
        case 'c':
        case 'C':
        jump_to_toplevel();
        break;
        default:
        goto qask;
        }
    } else
        saveact = SaveAction;
    }
    switch (saveact) {
    case SA_SAVE:
    if(runLast) R_dot_Last();

    if(R_DirtyImage) R_SaveGlobalEnv();

    if(R_Interactive) 
     mac_savehistory(R_HistoryFile);

    break;
    case SA_NOSAVE:
    if(runLast) R_dot_Last();

    break;
    case SA_SUICIDE:
    default:
        break;
    }
    
    
    KillAllDevices();
    if(saveact != SA_SUICIDE && R_CollectWarnings)
    PrintWarnings();    /* from device close and .Last */

    MacFinalCleanup();

    exit(status);

}

void R_Busy(int which)
{
    /* This can be used to gray out menus and change the */
    /* cursor (to a watch or equivalent) to indicate that an */
    /* extended computation is taking place. */
}


void R_SaveGlobalEnv(void)
{
  OSErr err;
  Boolean haveCancel;

  err = doRSave(&haveCancel);
//  err = doRSaveAs(&haveCancel);
  if (haveCancel){
      jump_to_toplevel();
  }
}


void R_RestoreGlobalEnv(void)
{
    FILE *fp;
    SEXP img, lst;
    int i;
//    int RestoreAction = SA_RESTORE;

    if(RestoreAction == SA_RESTORE) {
    if(!(fp = R_fopen(":etc:.RData", "rb"))) { /* binary file */
        /* warning here perhaps */
        return;
    }
#ifdef OLD
    FRAME(R_GlobalEnv) = R_LoadFromFile(fp, 1);
#else
    PROTECT(img = R_LoadFromFile(fp, 1));
    switch (TYPEOF(img)) {
    case LISTSXP:
        while (img != R_NilValue) {
        defineVar(TAG(img), CAR(img), R_GlobalEnv);
        img = CDR(img);
        }
        break;
    case VECSXP:
        for (i = 0; i < LENGTH(img); i++) {
//      lst = VECTOR(img)[i];
        lst = VECTOR_ELT(img,i);
        while (lst != R_NilValue) {
            defineVar(TAG(lst), CAR(lst), R_GlobalEnv);
            lst = CDR(lst);
        }
        }
        break;
    }
        UNPROTECT(1);
#endif
    if(!R_Quiet)
        Rprintf("[Previously saved workspace restored]\n\n");
        fclose(fp);
    }
}


    /*--- Platform Dependent Functions ---*/
#ifdef HAVE_TIMES
#include <time.h>

static clock_t StartTime;

void R_setStartTime(void)
{
    StartTime = clock(); // ticks from system boot
}

void R_getProcTime(double *data)
{
    double elapsed;
    elapsed = (clock() - StartTime) / (double)CLOCKS_PER_SEC;
    data[0] = R_NaReal; // we have no total user time
    data[1] = clock() / (double)CLOCKS_PER_SEC; // Real total system time
    data[2] = elapsed; // process system time
    data[3] = R_NaReal; // we don't have this under MacOS
    data[4] = R_NaReal; // as above
}

double R_getClockIncrement(void)
{
  return 1.0 / (double) CLOCKS_PER_SEC;
}

SEXP do_proctime(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP ans = allocVector(REALSXP, 5);
    R_getProcTime(REAL(ans));
    return ans;
}
#endif /* HAVE_TIMES */



static char CompleteEnvPath[NAME_MAX];

/* getenv() doesn't exists on Macintosh. We can only extract some
   information from the System when available. For the time beeing
   we only check for the TimeZone string.
   Stefano M. Iacus Gen 01
*/
   
   
   
   
SEXP do_getenv(SEXP call, SEXP op, SEXP args, SEXP env)
{
    int i, j;
    char *s = NULL;
    SEXP ans;
    FILE *fp;
    EnviromentPair *Env1;
    FSSpec spec;
    OSErr err;
    char env_buff[1000];
    char temp_path[NAME_MAX];
    
    checkArity(op, args);

    if (!isString(CAR(args)))
    errorcall(call, "wrong type for argument");

    i = LENGTH(CAR(args));
    if (i == 0) {
    
    sprintf(temp_path,"%s:%s",R_Home,"etc:.Renviron");

    GetCompletePath(CompleteEnvPath,temp_path,&spec,&err);

/* try open the file in the current folder */
    fp = FSp_fopen(&spec,"r");
    if (fp == NULL)
      { /* Okey, lets try open the file in the preference folder */
        FSpFindFolder_Name(
                   kOnSystemDisk,
                   kPreferencesFolderType,
                   kDontCreateFolder,
                   &spec,
                   "\p.Renviron");
    
    fp = FSp_fopen(&spec,"r");
    if (fp == NULL)
        {
        errorcall(call,"There is no environment file");
        return R_NilValue; /* there is no enviroment-file */
        }
    }

    s = load_entry(fp);
    while (s != NULL)
    {   /* parse the file line by line */
     Env1 = ParseLine(s);
     if (strlen(Env1->value) > 0) 
       i++;
     s = load_entry(fp);  /* read next line */
    }
    if(i==0) {
     fclose(fp);
     errorcall(call,"The environment file is empty");
     return R_NilValue;
     }
    
    PROTECT(ans = allocVector(STRSXP, i));
    
    i=0;
    fseek(fp,0,0);
    
    s = load_entry(fp);
    
    while (s != NULL)
    {   /* parse the file line by line */
    Env1 = ParseLine(s);
    if (strlen(Env1->value) > 0)
        {       /* we found a key/value pair */
           sprintf(env_buff,"%s=%s",Env1->key,Env1->value);
           SET_STRING_ELT(ans, i, mkChar(env_buff));
           i++;
        }
    s = load_entry(fp);  /* read next line */
    }
   fclose(fp);
    } else {
    PROTECT(ans = allocVector(STRSXP, i));
    for (j = 0; j < i; j++) {
        s = mac_getenv(CHAR(STRING_ELT(CAR(args), j)));
        if (s == NULL)
        SET_STRING_ELT(ans, j, mkChar(""));
        else
        SET_STRING_ELT(ans, j, mkChar(s));
    }
    }
    UNPROTECT(1);
    return (ans);
}



SEXP do_machine(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return mkString("Macintosh");
}

SEXP do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    errorcall(call, "\n The function \"system\" is not implemented on Macintosh\n");
    return R_NilValue;
}

/*
SEXP do_commandArgs(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    errorcall(call, "\n The function \"commandArgs\" is not implemented on Macintosh\n");
    return R_NilValue;
} // Jago
*/


/* 
   Rmac_tmpnam is a version of Runix_tmpnam for Macintosh. It assumes
   that the directory "tmp" exists in the same directory where the
   R application resides if not, it attemps to create it. 
   (Stefano M. Iacus) Jago Nov-00, implemented pre-alpha 3
*/
   
#define MAC_SIZE FILENAME_MAX
#define MAC_READ_OR_WRITE   0x0 /* fake a UNIX mode */
   
static char * Rmac_tmpnam(char * prefix)
{
    char *tmp, tm[PATH_MAX], tmp1[PATH_MAX], *res;
    char curFolder[MAC_SIZE], newFolder[MAC_SIZE];
    unsigned int n, done = 0, pid;

    getcwd( curFolder, MAC_SIZE );
    
    
    if( chdir(":tmp") ) 
    {
     sprintf(newFolder,"%s%s", curFolder, "tmp" );
     if( mkdir(newFolder, MAC_READ_OR_WRITE ) == -1 )
      error("Failed to create temporary folder");       
    }
    
    
    chdir( curFolder );     
    
    strcpy(tmp1, ":tmp");
    pid = (unsigned int) getpid();
    for (n = 0; n < 100; n++) {
    /* try a random number at the end */
        sprintf(tm, "%s:%sR%xS%x", tmp1, prefix, pid, rand());
        if (!R_FileExists(tm)) { done = 1; break; }
    }
    if(!done)
    error("cannot find unused tempfile name");
    res = (char *) malloc((strlen(tm)+1) * sizeof(char));
    strcpy(res, tm);
    return res;
}


/*
   do_tempfile it is just as under unix. No changes other then
   Rmac_tmpnam() instead of the Unix Runix_tmpnam();
   (Stefano M. Iacus) Jago Nov-00, implemented pre-alpha 3
*/


SEXP do_tempfile(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP  ans;
    char *tn, *tm;
    int i, slen=0 /* -Wall */;

    checkArity(op, args);
    if (!isString(CAR(args)) || (slen = LENGTH(CAR(args))) < 1)
    errorcall(call, "invalid file name argument");
    PROTECT(ans = allocVector(STRSXP, slen));
    for(i = 0; i < slen; i++) {
//  tn = CHAR( STRING( CAR(args) )[i] );
    tn = CHAR( STRING_ELT( CAR(args) ,i ) );
    /* try to get a new file name */
    tm = Rmac_tmpnam(tn);
//  STRING(ans)[i] = mkChar(tm);
    SET_STRING_ELT( ans,i,mkChar(tm) ); 
    free(tm);
    }
    UNPROTECT(1);
    return (ans);
}


/*
   do_dircreate it is just as under Windows. 
   (Stefano M. Iacus) Jago Jan-01, implemented in R 1.2.0 beta 1
*/

SEXP do_dircreate(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP  path, ans;
    char *p, dir[PATH_MAX];
    int res;

    checkArity(op, args);
    path = CAR(args);
    if (!isString(path) || length(path) != 1)
    errorcall(call, "invalid path argument");
    strcpy(dir, CHAR(STRING_ELT(path, 0)));
    for(p = dir; *p != '\0'; p++)
    if(*p == '/') *p = ':';  // Differs from Windows, Jago
    res = mkdir(dir,0);   // Differs from Windows, Jago 
    PROTECT(ans = allocVector(LGLSXP, 1));
    LOGICAL(ans)[0] = (res==0);
    UNPROTECT(1);
    return (ans);
}


static void SelectTargetsToLaunch(void);

/*
   do_helpstart it is just as under Windows. 
   (Stefano M. Iacus) Jago Jan-01, implemented in R 1.x.x 
*/

SEXP do_helpstart(SEXP call, SEXP op, SEXP args, SEXP env)
{
    char *home, buf[PATH_MAX];
    FILE *ff;
    FSSpec  fileSpec;
    OSErr err;
    Str255 HelpFileName;
    char errbuf[512];
                                     
    checkArity(op, args);
    
    home =  R_Home; // No env, Jago
   

    if (home == NULL)
    error("R_HOME not set");
    sprintf(buf, "%s:doc:html:rmac.html", home);
    ff = fopen(buf, "r");
    if (!ff) {
    sprintf(buf, "%s:doc:html:rmac.htm", home);
    ff = fopen(buf, "r");
    if (!ff) {
        sprintf(buf, "%s:doc:html:rmac.htm[l] not found", home);
        error(buf);
    }
    }
    fclose(ff);


    if (strlen(buf) < 254)
    strcpy((char *) HelpFileName, buf);
  else {
    error("file name too long");
    return R_NilValue;
       }
  CtoPstr((char *) HelpFileName);
  err = FSMakeFSSpecFromPath((ConstStr255Param) HelpFileName, &fileSpec);
  if (err != noErr) {
    sprintf(errbuf, "error code %d creating file spec for help file %s",
            err, buf);
    error(errbuf);        
    return R_NilValue;
  }
  
          
    err = FinderLaunch(1, &fileSpec);
    if(err!=noErr)
     error("Cannot lauch browser");
    
    return R_NilValue;
}


/* As under Windows. We only handle HTML help files
   Stefano M. Iacus (Jago Jan 2001)
*/
   
SEXP do_helpitem(SEXP call, SEXP op, SEXP args, SEXP env)
{
/*
 * type = 1: launch html file.
 *        
 */

    char *item;
    char *home, buf[PATH_MAX];
    FILE *ff;
    int   type;
    Str255 HelpFileName;
    FSSpec  fileSpec;
    OSErr err;
    char errbuf[512];
     
    checkArity(op, args);
    if (!isString(CAR(args)))
    errorcall(call, "invalid topic argument");
    item = CHAR(STRING_ELT(CAR(args), 0));
    type = asInteger(CADR(args));
    if (type == 1) {
    ff = fopen(item, "r");
    if (!ff) {
        sprintf(buf, "%s not found", item);
        error(buf);
    }
    fclose(ff);
/*  home = getenv("R_HOME");
*/  
    home =  R_Home;
    if (home == NULL)
        error("R_HOME not set");
        
        
    if (strlen(item) < 254)
     strcpy((char *) HelpFileName, item);
    else {
     error("file name too long");
     return R_NilValue;
     }

    CtoPstr((char *) HelpFileName);
    err = FSMakeFSSpecFromPath((ConstStr255Param) HelpFileName, &fileSpec);
    if (err != noErr) {
     sprintf(errbuf, "error code %d creating file spec for help file %s",
            err, item);
     error(errbuf);        
     return R_NilValue;
    }
  
    err = FinderLaunch(1, &fileSpec);
    if(err!=noErr)
     error("Cannot lauch browser");    
    }
    else
     warning("type not yet implemented");
    return R_NilValue;
}









SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    errorcall(call, "unimplemented function\n");
}



SEXP do_edit(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    int i, n;
    SEXP x;
    char **lines, *vmaxsave;

    checkArity(op, args);

    vmaxsave = vmaxget();

    /* x is the object to be edited */
    /* note that we ignore the file and editor args */

    PROTECT(x = deparse1(CAR(args), 0));
    n = length(x);
    lines = (char**)R_alloc(n, sizeof(char*));
    for (i = 0; i < n; i++) {
//          lines[i] = CHAR(STRING(x)[i]);
            lines[i] = CHAR( STRING_ELT(x,i) );
            }
    for (i = 0; i < n; i++) {
        Rprintf("%s\n", lines[i]);
            }
    R_Edit(lines, n);
    vmaxset(vmaxsave);
    UNPROTECT(1);
    R_Visible = 0;
    return R_NilValue;

}



/* Adapted from Windows code for Macintosh
   It does not allow wildcars and only files/dirs
   created in the current session can be removed.
   (Stefano M. Iacus) Jago Nov-00
*/

SEXP do_unlink(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP  fn, ans;
    char *p, tmp[PATH_MAX], dir[PATH_MAX];
    int i, nfiles, failures = 0;
    struct stat sb;


    checkArity(op, args);
    fn = CAR(args);
    nfiles = length(fn);
    if (!isString(fn) || nfiles < 1)
    errorcall(call, "invalid file name argument");
 
    for(i = 0; i < nfiles; i++) {
//  strcpy(tmp, CHAR(STRING(fn)[i]));
    strcpy(tmp, CHAR( STRING_ELT(fn,i) ));
    for(p = tmp; *p != '\0'; p++)
        if(*p == '/') *p = ':';

    if(stat(tmp, &sb) == 0)
        /* Is this a directory? */
        if(sb.st_mode & S_IFDIR) {
        if(rmdir(tmp)) failures++;      
        continue;
        }
    /* Regular file (or more) */
    strcpy(dir, tmp);
    if ((p = strrchr(dir, ':'))) *(++p) = '\0'; else *dir = '\0';
    /* wildcard not allowed */
       // strcpy(tmp, dir); //strcat(tmp, find_data.cFileName);
        failures += (unlink(tmp) !=0);
   }
    PROTECT(ans = allocVector(INTSXP, 1));
    if (!failures)
    INTEGER(ans)[0] = 0;
    else
    INTEGER(ans)[0] = 1;
    UNPROTECT(1);
    return (ans);
}


void R_Suicide(char *s)
{
    Str255 LabelText;
    int msglen,i;
    /* FIXME HERE: This should pop up a dialog box with the given */
    /* error message displayed, and the quit when the user hits the */
    /* OK button. */
    
  
    msglen = strlen(s);

   for(i=1;i<msglen;i++)
    if(s[i]==0x0A)
     s[i]=0x0D;

    StrToStr255(s, LabelText);
    R_doErrorAlert(LabelText);

    R_CleanUp(SA_NOSAVE,0,0);
    /* SA_NOSAVE means don't save anything and it's an unrecoverable abort */
}

void  StrToStr255(char* sourceText, Str255 targetText){
   SInt16 StringLength, Counter;
   StringLength = strlen(sourceText);
   if (StringLength > 254) 
      StringLength = 254;
   targetText[0] = StringLength;
   for (Counter = 1; Counter <=StringLength; Counter ++){
      targetText[Counter] = sourceText[Counter-1];
   }   
}
void  R_doErrorAlert(Str255 labelText)
{
    AlertStdAlertParamRec   paramRec;
    //Str255                                labelText;
    Str255                              narrativeText;
    SInt16                              itemHit;
        
    paramRec.movable                = false;
    paramRec.helpButton         = false;
    paramRec.filterProc         = NULL;
    paramRec.defaultText        = (StringPtr) kAlertDefaultOKText;
    paramRec.cancelText         = NULL;
    paramRec.otherText          = NULL;
    paramRec.defaultButton  = kAlertStdAlertOKButton;
    paramRec.cancelButton       = 0;
    paramRec.position               = kWindowAlertPositionMainScreen;

  Do_StandardAlert(labelText);
  //(kAlertStopAlert,labelText,0,&paramRec,&itemHit);

}






    /* Declarations to keep f77 happy */

int MAIN_()  {return 0;}
int MAIN__() {return 0;}
int __main() {return 0;}






/*
 
  What follows is adapted from src/unix/sys-common.c
 
 */

/*
  See ../unix/system.txt for a description of functions
 */

/*
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include "Defn.h"
#include "Fileio.h"
#include "Startup.h"

#include <string.h>
*/

#ifndef HAVE_STRDUP
extern char *strdup();
#endif


/* Permanent copy of the command line arguments and the number
   of them passed to the application.
   These are populated via the routine R_set_command_line_arguments()
   called from R_common_command_line().
*/
int    NumCommandLineArgs = 0;
char **CommandLineArgs = NULL;



/*
FILE *R_OpenSysInitFile(void)
{
    char buf[256];
    FILE *fp;

    sprintf(buf, "%s/library/base/R/Rprofile", R_Home);
    fp = R_fopen(buf, "r");
    return fp;
}
*/

/*
FILE *R_OpenSiteFile(void)
{
    char buf[256];
    FILE *fp;

    fp = NULL;
    if (LoadSiteFile) {
    if ((fp = R_fopen(getenv("R_PROFILE"), "r")))
        return fp;
    if ((fp = R_fopen(getenv("RPROFILE"), "r")))
        return fp;
    sprintf(buf, "%s/etc/Rprofile", R_Home);
    if ((fp = R_fopen(buf, "r")))
        return fp;
    }
    return fp;
}
*/

    /* Saving and Restoring the Global Environment */
/*
void R_RestoreGlobalEnv(void)
{
    FILE *fp;
    SEXP img, lst;
    int i;

    if(RestoreAction == SA_RESTORE) {
    if(!(fp = R_fopen(".RData", "rb"))) { 
        return;
    }
#ifdef OLD
    FRAME(R_GlobalEnv) = R_LoadFromFile(fp, 1);
#else
    PROTECT(img = R_LoadFromFile(fp, 1));
    switch (TYPEOF(img)) {
    case LISTSXP:
        while (img != R_NilValue) {
        defineVar(TAG(img), CAR(img), R_GlobalEnv);
        img = CDR(img);
        }
        break;
    case VECSXP:
        for (i = 0; i < LENGTH(img); i++) {
        lst = VECTOR_ELT(img, i);
        while (lst != R_NilValue) {
            defineVar(TAG(lst), CAR(lst), R_GlobalEnv);
            lst = CDR(lst);
        }
        }
        break;
    }
        UNPROTECT(1);
#endif
    if(!R_Quiet)
        Rprintf("[Previously saved workspace restored]\n\n");
        fclose(fp);
    }
}
*/
/*
void R_SaveGlobalEnv(void)
{
    FILE *fp = R_fopen(".RData", "wb"); 
    if (!fp)
    error("can't save data -- unable to open ./.RData");
    if (HASHTAB(R_GlobalEnv) != R_NilValue)
    R_SaveToFile(HASHTAB(R_GlobalEnv), fp, 0);
    else
    R_SaveToFile(FRAME(R_GlobalEnv), fp, 0);
    fclose(fp);
}
*/

/*
 * 5) FILESYSTEM INTERACTION
 */

/*
 * This call provides a simple interface to the "stat" system call.
 */

#ifdef HAVE_STAT
#include <types.h>
#include <stat.h>

#include <stat.h>

/*Rboolean R_FileExists(char *path)
{
    struct stat sb;
    return stat(path, &sb) == 0;
}
*/


Rboolean R_FileExists(char *path)
{
    struct stat sb;
    return stat(R_ExpandFileName(path), &sb) == 0;
}
#else
Rboolean R_FileExists(char *path)
{
    error("file existence is not available on this system");
}
#endif

    /*
     *  Unix file names which begin with "." are invisible.
     */
/*
Rboolean R_HiddenFile(char *name)
{
    if (name && name[0] != '.') return 0;
    else return 1;
}
*/

FILE *R_fopen(const char *filename, const char *mode)
{
    return(filename ? fopen(filename, mode) : NULL );
}

/*
 *  6) SYSTEM INFORMATION
 */

          /* The location of the R system files */

/*
 *  7) PLATFORM DEPENDENT FUNCTIONS
 */



SEXP do_putenv(SEXP call, SEXP op, SEXP args, SEXP env)
{
#ifdef HAVE_PUTENV
    int i, n;
    SEXP ans, vars;

    checkArity(op, args);

    if (!isString(vars =CAR(args)))
    errorcall(call, "wrong type for argument");

    n = LENGTH(vars);
    PROTECT(ans = allocVector(LGLSXP, n));
    for (i = 0; i < n; i++) {
    LOGICAL(ans)[i] = putenv(CHAR(STRING_ELT(vars, i))) == 0;
    }
    UNPROTECT(1);
    return ans;
#else
    error("`putenv' is not available on this system");
    return R_NilValue; /* -Wall */
#endif
}


SEXP do_interactive(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP rval;

    rval=allocVector(LGLSXP, 1);
    LOGICAL(rval)[0]= (R_Interactive) ? 1 : 0;
    return rval;
}

/*
 *  INITIALIZATION HELPER CODE
 */


void R_ShowMessage(char *msg)
{
  Str255 LabelText;
  int msglen,i;
  
  msglen = strlen(msg);
   
  
  for(i=1;i<msglen;i++)
   if(msg[i]==0x0A)
    msg[i]=0x0D;

      
  StrToStr255(msg, LabelText);
  R_doErrorAlert(LabelText);
}

void R_DefParams(Rstart Rp)
{
    Rp->R_Quiet = FALSE;
    Rp->R_Slave = FALSE;
    Rp->R_Interactive = TRUE;
    Rp->R_Verbose = FALSE;
    Rp->RestoreAction = SA_RESTORE;
    Rp->SaveAction = SA_SAVEASK;
    Rp->LoadSiteFile = TRUE;
    Rp->LoadInitFile = TRUE;
    Rp->DebugInitFile = FALSE;
    Rp->vsize = R_VSIZE;
    Rp->nsize = R_NSIZE;
    Rp->max_vsize = INT_MAX;
    Rp->max_nsize = INT_MAX;
    Rp->NoRenviron = FALSE;
}

#define Max_Nsize 50000000  /* must be < LONG_MAX (= 2^32 - 1 =)
                   2147483647 = 2.1e9 */
                                /* limit was 2e7, changed to 5e7, which gives
                                   nearly 2Gb of cons cells */
#define Max_Vsize (2048*Mega)   /* 2048*Mega = 2^(11+20) must be < LONG_MAX */

#define Min_Nsize 160000
#define Min_Vsize (1*Mega)

void R_SizeFromEnv(Rstart Rp)
{
    int value, ierr;
    char *p;
    if((p = getenv("R_VSIZE"))) {
    value = Decode2Long(p, &ierr);
    if(ierr != 0 || value > Max_Vsize || value < Min_Vsize)
        R_ShowMessage("WARNING: invalid R_VSIZE ignored\n");
    else
        Rp->vsize = value;
    }
    if((p = getenv("R_NSIZE"))) {
    value = Decode2Long(p, &ierr);
    if(ierr != 0 || value > Max_Nsize || value < Min_Nsize)
        R_ShowMessage("WARNING: invalid R_NSIZE ignored\n");
    else
        Rp->nsize = value;
    }
}

static void SetSize(int vsize, int nsize)
{
    char msg[1024];

    /* vsize >0 to catch long->int overflow */
    if (vsize < 1000 && vsize > 0) {
    R_ShowMessage("WARNING: vsize ridiculously low, Megabytes assumed\n");
    vsize *= Mega;
    }
    if(vsize < Min_Vsize || vsize > Max_Vsize) {
    sprintf(msg, "WARNING: invalid v(ector heap)size `%d' ignored\n"
         "using default = %gM\n", vsize, R_VSIZE / Mega);
    R_ShowMessage(msg);
    R_VSize = R_VSIZE;
    } else
    R_VSize = vsize;
    if(nsize < Min_Nsize || nsize > Max_Nsize) {
    sprintf(msg, "WARNING: invalid language heap (n)size `%d' ignored,"
         " using default = %ld\n", nsize, R_NSIZE);
    R_ShowMessage(msg);
    R_NSize = R_NSIZE;
    } else
    R_NSize = nsize;
}


void R_SetParams(Rstart Rp)
{
    R_Quiet = Rp->R_Quiet;
    R_Slave = Rp->R_Slave;
    R_Interactive = Rp->R_Interactive;
    R_Verbose = Rp->R_Verbose;
    RestoreAction = Rp->RestoreAction;
    SaveAction = Rp->SaveAction;
    LoadSiteFile = Rp->LoadSiteFile;
    LoadInitFile = Rp->LoadInitFile;
    DebugInitFile = Rp->DebugInitFile;
    SetSize(Rp->vsize, Rp->nsize);
    R_SetMaxNSize(Rp->max_nsize);
    R_SetMaxVSize(Rp->max_vsize);
    CommandLineArgs = Rp->CommandLineArgs;
    NumCommandLineArgs = Rp->NumCommandLineArgs;
}


/* Remove and process common command-line arguments */

/*
  This copies the command line arguments to the Rstart
  structure. The memory is obtained from calloc, etc.
  since these are permanent and it is not intended that
  they be modified. This is why they are copied before
  being processed and removed from the list.

  We might store these as a SEXP. I have no strong opinion
  about this.
 */
void
R_set_command_line_arguments(int argc, char **argv, Rstart Rp)
{
 int i;

  Rp->NumCommandLineArgs = argc;
  Rp->CommandLineArgs = (char**) calloc(argc, sizeof(char*));

  for(i = 0; i < argc; i++) {
    Rp->CommandLineArgs[i] = strdup(argv[i]);
  }
}


/*
  The .Internal which returns the command line arguments that are stored
  in global variables.
 */
SEXP
do_commandArgs(SEXP call, SEXP op, SEXP args, SEXP env)
{
 int i;
 SEXP vals;

  vals = allocVector(STRSXP, NumCommandLineArgs);
  for(i = 0; i < NumCommandLineArgs; i++) {
    SET_STRING_ELT(vals, i, mkChar(CommandLineArgs[i]));
  }

 return(vals);
}

void
R_common_command_line(int *pac, char **argv, Rstart Rp)
{
    int ac = *pac, newac = 1;   /* argv[0] is process name */
    int ierr;
    long value;
    char *p, **av = argv, msg[1024];

    R_RestoreHistory = 1;
    while(--ac) {
    if(**++av == '-') {
        if (!strcmp(*av, "--version")) {
        PrintVersion(msg);
        R_ShowMessage(msg);
        exit(0);
        }
#if 0
        else if(!strcmp(*av, "--print-nsize")) {
        Rprintf("%d\n", R_NSize);
        exit(0);
        }
        else if(!strcmp(*av, "--print-vsize")) {
        Rprintf("%d\n", R_VSize);
        exit(0);
        }
#endif
        else if(!strcmp(*av, "--save")) {
        Rp->SaveAction = SA_SAVE;
        }
        else if(!strcmp(*av, "--no-save")) {
        Rp->SaveAction = SA_NOSAVE;
        }
        else if(!strcmp(*av, "--restore")) {
        Rp->RestoreAction = SA_RESTORE;
        }
        else if(!strcmp(*av, "--no-restore")) {
        Rp->RestoreAction = SA_NORESTORE;
        R_RestoreHistory = 0;
        }
        else if(!strcmp(*av, "--no-restore-data")) {
        Rp->RestoreAction = SA_NORESTORE;
        }
        else if(!strcmp(*av, "--no-restore-history")) {
        R_RestoreHistory = 0;
        }
        else if (!strcmp(*av, "--silent") ||
             !strcmp(*av, "--quiet") ||
             !strcmp(*av, "-q")) {
        Rp->R_Quiet = TRUE;
        }
        else if (!strcmp(*av, "--vanilla")) {
        Rp->SaveAction = SA_NOSAVE; /* --no-save */
        Rp->RestoreAction = SA_NORESTORE; /* --no-restore */
        Rp->LoadSiteFile = FALSE; /* --no-site-file */
        Rp->LoadInitFile = FALSE; /* --no-init-file */
        R_RestoreHistory = 0;     /* --no-restore-history */
        Rp->NoRenviron = TRUE;
        }
        else if (!strcmp(*av, "--no-environ")) {
        Rp->NoRenviron = TRUE;
        }
        else if (!strcmp(*av, "--verbose")) {
        Rp->R_Verbose = TRUE;
        }
        else if (!strcmp(*av, "--slave") ||
             !strcmp(*av, "-s")) {
        Rp->R_Quiet = TRUE;
        Rp->R_Slave = TRUE;
        Rp->SaveAction = SA_NOSAVE;
        }
        else if (!strcmp(*av, "--no-site-file")) {
        Rp->LoadSiteFile = FALSE;
        }
        else if (!strcmp(*av, "--no-init-file")) {
        Rp->LoadInitFile = FALSE;
        }
        else if (!strcmp(*av, "--debug-init")) {
            Rp->DebugInitFile = TRUE;
        }
        else if (!strcmp(*av, "-save") ||
             !strcmp(*av, "-nosave") ||
             !strcmp(*av, "-restore") ||
             !strcmp(*av, "-norestore") ||
             !strcmp(*av, "-noreadline") ||
             !strcmp(*av, "-quiet") ||
             !strcmp(*av, "-V") ||
             !strcmp(*av, "-n") ||
             !strcmp(*av, "-v")) {
        sprintf(msg, "WARNING: option %s no longer supported\n", *av);
        R_ShowMessage(msg);
        }
            /* mop up --max/min/-n/vsize */
        else if(strncmp(*av+7, "size", 4) == 0) {
        if(strlen(*av) < 13) {
            ac--; av++; p = *av;
        }
        else p = &(*av)[12];
        if (p == NULL) {
            sprintf(msg, "WARNING: no value given for %s\n", *av);
            R_ShowMessage(msg);
            break;
        }
        value = Decode2Long(p, &ierr);
        if(ierr) {
            if(ierr < 0)
            sprintf(msg, "WARNING: %s value is invalid: ignored\n",
                *av);
            else
            sprintf(msg, "WARNING: %s=%ld`%c': too large and ignored\n",
                *av, value,
                (ierr == 1) ? 'M': ((ierr == 2) ? 'K' : 'k'));
            R_ShowMessage(msg);

        } else {
            if(!strncmp(*av, "--min-nsize", 11)) Rp->nsize = value;
            if(!strncmp(*av, "--max-nsize", 11)) Rp->max_nsize = value;
            if(!strncmp(*av, "--min-vsize", 11)) Rp->vsize = value;
            if(!strncmp(*av, "--max-vsize", 11)) Rp->max_vsize = value;
        }
        }
        else if(strncmp(*av, "--vsize", 7) == 0) {
        if(strlen(*av) < 9) {
            ac--; av++; p = *av;
        }
        else
            p = &(*av)[8];
        if (p == NULL) {
            R_ShowMessage("WARNING: no vsize given\n");
            break;
        }
        value = Decode2Long(p, &ierr);
        if(ierr) {
            if(ierr < 0) /* R_common_badargs(); */
            sprintf(msg, "WARNING: --vsize value is invalid: ignored\n");
            else
            sprintf(msg, "WARNING: --vsize=%ld`%c': too large and ignored\n",
                value,
                (ierr == 1) ? 'M': ((ierr == 2) ? 'K' : 'k'));
            R_ShowMessage(msg);

        } else
            Rp->vsize = value;
        }
        else if(strncmp(*av, "--nsize", 7) == 0) {
        if(strlen(*av) < 9) {
            ac--; av++; p = *av;
        }
        else
            p = &(*av)[8];
        if (p == NULL) {
            R_ShowMessage("WARNING: no nsize given\n");
            break;
        }
        value = Decode2Long(p, &ierr);
        if(ierr) {
            if(ierr < 0) /* R_common_badargs(); */
            sprintf(msg, "WARNING: --nsize value is invalid: ignored\n");
            else
            sprintf(msg, "WARNING: --nsize=%ld`%c': too large and ignored\n",
                value,
                (ierr == 1) ? 'M': ((ierr == 2) ? 'K':'k'));
            R_ShowMessage(msg);
        } else
            Rp->nsize = value;
        }
        else {
        argv[newac++] = *av;
        }
    }
    else {
        argv[newac++] = *av;
    }
    }
    *pac = newac;
    return;
}

/* ------------------- process .Renviron files in C ----------------- */

/* remove leading and trailing space */
static char *rmspace(char *s)
{
    int   i;

    for (i = strlen(s) - 1; isspace((int)s[i]); i--) s[i] = '\0';
    for (i = 0; isspace((int)s[i]); i++);
    return s + i;
}

/* look for ${FOO:-bar} constructs, recursively */
static char *findterm(char *s)
{
    char *p, *q;

    if(!strlen(s)) return "";
    if(strncmp(s, "${", 2)) return s;
    /* found one, so remove leading ${ and final } */
    if(s[strlen(s) - 1] != '}') return "";
    s[strlen(s) - 1] = '\0';
    s += 2;
    p = strchr(s, '-');
    if(!p) return "";
    q = p + 1; /* start of value */
    if(p - s > 1 && *(p-1) == ':') *(p-1) = '\0'; else *p = '\0';
    s = rmspace(s);
    if(!strlen(s)) return "";
    p = getenv(s);
    if(p && strlen(p)) return p; /* variable was set and non-empty */
    return findterm(q);
}

static void Putenv(char *a, char *b)
{
    char *buf;

    buf = (char *) malloc((strlen(a) + strlen(b) + 2) * sizeof(char));
    if(!buf) R_Suicide("allocation failure in reading Renviron");
    strcpy(buf, a); strcat(buf, "="); strcat(buf, b);
  //  putenv(buf);
    /* no free here: storage remains in use */
}


#define BUF_SIZE 255
#define MSG_SIZE 2000
static int process_Renviron(char *filename)
{
    FILE *fp;
    char *s, *p, sm[BUF_SIZE], *lhs, *rhs, msg[MSG_SIZE+50];
    int errs = 0;

    if (!filename || !(fp = fopen(filename, "r"))) return 0;
    sprintf(msg, "\n   File %s contains invalid line(s)", filename);

    while(fgets(sm, BUF_SIZE, fp)) {
    sm[BUF_SIZE] = '\0';
    s = rmspace(sm);
    if(strlen(s) == 0 || s[0] == '#') continue;
    if(!(p = strchr(s, '='))) {
        errs++;
        if(strlen(msg) < MSG_SIZE) {
        strcat(msg, "\n      "); strcat(msg, s);
        }
        continue;
    }
    *p = '\0';
    lhs = rmspace(s);
    rhs = findterm(rmspace(p+1));
    /* set lhs = rhs */
    if(strlen(lhs) && strlen(rhs)) Putenv(lhs, rhs);
    }
    fclose(fp);
    if (errs) {
    strcat(msg, "\n   They were ignored\n");
    R_ShowMessage(msg);
    }
    return 1;
}


/* read R_HOME/etc/Renviron:  Unix only */

/* try ./.Renviron, then value of R_ENVIRON, then ~/.Renviron */
void process_users_Renviron()
{
    char *s;
    
    
    if(process_Renviron(".Renviron")) return;
    if((s = getenv("R_ENVIRON"))) {
    process_Renviron(s);
    return;
    } 

    process_Renviron(s);
}