예제 #1
0
파일: sys-unix.c 프로젝트: Vladimir84/rcc
void InitTempDir()
{
    char *tmp, *tm, tmp1[PATH_MAX+10], *p;
    int len;
#ifndef HAVE_MKDTEMP
    int res;
#endif

    tmp = getenv("R_SESSION_TMPDIR");
    if (!tmp) {
        /* This looks like it will only be called in the embedded case
           since this is done in the script. Also should test if directory
           exists rather than just attempting to remove it. 
	*/
	char *buf;
	tm = getenv("TMPDIR");
	if (!tm) tm = getenv("TMP");
	if (!tm) tm = getenv("TEMP");
	if (!tm) tm = "/tmp";
#ifdef HAVE_MKDTEMP
	sprintf(tmp1, "%s/RtmpXXXXXX", tm);
	tmp = mkdtemp(tmp1);
	if(!tmp) R_Suicide(_("cannot mkdir R_TempDir"));
#else
	sprintf(tmp1, "rm -rf %s/Rtmp%u", tm, (unsigned int)getpid());
	R_system(tmp1);
	sprintf(tmp1, "%s/Rtmp%u", tm, (unsigned int)getpid());
	res = mkdir(tmp1, 0755);
	if(res) {
	    /* Try one more time, in case a dir left around from that
	       process number from another user */
	    sprintf(tmp1, "rm -rf %s/Rtmp%u-%d", tm, (unsigned int)getpid(), 
		    rand() % 1000);
	    R_system(tmp1);
	    sprintf(tmp1, "%s/Rtmp%u-%d", tm, (unsigned int)getpid(), 
		    rand() % 1000);
	    res = mkdir(tmp1, 0755);
	}
	if(res) R_Suicide(_("cannot mkdir R_TempDir"));
#endif
	tmp = tmp1;
	buf = (char *) malloc((strlen(tmp) + 20) * sizeof(char));
	if(buf) {
	    sprintf(buf, "R_SESSION_TMPDIR=%s", tmp);
	    putenv(buf);
	    /* no free here: storage remains in use */
	}
    }

    len = strlen(tmp) + 1;
    p = (char *) malloc(len);
    if(!p) R_Suicide(_("cannot allocate R_TempDir"));
    else {
	R_TempDir = p;
	strcpy(R_TempDir, tmp);
    }
}
예제 #2
0
파일: system.c 프로젝트: radfordneal/pqR
    /*
     *     nfile   = number of files
     *     file    = array of filenames
     *     editor  = editor to be used.
     */
int R_EditFiles(int nfile, const char **file, const char **title,
		const char *editor)
{
    char  buf[1024];

    if (ptr_R_EditFiles) return(ptr_R_EditFiles(nfile, file, title, editor));

    if (nfile > 0) {
	if (nfile > 1)
	    R_ShowMessage(_("WARNING: Only editing the first in the list of files"));

	if (ptr_R_EditFile) ptr_R_EditFile((char *) file[0]);
	else {
	    /* Quote path if necessary */
	    if (editor[0] != '"' && Rf_strchr(editor, ' '))
		snprintf(buf, 1024, "\"%s\" \"%s\"", editor, file[0]);
	    else
		snprintf(buf, 1024, "%s \"%s\"", editor, file[0]);
	    if (R_system(buf) == 127)
		warningcall(R_NilValue, _("error in running command"));
	}
	return 0;
    }
    return 1;
}
예제 #3
0
파일: sys-std.c 프로젝트: lovmoy/r-source
int attribute_hidden
Rstd_ShowFiles(int nfile,		/* number of files */
	       const char **file,		/* array of filenames */
	       const char **headers,	/* the `headers' args of file.show.
					   Printed before each file. */
	       const char *wtitle,	/* title for window
					   = `title' arg of file.show */
	       Rboolean del,	/* should files be deleted after use? */
	       const char *pager)		/* pager to be used */

