自定义R重启功能，该功能不'；流产

invokeRestart（“muffleWarning”）

中的

muffleWarning

是如何实现的？我问是因为 在以下代码中：

e <-expression({
  warning("Step 1",immediate.=TRUE)
  warning("Step 2",immediate.=TRUE)
})

r <- withRestarts(withCallingHandlers(eval(e)
                                      ,warning=function(co){
                                        print(co) #1
                                        invokeRestart("mymuffleWarn",co)
                                      })
                  , mymuffleWarn=function(co) print(conditionMessage(co)))

---

eR源代码的灰色显示：

.signalSimpleWarning <- function(msg, call)
    withRestarts({
           .Internal(.signalCondition(simpleWarning(msg, call), msg, call))
           .Internal(.dfltWarn(msg, call))
        }, muffleWarning = function() NULL)

这是从

static void vsignalWarning(SEXP call, const char *format, va_list ap)
{
    char buf[BUFSIZE];
    SEXP hooksym, hcall, qcall;

    hooksym = install(".signalSimpleWarning");
    if (SYMVALUE(hooksym) != R_UnboundValue &&
        SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {
        PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));
        PROTECT(hcall = LCONS(qcall, R_NilValue));
        Rvsnprintf(buf, BUFSIZE - 1, format, ap);
        hcall = LCONS(mkString(buf), hcall);
        PROTECT(hcall = LCONS(hooksym, hcall));
        eval(hcall, R_GlobalEnv);
        UNPROTECT(3);
    }
    else vwarningcall_dflt(call, format, ap);
}

void warningcall(SEXP call, const char *format, ...)
{
    va_list(ap);
    va_start(ap, format);
    vsignalWarning(call, format, ap);
    va_end(ap);
}

该函数用于在C代码中生成警告，也可从支持
warning（）
的C函数
do\u warning
调用

因此，每当发出警告时，
muffleWarning
处理程序始终可用