The R Project SVN R

Rev

Rev 78002 | Rev 78073 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 78002 Rev 78071
Line 31... Line 31...
31 
#include <R_ext/GraphicsEngine.h> /* for GEonExit */
 31 
#include <R_ext/GraphicsEngine.h> /* for GEonExit */
32 
#include <Rmath.h> /* for imax2 */
 32 
#include <Rmath.h> /* for imax2 */
33 
#include <R_ext/Print.h>
 33 
#include <R_ext/Print.h>
34 
#include <stdarg.h>
 34 
#include <stdarg.h>
35 
 
 35 
 
- 
 
 36 
/* eval() sets R_Visible = TRUE. Thas may not be wanted when eval() is
- 
 
 37 
   used in C code. This is a version that saves/restores R_Visible.
- 
 
 38 
   This should probably be moved to eval.c, be make public, and used
- 
 
 39 
   in  more places. LT */
- 
 
 40 
static SEXP evalKeepVis(SEXP e, SEXP rho)
- 
 
 41 
{
- 
 
 42 
    int oldvis = R_Visible;
- 
 
 43 
    SEXP val = eval(e, rho);
- 
 
 44 
    R_Visible = oldvis;
- 
 
 45 
    return val;
- 
 
 46 
}
- 
 
 47 
 
36 
#ifndef min
 48 
#ifndef min
37 
#define min(a, b) (a<b?a:b)
 49 
#define min(a, b) (a<b?a:b)
38 
#endif
 50 
#endif
39 
 
 51 
 
40 
/* Total line length, in chars, before splitting in warnings/errors */
 52 
/* Total line length, in chars, before splitting in warnings/errors */
Line 404... Line 416...
404 
	if( !isLanguage(s) &&  ! isExpression(s) )
 416 
	if( !isLanguage(s) &&  ! isExpression(s) )
405 
	    error(_("invalid option \"warning.expression\""));
 417 
	    error(_("invalid option \"warning.expression\""));
406 
	cptr = R_GlobalContext;
 418 
	cptr = R_GlobalContext;
407 
	while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->callflag )
 419 
	while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->callflag )
408 
	    cptr = cptr->nextcontext;
 420 
	    cptr = cptr->nextcontext;
409 
	eval(s, cptr->cloenv);
 421 
	evalKeepVis(s, cptr->cloenv);
410 
	return;
 422 
	return;
411 
    }
 423 
    }
412 
 
 424 
 
413 
    w = asInteger(GetOption1(install("warn")));
 425 
    w = asInteger(GetOption1(install("warn")));
414 
 
 426 
 
Line 1708... Line 1720...
1708 
	PROTECT(qcall = LCONS(qfun, LCONS(call, R_NilValue)));
 1720 
	PROTECT(qcall = LCONS(qfun, LCONS(call, R_NilValue)));
1709 
	PROTECT(hcall = LCONS(qcall, R_NilValue));
 1721 
	PROTECT(hcall = LCONS(qcall, R_NilValue));
1710 
	Rvsnprintf(buf, BUFSIZE - 1, format, ap);
 1722 
	Rvsnprintf(buf, BUFSIZE - 1, format, ap);
1711 
	hcall = LCONS(mkString(buf), hcall);
 1723 
	hcall = LCONS(mkString(buf), hcall);
1712 
	PROTECT(hcall = LCONS(hooksym, hcall));
 1724 
	PROTECT(hcall = LCONS(hooksym, hcall));
1713 
	eval(hcall, R_GlobalEnv);
 1725 
	evalKeepVis(hcall, R_GlobalEnv);
1714 
	UNPROTECT(4);
 1726 
	UNPROTECT(4);
1715 
    }
 1727 
    }
1716 
    else vwarningcall_dflt(call, format, ap);
 1728 
    else vwarningcall_dflt(call, format, ap);
1717 
}
 1729 
}
1718 
 
 1730 
 
Line 1863... Line 1875...
1863 
	PROTECT(cond = getInterruptCondition());
 1875 
	PROTECT(cond = getInterruptCondition());
1864 
	if (IS_CALLING_ENTRY(entry)) {
 1876 
	if (IS_CALLING_ENTRY(entry)) {
1865 
	    SEXP h = ENTRY_HANDLER(entry);
 1877 
	    SEXP h = ENTRY_HANDLER(entry);
1866 
	    SEXP hcall = LCONS(h, LCONS(cond, R_NilValue));
 1878 
	    SEXP hcall = LCONS(h, LCONS(cond, R_NilValue));
1867 
	    PROTECT(hcall);
 1879 
	    PROTECT(hcall);
1868 
	    eval(hcall, R_GlobalEnv);
 1880 
	    evalKeepVis(hcall, R_GlobalEnv);
1869 
	    UNPROTECT(1);
 1881 
	    UNPROTECT(1);
1870 
	}
 1882 
	}
1871 
	else gotoExitingHandler(cond, R_NilValue, entry);
 1883 
	else gotoExitingHandler(cond, R_NilValue, entry);
1872 
	UNPROTECT(1);
 1884 
	UNPROTECT(1);
1873 
    }
 1885 
    }
Line 1875... Line 1887...
1875 
    UNPROTECT(1);
 1887 
    UNPROTECT(1);
1876 
 
 1888 
 
1877 
    SEXP h = GetOption1(install("interrupt"));
 1889 
    SEXP h = GetOption1(install("interrupt"));
1878 
    if (h != R_NilValue) {
 1890 
    if (h != R_NilValue) {
1879 
	SEXP call = PROTECT(LCONS(h, R_NilValue));
 1891 
	SEXP call = PROTECT(LCONS(h, R_NilValue));
1880 
	eval(call, R_GlobalEnv);
 1892 
	evalKeepVis(call, R_GlobalEnv);
1881 
    }
 1893 
    }
1882 
}
 1894 
}
1883 
 
 1895 
 
1884 
void attribute_hidden
 1896 
void attribute_hidden
1885 
R_InsertRestartHandlers(RCNTXT *cptr, const char *cname)
 1897 
R_InsertRestartHandlers(RCNTXT *cptr, const char *cname)
Line 2337... Line 2349...
2337 
    PROTECT(conds);
 2349 
    PROTECT(conds);
2338 
    SEXP fin = finally != NULL ? R_TrueValue : R_FalseValue;
 2350 
    SEXP fin = finally != NULL ? R_TrueValue : R_FalseValue;
2339 
    SEXP tcdptr = R_MakeExternalPtr(&tcd, R_NilValue, R_NilValue);
 2351 
    SEXP tcdptr = R_MakeExternalPtr(&tcd, R_NilValue, R_NilValue);
2340 
    SEXP expr = lang4(trycatch_callback, tcdptr, conds, fin);
 2352 
    SEXP expr = lang4(trycatch_callback, tcdptr, conds, fin);
2341 
    PROTECT(expr);
 2353 
    PROTECT(expr);
2342 
    SEXP val = eval(expr, R_GlobalEnv);
 2354 
    SEXP val = evalKeepVis(expr, R_GlobalEnv);
2343 
    UNPROTECT(2); /* conds, expr */
 2355 
    UNPROTECT(2); /* conds, expr */
2344 
    R_interrupts_suspended = tcd.suspended;
 2356 
    R_interrupts_suspended = tcd.suspended;
2345 
    return val;
 2357 
    return val;
2346 
}
 2358 
}
2347 
 
 2359