{
/*
	This function can be used to display the named files with the
	given titles and overall title.	 On GUI platforms we could
	use a read-only window to display the result.  Here we just
	make up a temporary file and invoke a pager on it.
*/

    int c, i, res;
    char *filename;
    FILE *fp, *tfp;
    char buf[1024];

    if (nfile > 0) {
	if (pager == NULL || strlen(pager) == 0) pager = "more";
	filename = R_tmpnam(NULL, R_TempDir); /* mallocs result */
	if ((tfp = R_fopen(filename, "w")) != NULL) {
	    for(i = 0; i < nfile; i++) {
		if (headers[i] && *headers[i])
		    fprintf(tfp, "%s\n\n", headers[i]);
		errno = 0; /* some systems require this */
		/* File expansion is now done in file.show(), but
		   left here in case other callers assumed it */
		if ((fp = R_fopen(R_ExpandFileName(file[i]), "r"))
		    != NULL) {
		    while ((c = fgetc(fp)) != EOF)
			fputc(c, tfp);
		    fprintf(tfp, "\n");
		    fclose(fp);
		    if(del)
			unlink(R_ExpandFileName(file[i]));
		}
		else
		    fprintf(tfp, _("Cannot open file '%s': %s\n\n"),
			    file[i], strerror(errno));
	    }
	    fclose(tfp);
	}
	snprintf(buf, 1024, "'%s' < '%s'", pager, filename); //might contain spaces
	res = R_system(buf);
	unlink(filename);
	free(filename);
	return (res != 0);
    }
    return 1;
}
예제 #4
0
파일: sys-unix.c 프로젝트: Vladimir84/rcc
SEXP do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    FILE *fp;
    char *x = "r", buf[INTERN_BUFSIZE];
    int read=0, i, j;
    SEXP tlist = R_NilValue, tchar, rval;

    checkArity(op, args);
    if (!isValidStringF(CAR(args)))
	errorcall(call, _("non-empty character argument expected"));
    if (isLogical(CADR(args)))
	read = INTEGER(CADR(args))[0];
    if (read) {
#ifdef HAVE_POPEN
	PROTECT(tlist);
	fp = R_popen(CHAR(STRING_ELT(CAR(args), 0)), x);
	for (i = 0; fgets(buf, INTERN_BUFSIZE, fp); i++) {
	    read = strlen(buf);
	    if (read > 0 && buf[read-1] == '\n') 
		buf[read - 1] = '\0'; /* chop final CR */
	    tchar = mkChar(buf);
	    UNPROTECT(1);
	    PROTECT(tlist = CONS(tchar, tlist));
	}
	pclose(fp);
	rval = allocVector(STRSXP, i);;
	for (j = (i - 1); j >= 0; j--) {
	    SET_STRING_ELT(rval, j, CAR(tlist));
	    tlist = CDR(tlist);
	}
	UNPROTECT(1);
	return (rval);
#else /* not HAVE_POPEN */
	errorcall(call, _("intern=TRUE is not implemented on this platform"));
	return R_NilValue;
#endif /* not HAVE_POPEN */
    }
    else {
#ifdef HAVE_AQUA
    	R_Busy(1);
#endif
	tlist = allocVector(INTSXP, 1);
	fflush(stdout);
	INTEGER(tlist)[0] = R_system(CHAR(STRING_ELT(CAR(args), 0)));
#ifdef HAVE_AQUA
    	R_Busy(0);
#endif
	R_Visible = 0;
	return tlist;
    }
}
예제 #5
0
파일: sys-std.c 프로젝트: lovmoy/r-source
void R_CleanTempDir(void)
{
    char buf[1024];

    if((Sys_TempDir)) {
#if defined(sun) || defined(__sun)
	/* On Solaris the working directory must be outside this one */
	chdir(R_HomeDir());
#endif
	char *p = getenv("R_OSX_VALGRIND");
	if (!p) {
	    snprintf(buf, 1024, "rm -rf %s", Sys_TempDir);
	    buf[1023] = '\0';
	    R_system(buf);
	} else R_CleanTempDir2();
    }
}
예제 #6
0
파일: edit.cpp 프로젝트: csilles/cxxr
SEXP do_edit(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    int   i, rc;
    ParseStatus status;
    SEXP  x, fn, envir, ed, src, srcfile, Rfn;
    char *filename, *editcmd;
    const char *cmd;
    const void *vmaxsave;
    FILE *fp;
#ifdef Win32
    SEXP ti;
    char *title;
#endif

	checkArity(op, args);

    vmaxsave = vmaxget();

    x = CAR(args); args = CDR(args);
    if (TYPEOF(x) == CLOSXP) envir = CLOENV(x);
    else envir = R_NilValue;
    PROTECT(envir);

    fn = CAR(args); args = CDR(args);
    if (!isString(fn))
	error(_("invalid argument to edit()"));

    if (LENGTH(STRING_ELT(fn, 0)) > 0) {
	const char *ss = translateChar(STRING_ELT(fn, 0));
	filename = R_alloc(strlen(ss), sizeof(char));
	strcpy(filename, ss);
    }
    else filename = DefaultFileName;

    if (x != R_NilValue) {
	if((fp=R_fopen(R_ExpandFileName(filename), "w")) == NULL)
	    errorcall(call, _("unable to open file"));
	if (LENGTH(STRING_ELT(fn, 0)) == 0) EdFileUsed++;
	if (TYPEOF(x) != CLOSXP || isNull(src = getAttrib(x, R_SourceSymbol)))
	    src = deparse1(x, CXXRFALSE, FORSOURCING); /* deparse for sourcing, not for display */
	for (i = 0; i < LENGTH(src); i++)
	    fprintf(fp, "%s\n", translateChar(STRING_ELT(src, i)));
	fclose(fp);
    }
#ifdef Win32
    ti = CAR(args);
#endif
    args = CDR(args);
    ed = CAR(args);
    if (!isString(ed)) errorcall(call, _("argument 'editor' type not valid"));
    cmd = translateChar(STRING_ELT(ed, 0));
    if (strlen(cmd) == 0) errorcall(call, _("argument 'editor' is not set"));
    editcmd = R_alloc(strlen(cmd) + strlen(filename) + 6, sizeof(char));
#ifdef Win32
    if (!strcmp(cmd,"internal")) {
	if (!isString(ti))
	    error(_("'title' must be a string"));
	if (LENGTH(STRING_ELT(ti, 0)) > 0) {
	    title = R_alloc(strlen(CHAR(STRING_ELT(ti, 0)))+1, sizeof(char));
	    strcpy(title, CHAR(STRING_ELT(ti, 0)));
	} else {
	    title = R_alloc(strlen(filename)+1, sizeof(char));
	    strcpy(title, filename);
	}
	Rgui_Edit(filename, CE_NATIVE, title, 1);
    }
    else {
	/* Quote path if necessary */
	if(cmd[0] != '"' && Rf_strchr(cmd, ' '))
	    sprintf(editcmd, "\"%s\" \"%s\"", cmd, filename);
	else
	    sprintf(editcmd, "%s \"%s\"", cmd, filename);
	rc = runcmd(editcmd, CE_NATIVE, 1, 1, NULL, NULL, NULL);
	if (rc == NOLAUNCH)
	    errorcall(call, _("unable to run editor '%s'"), cmd);
	if (rc != 0)
	    warningcall(call, _("editor ran but returned error status"));
    }
#else
    if (ptr_R_EditFile)
	rc = ptr_R_EditFile(filename);
    else {
	sprintf(editcmd, "'%s' '%s'", cmd, filename); // allow for spaces
	rc = R_system(editcmd);
    }
    if (rc != 0)
	errorcall(call, _("problem with running editor %s"), cmd);
#endif

    if (asLogical(GetOption1(install("keep.source")))) {
	PROTECT(Rfn = findFun(install("readLines"), R_BaseEnv));
	PROTECT(src = lang2(Rfn, ScalarString(mkChar(R_ExpandFileName(filename)))));
	PROTECT(src = eval(src, R_BaseEnv));
	PROTECT(Rfn = findFun(install("srcfilecopy"), R_BaseEnv));
	PROTECT(srcfile = lang3(Rfn, ScalarString(mkChar("<tmp>")), src));
	srcfile = eval(srcfile, R_BaseEnv);
	UNPROTECT(5);
    } else
    	srcfile = R_NilValue;
    PROTECT(srcfile);
    
    /* <FIXME> setup a context to close the file, and parse and eval
       line by line */
    if((fp = R_fopen(R_ExpandFileName(filename), "r")) == NULL)
	errorcall(call, _("unable to open file to read"));

    x = PROTECT(R_ParseFile(fp, -1, &status, srcfile));
    fclose(fp);

    if (status != PARSE_OK)
	errorcall(call,
		  _("%s occurred on line %d\n use a command like\n x <- edit()\n to recover"), R_ParseErrorMsg, R_ParseError);
    R_ResetConsole();
    {   /* can't just eval(x) here */
	int j, n;
	SEXP tmp = R_NilValue;

	n = LENGTH(x);
	for (j = 0 ; j < n ; j++)
	    tmp = eval(XVECTOR_ELT(x, j), R_GlobalEnv);
	x = tmp;
    }
    if (TYPEOF(x) == CLOSXP && envir != R_NilValue)
	SET_CLOENV(x, envir);
    UNPROTECT(3);
    vmaxset(vmaxsave);
    return x;
}
예제 #7
0
SEXP attribute_hidden do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP tlist = R_NilValue;
    int intern = 0;

    checkArity(op, args);
    if (!isValidStringF(CAR(args)))
	error(_("non-empty character argument expected"));
    intern = asLogical(CADR(args));
    if (intern == NA_INTEGER)
	error(_("'intern' must be logical and not NA"));
    if (intern) { /* intern = TRUE */
	FILE *fp;
	char *x = "r", buf[INTERN_BUFSIZE];
	const char *cmd;
	int i, j, res;
	SEXP tchar, rval;

	PROTECT(tlist);
	cmd = translateChar(STRING_ELT(CAR(args), 0));
	errno = 0; /* precaution */
	if(!(fp = R_popen(cmd, x)))
	    error(_("cannot popen '%s', probable reason '%s'"),
		  cmd, strerror(errno));
	for (i = 0; fgets(buf, INTERN_BUFSIZE, fp); i++) {
	    size_t read = strlen(buf);
	    if(read >= INTERN_BUFSIZE - 1)
		warning(_("line %d may be truncated in call to system(, intern = TRUE)"), i + 1);
	    if (read > 0 && buf[read-1] == '\n')
		buf[read - 1] = '\0'; /* chop final CR */
	    tchar = mkChar(buf);
	    UNPROTECT(1);
	    PROTECT(tlist = CONS(tchar, tlist));
	}
	res = pclose(fp);
#ifdef HAVE_SYS_WAIT_H
	if (WIFEXITED(res)) res = WEXITSTATUS(res);
	else res = 0;
#else
	/* assume that this is shifted if a multiple of 256 */
	if ((res % 256) == 0) res = res/256;
#endif
	if ((res & 0xff)  == 127) {/* 127, aka -1 */
	    if (errno)
		error(_("error in running command: '%s'"), strerror(errno));
	    else
		error(_("error in running command"));
	} else if (res) {
	    if (errno)
		warningcall(R_NilValue, 
			    _("running command '%s' had status %d and error message '%s'"), 
			    cmd, res, 
			    strerror(errno));
	    else 
		warningcall(R_NilValue, 
			    _("running command '%s' had status %d"), 
			    cmd, res);
	}
	
	rval = PROTECT(allocVector(STRSXP, i));
	for (j = (i - 1); j >= 0; j--) {
	    SET_STRING_ELT(rval, j, CAR(tlist));
	    tlist = CDR(tlist);
	}
	if(res) {
	    SEXP lsym = install("status");
	    setAttrib(rval, lsym, ScalarInteger(res));
	    if(errno) {
		lsym = install("errmsg");
		setAttrib(rval, lsym, mkString(strerror(errno)));
	    }
	}
	UNPROTECT(2);
	return rval;
    }
    else { /* intern =  FALSE */
#ifdef HAVE_AQUA
	R_Busy(1);
#endif
	tlist = PROTECT(allocVector(INTSXP, 1));
	fflush(stdout);
	INTEGER(tlist)[0] = R_system(translateChar(STRING_ELT(CAR(args), 0)));
#ifdef HAVE_AQUA
	R_Busy(0);
#endif
	UNPROTECT(1);
	R_Visible = 0;
	return tlist;
    }
}
예제 #8
0
/**
  This is the body of the REPL.
  It attempts to parse the first line or expression of its input,
  and optionally request input from the user if none is available.
  If the input can be parsed correctly,
     i) the resulting expression is evaluated,
    ii) the result assigned to .Last.Value,
   iii) top-level task handlers are invoked.

 If the input cannot be parsed, i.e. there is a syntax error,
 it is incomplete, or we encounter an end-of-file, then we
 change the prompt accordingly.

 The "cursor" for the input buffer is moved to the next starting
 point, i.e. the end of the first line or after the first ;.
 */
