Hi,
R_tryEval, exported in Rinternals.h but not part of the API, is
currently defined as:
R_tryEval(SEXP e, SEXP env, int *ErrorOccurred);
I'm trying to embed R in an application (basically yet another GUI),
and this has been very helpful to catch errors. It would be even more
helpful if it also gave access to the visibility flag. I can wrap this
in a call to withVisible, and that works great, but if there is an
error, traceback() contains a bunch of irrelevant levels.
It seems fairly easy to add another argument, similar to
ErrorOccurred, that is set to the visibility flag before returning. Is
this something that could be considered for addition in R-devel? A
possible patch for R/trunk is attached. Mac-GUI/REngine/REngine.m will
also need a patch, but I don't understand the language it's written
in.
-Deepayan
Index: src/include/Rinternals.h
===================================================================
--- src/include/Rinternals.h (revision 41080)
+++ src/include/Rinternals.h (working copy)
@@ -616,7 +616,7 @@
void R_ProtectWithIndex(SEXP, PROTECT_INDEX *);
void R_Reprotect(SEXP, PROTECT_INDEX);
-SEXP R_tryEval(SEXP, SEXP, int *);
+SEXP R_tryEval(SEXP, SEXP, int *, int *);
/* return(.) NOT reached : for -Wall */
#define error_return(msg) { Rf_error(msg); return R_NilValue; }
Index: src/library/methods/src/methods_list_dispatch.c
===================================================================
--- src/library/methods/src/methods_list_dispatch.c (revision 41080)
+++ src/library/methods/src/methods_list_dispatch.c (working copy)
@@ -299,7 +299,7 @@
val = CDR(val);
SETCAR(val, f_env);
}
- val = R_tryEval(e, Methods_Namespace, &check_err);
+ val = R_tryEval(e, Methods_Namespace, &check_err, NULL);
if(check_err)
error(_("S language method selection got an error when called from internal dispatch for function '%s'"),
check_symbol_or_string(fname, TRUE,
@@ -540,7 +540,7 @@
else {
/* get its class */
SEXP arg, class_obj; int check_err;
- PROTECT(arg = R_tryEval(arg_sym, ev, &check_err)); nprotect++;
+ PROTECT(arg = R_tryEval(arg_sym, ev, &check_err, NULL)); nprotect++;
if(check_err)
error(_("error in evaluating the argument '%s' in selecting a method for function '%s'"),
CHAR(PRINTNAME(arg_sym)),CHAR(asChar(fname)));
@@ -551,7 +551,7 @@
else {
/* the arg contains the class as a string */
SEXP arg; int check_err;
- PROTECT(arg = R_tryEval(arg_sym, ev, &check_err)); nprotect++;
+ PROTECT(arg = R_tryEval(arg_sym, ev, &check_err, NULL)); nprotect++;
if(check_err)
error(_("error in evaluating the argument '%s' in selecting a method for function '%s'"),
CHAR(PRINTNAME(arg_sym)),CHAR(asChar(fname)));
@@ -636,7 +636,7 @@
args = CDR(args);
}
if(prim_case) {
- val = R_tryEval(e, ev, &error_flag);
+ val = R_tryEval(e, ev, &error_flag, NULL);
/* reset the methods: R_NilValue for the mlist argument
leaves the previous function, methods list unchanged */
do_set_prim_method(op, "set", R_NilValue, R_NilValue);
@@ -833,7 +833,7 @@
else {
/* get its class */
SEXP arg; int check_err;
- PROTECT(arg = R_tryEval(arg_sym, ev, &check_err));
+ PROTECT(arg = R_tryEval(arg_sym, ev, &check_err, NULL));
if(check_err)
error(_("error in evaluating the argument '%s' in selecting a method for function '%s'"),
CHAR(PRINTNAME(arg_sym)),CHAR(asChar(fname)));
Index: src/main/main.c
===================================================================
--- src/main/main.c (revision 41080)
+++ src/main/main.c (working copy)
@@ -1434,7 +1434,7 @@
SETCAR(cur, VECTOR_ELT(f, 1));
}
- val = R_tryEval(e, NULL, &errorOccurred);
+ val = R_tryEval(e, NULL, &errorOccurred, NULL);
if(!errorOccurred) {
PROTECT(val);
if(TYPEOF(val) != LGLSXP) {
Index: src/main/context.c
===================================================================
--- src/main/context.c (revision 41080)
+++ src/main/context.c (working copy)
@@ -636,7 +636,7 @@
}
SEXP
-R_tryEval(SEXP e, SEXP env, int *ErrorOccurred)
+R_tryEval(SEXP e, SEXP env, int *ErrorOccurred, int *IsVisible)
{
Rboolean ok;
ProtectedEvalData data;
@@ -649,6 +649,9 @@
if (ErrorOccurred) {
*ErrorOccurred = (ok == FALSE);
}
+ if (IsVisible) {
+ *IsVisible = (int) R_Visible;
+ }
if (ok == FALSE)
data.val = NULL;
else
Index: src/gnuwin32/front-ends/rproxy_impl.c
===================================================================
--- src/gnuwin32/front-ends/rproxy_impl.c (revision 41080)
+++ src/gnuwin32/front-ends/rproxy_impl.c (working copy)
@@ -305,7 +305,7 @@
switch (lStatus) {
case PARSE_OK:
PROTECT(lSexp);
- lResult = R_tryEval(VECTOR_ELT(lSexp, 0), R_GlobalEnv, &evalError);
+ lResult = R_tryEval(VECTOR_ELT(lSexp, 0), R_GlobalEnv, &evalError, NULL);
UNPROTECT(1);
if(evalError) lRc = SC_PROXY_ERR_EVALUATE_STOP;
else lRc = SEXP2BDX(lResult, pData);
@@ -333,7 +333,7 @@
switch (lStatus) {
case PARSE_OK:
PROTECT(lSexp);
- lResult = R_tryEval(VECTOR_ELT(lSexp, 0), R_GlobalEnv, &evalError);
+ lResult = R_tryEval(VECTOR_ELT(lSexp, 0), R_GlobalEnv, &evalError, NULL);
UNPROTECT(1);
if(evalError) lRc = SC_PROXY_ERR_EVALUATE_STOP;
else lRc = SC_PROXY_OK;
Index: tests/Embedding/tryEval.c
===================================================================
--- tests/Embedding/tryEval.c (revision 41080)
+++ tests/Embedding/tryEval.c (working copy)
@@ -10,12 +10,12 @@
Rf_initEmbeddedR(argc, argv);
PROTECT(e = lang2(install("sqrt"), mkString("")));
- val = R_tryEval(e, NULL, &errorOccurred);
+ val = R_tryEval(e, NULL, &errorOccurred, NULL);
if(errorOccurred) {
fprintf(stderr, "Caught an error calling sqrt(). Try again with a different argument.\n");fflush(stderr);
}
SETCAR(CDR(e), ScalarInteger(9));
- val = R_tryEval(e, NULL, &errorOccurred);
+ val = R_tryEval(e, NULL, &errorOccurred, NULL);
if(errorOccurred) {
fprintf(stderr, "Caught another error calling sqrt()\n");fflush(stderr);
} else {
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
