Nothing
# sink -----------------------------------------------------------------------
# FIXME: Use (a better version of) pryr:::partial2 when available
output_sink <- function(file = NULL, append = FALSE, split = FALSE) {
sink(file = file, append = append, type = "output", split = split)
}
message_sink <- function(file = NULL, append = FALSE) {
sink(file = file, append = append, type = "message", split = FALSE)
}
#' @include wrap.R
set_output_sink <- wrap(
output_sink,
if (is.null(file)) {
stop("file cannot be NULL", call. = FALSE)
},
list(n = sink.number()))
set_message_sink <- wrap(
message_sink,
{
if (is.null(file)) {
stop("file cannot be NULL,", call. = FALSE)
}
if (sink.number(type = "message") != 2L) {
stop("Cannot establish message sink when another sink is active.",
call. = FALSE)
}
con <- if (is.character(file)) {
file <- file(file, if (append) "a" else "w")
}
},
{
list(n = sink.number(type = "message"), con = con)
})
reset_output_sink <- function(sink_info) {
repeat {
n <- sink.number()
delta <- n - sink_info$n
if (delta >= 0L) {
sink()
if (delta > 0L) {
warning("Removing a different sink.", call. = FALSE)
} else {
return()
}
} else {
warning("Sink #", sink_info$n, " already removed.", call. = FALSE)
return()
}
}
}
reset_message_sink <- function(sink_info) {
if (!is.null(sink_info$con)) {
on.exit(close(sink_info$con), add = TRUE)
}
do_reset_message_sink(sink_info)
}
do_reset_message_sink <- function(sink_info) {
n <- sink.number(type = "message")
if (n == 2L) {
warning("No message sink to remove.", call. = FALSE)
} else if (n == sink_info$n) {
sink(type = "message")
} else {
warning("Not removing a different message sink.", call. = FALSE)
}
}
#' Output redirection
#'
#' Temporarily divert output to a file via [sink()]. For
#' sinks of type `message`, an error is raised if such a sink is already
#' active.
#'
#' @template with
#' @param new `[character(1)|connection]`\cr
#' A writable \link{connection} or a character string naming the file to write
#' to. Passing `NULL` will throw an error.
#' @inheritParams base::sink
#' @inheritParams with_collate
#' @seealso [sink()]
#' @export
#' @name with_sink
with_output_sink <- with_(set_output_sink, reset_output_sink)
#' @rdname with_sink
#' @export
local_output_sink <- local_(set_output_sink, reset_output_sink)
#' @rdname with_sink
#' @export
with_message_sink <- with_(set_message_sink, reset_message_sink)
#' @rdname with_sink
#' @export
local_message_sink <- local_(set_message_sink, reset_message_sink)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.