int
Rf_ReplIteration(SEXP rho, int savestack, int browselevel, R_ReplState *state)
{
    int c, browsevalue;
    SEXP value, thisExpr;
    Rboolean wasDisplayed = FALSE;

    if(!*state->bufp) {
	    R_Busy(0);
	    if (R_ReadConsole(R_PromptString(browselevel, state->prompt_type),
			      state->buf, CONSOLE_BUFFER_SIZE, 1) == 0)
		return(-1);
	    state->bufp = state->buf;
    }
#ifdef SHELL_ESCAPE /* not default */
    if (*state->bufp == '!') {
	    R_system(&(state->buf[1]));
	    state->buf[0] = '\0';
	    return(0);
    }
#endif /* SHELL_ESCAPE */
    while((c = *state->bufp++)) {
	    R_IoBufferPutc(c, &R_ConsoleIob);
	    if(c == ';' || c == '\n') break;
    }

    R_PPStackTop = savestack;
    R_CurrentExpr = R_Parse1Buffer(&R_ConsoleIob, 0, &state->status);
    
    switch(state->status) {

    case PARSE_NULL:

	/* The intention here is to break on CR but not on other
	   null statements: see PR#9063 */
	if (browselevel && !R_DisableNLinBrowser
	    && !strcmp((char *) state->buf, "\n")) return -1;
	R_IoBufferWriteReset(&R_ConsoleIob);
	state->prompt_type = 1;
	return 1;

    case PARSE_OK:

	R_IoBufferReadReset(&R_ConsoleIob);
	R_CurrentExpr = R_Parse1Buffer(&R_ConsoleIob, 1, &state->status);
	if (browselevel) {
	    browsevalue = ParseBrowser(R_CurrentExpr, rho);
	    if(browsevalue == 1) return -1;
	    if(browsevalue == 2) {
		R_IoBufferWriteReset(&R_ConsoleIob);
		return 0;
	    }
	    /* PR#15770 We don't want to step into expressions entered at the debug prompt. 
	       The 'S' will be changed back to 's' after the next eval. */
	    if (R_BrowserLastCommand == 's') R_BrowserLastCommand = 'S';  
	}
	R_Visible = FALSE;
	R_EvalDepth = 0;
	resetTimeLimits();
	PROTECT(thisExpr = R_CurrentExpr);
	R_Busy(1);
	value = eval(thisExpr, rho);
	SET_SYMVALUE(R_LastvalueSymbol, value);
	wasDisplayed = R_Visible;
	if (R_Visible)
	    PrintValueEnv(value, rho);
	if (R_CollectWarnings)
	    PrintWarnings();
	Rf_callToplevelHandlers(thisExpr, value, TRUE, wasDisplayed);
	R_CurrentExpr = value; /* Necessary? Doubt it. */
	UNPROTECT(1);
	if (R_BrowserLastCommand == 'S') R_BrowserLastCommand = 's';  
	R_IoBufferWriteReset(&R_ConsoleIob);
	state->prompt_type = 1;
	return(1);

    case PARSE_ERROR:

	state->prompt_type = 1;
	parseError(R_NilValue, 0);
	R_IoBufferWriteReset(&R_ConsoleIob);
	return(1);

    case PARSE_INCOMPLETE:

	R_IoBufferReadReset(&R_ConsoleIob);
	state->prompt_type = 2;
	return(2);

    case PARSE_EOF:

	return(-1);
	break;
    }

    return(0);
}
예제 #9
0
파일: edit.c 프로젝트: Vladimir84/rcc
SEXP do_edit(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    int   i, rc;
    ParseStatus status;
    SEXP  x, fn, envir, ti, ed, t;
    char *filename, *editcmd, *vmaxsave, *cmd;
    FILE *fp;
#ifdef Win32
    char *title;
#endif

	checkArity(op, args);

    vmaxsave = vmaxget();

    x = CAR(args); args = CDR(args);
    if (TYPEOF(x) == CLOSXP) envir = CLOENV(x);
    else envir = R_NilValue;
    PROTECT(envir);

    fn = CAR(args); args = CDR(args);
    if (!isString(fn))
	error(_("invalid argument to edit()"));

    if (LENGTH(STRING_ELT(fn, 0)) > 0) {
	filename = R_alloc(strlen(CHAR(STRING_ELT(fn, 0))), sizeof(char));
	strcpy(filename, CHAR(STRING_ELT(fn, 0)));
    }
    else filename = DefaultFileName;

    if (x != R_NilValue) {

	if((fp=R_fopen(R_ExpandFileName(filename), "w")) == NULL)
	    errorcall(call, _("unable to open file"));
	if (LENGTH(STRING_ELT(fn, 0)) == 0) EdFileUsed++;
	if (TYPEOF(x) != CLOSXP || isNull(t = getAttrib(x, R_SourceSymbol)))
	    t = deparse1(x, 0, FORSOURCING); /* deparse for sourcing, not for display */
	for (i = 0; i < LENGTH(t); i++)
	    fprintf(fp, "%s\n", CHAR(STRING_ELT(t, i)));
	fclose(fp);
    }
    ti = CAR(args); args = CDR(args);
    ed = CAR(args);
    if (!isString(ed)) errorcall(call, _("argument 'editor' type not valid"));
    cmd = CHAR(STRING_ELT(ed, 0));
    if (strlen(cmd) == 0) errorcall(call, _("argument 'editor' is not set"));
    editcmd = R_alloc(strlen(cmd) + strlen(filename) + 6, sizeof(char));
#ifdef Win32
    if (!strcmp(cmd,"internal")) {
	if (!isString(ti))
	    error(_("'title' must be a string"));
	if (LENGTH(STRING_ELT(ti, 0)) > 0) {
	    title = R_alloc(strlen(CHAR(STRING_ELT(ti, 0)))+1, sizeof(char));
	    strcpy(title, CHAR(STRING_ELT(ti, 0)));
	} else {
	    title = R_alloc(strlen(filename)+1, sizeof(char));
	    strcpy(title, filename);
	}
	Rgui_Edit(filename, title, 1);
    }
    else {
	/* Quote path if necessary */
	if(cmd[0] != '"' && Rf_strchr(cmd, ' '))
	    sprintf(editcmd, "\"%s\" \"%s\"", cmd, filename);
	else
	    sprintf(editcmd, "%s \"%s\"", cmd, filename);
	rc = runcmd(editcmd, 1, 1, "");
	if (rc == NOLAUNCH)
	    errorcall(call, _("unable to run editor '%s'"), cmd);
	if (rc != 0)
	    warningcall(call, _("editor ran but returned error status"));
    }
#else
    if (ptr_R_EditFile)
        rc = ptr_R_EditFile(filename);
    else {
        sprintf(editcmd, "%s %s", cmd, filename);
        rc = R_system(editcmd);
    }
    if (rc != 0)
	errorcall(call, _("problem with running editor %s"), cmd);
#endif

    if((fp = R_fopen(R_ExpandFileName(filename), "r")) == NULL)
	errorcall(call, _("unable to open file to read"));
    R_ParseCnt = 0;
    x = PROTECT(R_ParseFile(fp, -1, &status));
    fclose(fp);
    if (status != PARSE_OK)
	errorcall(call,
		  _("an error occurred on line %d\n use a command like\n x <- edit()\n to recover"), R_ParseError);
    R_ResetConsole();
    {   /* can't just eval(x) here */
	int j, n;
	SEXP tmp = R_NilValue;

	n = LENGTH(x);
	for (j = 0 ; j < n ; j++)
	    tmp = eval(VECTOR_ELT(x, j), R_GlobalEnv);
	x = tmp;
    }
    if (TYPEOF(x) == CLOSXP && envir != R_NilValue)
	SET_CLOENV(x, envir);
    UNPROTECT(2);
    vmaxset(vmaxsave);
    return (x);
}