source_selection_addin.R

.packageName <- "myrstudioaddins"
handler <- function(e) {
  calls <- sys.calls()
  frames <- sys.frames()
  skip <- c("stop", "base::stop", ".handleSimpleError", "h",
            "simpleError", "simpleCondition")
  target <- length(calls)
  for (i in rev(seq_along(calls))) {
    cl <- tryCatch(deparse(calls[[i]][[1]], nlines = 1), error = function(e2) "")
    if (cl %in% skip) next
    if (grepl("^function\\s*\\(", cl)) next
    if (grepl("^\\(function\\s*\\(", cl)) next
    target <- i
    break
  }
  message("\n=== ERROR: ", conditionMessage(e), " ===")
  message("\nCall stack:")
  for (i in seq_along(calls)) {
    src <- tryCatch(getSrcref(calls[[i]]), error = function(e2) NULL)
    loc <- ""
    if (!is.null(src)) {
      fname <- tryCatch({
        sf <- attr(src, "srcfile")
        if (!is.null(sf) && !is.null(sf$filename) && nchar(sf$filename) > 0)
          basename(sf$filename)
        else
          NULL
      }, error = function(e2) NULL)
      if (!is.null(fname))
        loc <- paste0(" [", fname, ":", src[1], "]")
      else
        loc <- paste0(" [line ", src[1], "]")
    }
    cl <- tryCatch(deparse(calls[[i]], nlines = 1), error = function(e2) "<deparse error>")
    marker <- if (i == target) " <<<" else ""
    message(i, loc, ": ", cl, marker)
  }
  assign(".error_env", frames[[target]], envir = globalenv())
  message("\n>>> Error origin (", target, "): ",
          tryCatch(deparse(calls[[target]], nlines = 1), error = function(e2) ""))
  message("Saved to .error_env")
}
source_selection <- function() {
  code <- rstudioapi::getActiveDocumentContext()$selection[[1]]$text
  if (nchar(code) == 0) { message("No code selected."); return(invisible()) }
  tryCatch(
    withCallingHandlers(
      source(exprs = parse(text = code, keep.source = TRUE), local = globalenv()),
      error = handler
    ),
    error = function(e) invisible(NULL)
  )
}