int R_ShowFiles(int nfile, const char **file, const char **headers,
const char *wtitle, Rboolean del, const char *pager)
{
int i;
char buf[1024];
if (nfile > 0) {
if (pager == NULL || strlen(pager) == 0)
pager = "internal";
for (i = 0; i < nfile; i++) {
if(!access(file[i], R_OK)) {
if (!strcmp(pager, "internal")) {
newpager(wtitle, file[i], CE_NATIVE, headers[i], del);
} else if (!strcmp(pager, "console")) {
size_t len;
FILE *f;
f = R_fopen(file[i], "rt");
if(f) {
while((len = fread(buf, 1, 1023, f))) {
buf[len] = '\0';
R_WriteConsole(buf, strlen(buf));
}
fclose(f);
if (del) DeleteFile(file[i]);
/* add a blank line */
R_WriteConsole("", 0);
}
else {
snprintf(buf, 1024,
_("cannot open file '%s': %s"),
file[i], strerror(errno));
warning(buf);
}
} else {
/* Quote path if necessary */
if(pager[0] != '"' && Rf_strchr(pager, ' '))
snprintf(buf, 1024, "\"%s\" \"%s\"", pager, file[i]);
else
snprintf(buf, 1024, "%s \"%s\"", pager, file[i]);
runcmd(buf, CE_NATIVE, 0, 1, NULL, NULL, NULL);
}
} else {
snprintf(buf, 1024,
_("file.show(): file '%s' does not exist\n"),
file[i]);
warning(buf);
}
}
return 0;
}
return 1;
}
attribute_hidden
void Rcons_vprintf(const char *format, va_list arg)
{
char buf[R_BUFSIZE], *p = buf;
int res;
const void *vmax = vmaxget();
int usedRalloc = FALSE, usedVasprintf = FALSE;
va_list aq;
va_copy(aq, arg);
res = vsnprintf(buf, R_BUFSIZE, format, aq);
va_end(aq);
#ifdef HAVE_VASPRINTF
if(res >= R_BUFSIZE || res < 0) {
res = vasprintf(&p, format, arg);
if (res < 0) {
p = buf;
buf[R_BUFSIZE - 1] = '\0';
warning("printing of extremely long output is truncated");
} else usedVasprintf = TRUE;
}
#else
if(res >= R_BUFSIZE) { /* res is the desired output length */
usedRalloc = TRUE;
p = R_alloc(res+1, sizeof(char));
vsprintf(p, format, arg);
} else if(res < 0) { /* just a failure indication */
usedRalloc = TRUE;
p = R_alloc(10*R_BUFSIZE, sizeof(char));
res = vsnprintf(p, 10*R_BUFSIZE, format, arg);
if (res < 0) {
*(p + 10*R_BUFSIZE - 1) = '\0';
warning("printing of extremely long output is truncated");
}
}
#endif /* HAVE_VASPRINTF */
R_WriteConsole(p, (int) strlen(p));
if(usedRalloc) vmaxset(vmax);
if(usedVasprintf) free(p);
}
SEXP do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
{
rpipe *fp;
char buf[INTERN_BUFSIZE];
const char *fout = "", *ferr = "";
int vis = 0, flag = 2, i = 0, j, ll = 0;
SEXP cmd, fin, Stdout, Stderr, tlist = R_NilValue, tchar, rval;
int timeout = 0, timedout = 0;
checkArity(op, args);
cmd = CAR(args);
if (!isString(cmd) || LENGTH(cmd) != 1)
errorcall(call, _("character string expected as first argument"));
args = CDR(args);
flag = asInteger(CAR(args)); args = CDR(args);
if (flag >= 20) {vis = -1; flag -= 20;}
else if (flag >= 10) {vis = 0; flag -= 10;}
else vis = 1;
fin = CAR(args);
if (!isString(fin))
errorcall(call, _("character string expected as third argument"));
args = CDR(args);
Stdout = CAR(args);
args = CDR(args);
Stderr = CAR(args);
args = CDR(args);
timeout = asInteger(CAR(args));
if (timeout == NA_INTEGER || timeout < 0 || timeout > 2000000)
/* the limit could be increased, but not much as in milliseconds it
has to fit into a 32-bit unsigned integer */
errorcall(call, _("invalid '%s' argument"), "timeout");
if (timeout && !flag)
errorcall(call, "Timeout with background running processes is not supported.");
if (CharacterMode == RGui) {
/* This is a rather conservative approach: if
Rgui is launched from a console window it does have
standard handles -- but users might well not expect that.
*/
SetStdHandle(STD_INPUT_HANDLE, INVALID_HANDLE_VALUE);
SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
if (TYPEOF(Stdout) == STRSXP) fout = CHAR(STRING_ELT(Stdout, 0));
if (TYPEOF(Stderr) == STRSXP) ferr = CHAR(STRING_ELT(Stderr, 0));
} else {
if (flag == 2) flag = 1; /* ignore std.output.on.console */
if (TYPEOF(Stdout) == STRSXP) fout = CHAR(STRING_ELT(Stdout, 0));
else if (asLogical(Stdout) == 0) fout = NULL;
if (TYPEOF(Stderr) == STRSXP) ferr = CHAR(STRING_ELT(Stderr, 0));
else if (asLogical(Stderr) == 0) ferr = NULL;
}
if (flag < 2) { /* Neither intern = TRUE nor
show.output.on.console for Rgui */
ll = runcmd_timeout(CHAR(STRING_ELT(cmd, 0)),
getCharCE(STRING_ELT(cmd, 0)),
flag, vis, CHAR(STRING_ELT(fin, 0)), fout, ferr,
timeout, &timedout);
} else {
/* read stdout +/- stderr from pipe */
int m = 0;
if(flag == 2 /* show on console */ || CharacterMode == RGui) m = 3;
if(TYPEOF(Stderr) == LGLSXP)
m = asLogical(Stderr) ? 2 : 0;
if(m && TYPEOF(Stdout) == LGLSXP && asLogical(Stdout)) m = 3;
fp = rpipeOpen(CHAR(STRING_ELT(cmd, 0)), getCharCE(STRING_ELT(cmd, 0)),
vis, CHAR(STRING_ELT(fin, 0)), m, fout, ferr, timeout);
if (!fp) {
/* If intern = TRUE generate an error */
if (flag == 3) error(runerror());
ll = NOLAUNCH;
} else {
/* FIXME: use REPROTECT */
if (flag == 3) {
PROTECT(tlist);
/* honour intern = FALSE, ignore.stdout = TRUE */
if (m > 0 ||
(!(TYPEOF(Stdout) == LGLSXP && !asLogical(Stdout))))
for (i = 0; rpipeGets(fp, buf, INTERN_BUFSIZE); i++) {
ll = strlen(buf) - 1;
if ((ll >= 0) && (buf[ll] == '\n')) buf[ll] = '\0';
tchar = mkChar(buf);
UNPROTECT(1); /* tlist */
PROTECT(tlist = CONS(tchar, tlist));
}
} else {
for (i = 0; rpipeGets(fp, buf, INTERN_BUFSIZE); i++)
R_WriteConsole(buf, strlen(buf));
}
ll = rpipeClose(fp, &timedout);
}
}
if (timedout) {
ll = 124;
warningcall(R_NilValue, _("command '%s' timed out"),
CHAR(STRING_ELT(cmd, 0)));
} else if (flag == 3 && ll) {
warningcall(R_NilValue,
_("running command '%s' had status %d"),
CHAR(STRING_ELT(cmd, 0)), ll);
}
if (flag == 3) { /* intern = TRUE: convert pairlist to list */
PROTECT(rval = allocVector(STRSXP, i));
for (j = (i - 1); j >= 0; j--) {
SET_STRING_ELT(rval, j, CAR(tlist));
tlist = CDR(tlist);
}
if(ll) {
SEXP lsym = install("status");
setAttrib(rval, lsym, ScalarInteger(ll));
}
UNPROTECT(2);
return rval;
} else {
rval = ScalarInteger(ll);
R_Visible = 0;
return rval;
}
}
