Nothing
readLines <- function(...) {
cli::cli_abort(
"Inside {.pkg reprex}, we use {.fun read_lines}, not {.fun readLines}, for UTF-8 reasons.",
.internal = TRUE
)
}
writeLines <- function(...) {
cli::cli_abort(
"Inside {.pkg reprex}, we use {.fun write_lines}, not {.fun writeLines}, for UTF-8 reasons.",
.internal = TRUE
)
}
read_lines <- function(path, n = -1L) {
if (is.null(path)) {
return(NULL)
}
base::readLines(path, n = n, encoding = "UTF-8", warn = FALSE)
}
write_lines <- function(text, path, sep = "\n") {
path <- file(path, open = "wb")
withr::defer(close(path))
base::writeLines(enc2utf8(text), con = path, sep = sep, useBytes = TRUE)
}
locate_input <- function(input) {
if (is.null(input)) {
if (reprex_clipboard()) {
return("clipboard")
}
if (in_rstudio()) {
return("selection")
} else {
return(NULL)
}
}
if (is_path(input)) {
"path"
} else {
"input"
}
}
retrofit_files <- function(infile = NULL, wd = NULL, outfile = deprecated()) {
if (!lifecycle::is_present(outfile)) {
return(list(infile = infile, wd = wd))
}
# `outfile` was specified
if (!is.null(wd)) {
lifecycle::deprecate_warn(
when = "2.0.0",
what = "reprex(outfile)",
with = "reprex(wd)"
)
return(list(infile = infile, wd = wd))
}
# `wd` was not specified
# cases to consider
# infile outfile
# NULL NA
# "foo.R" NA
# "foo/bar.R" NA
# NULL "foo"
# NULL "foo/bar"
# "foo/bar.R" "blah"
if (is.na(outfile)) {
# historically, this was a good way to say "reprex in working directory"
if (is.null(infile)) {
lifecycle::deprecate_warn(
when = "2.0.0",
what = "reprex(outfile)",
details = 'Use `reprex(wd = ".")` instead of `reprex(outfile = NA)`.'
)
return(list(infile = NULL, wd = "."))
}
lifecycle::deprecate_warn(
when = "2.0.0",
what = "reprex(outfile)",
details = "Working directory will be derived from `input`."
)
return(list(infile = infile, wd = NULL))
}
# `outfile` is string
if (is.null(infile)) {
lifecycle::deprecate_warn(
when = "2.0.0",
what = "reprex(outfile)",
details = c(
"To control output filename, provide a filepath to `input`.",
"Only taking working directory from `outfile`."
)
)
return(list(infile = NULL, wd = path_dir(outfile)))
}
# both `infile` and `outfile` are strings
lifecycle::deprecate_warn(
when = "2.0.0",
what = "reprex(outfile)",
details = "Working directory and output filename will be determined from `input`."
)
list(infile = infile, wd = NULL)
}
plan_files <- function(infile = NULL, wd = NULL, outfile = deprecated()) {
tmp <- retrofit_files(infile, wd, outfile)
infile <- tmp$infile
wd <- tmp$wd
chatty <- !is.null(infile) || !is.null(wd) || lifecycle::is_present(outfile)
if (!is.null(infile) && !is.null(wd)) {
reprex_warning(
"Ignoring {.code wd}, working directory is determined by {.code input}"
)
wd <- NULL
}
list(
chatty = chatty,
filebase = make_filebase(infile, wd)
)
}
# we'll index into the (shuffled) adjective-animal list with this
aa_i <- (function() {
i <- 0
function() {
i <<- i + 1
i
}
})()
reprex_aa <- function() adjective_animal[[aa_i()]]
reprex_default_filebase <- function(in_temp_dir) {
# ugly but (probably) unique
ugly_dir <- file_temp("reprex-")
# human-friendly and unique within an R session, at least for first n reprexes
aa <- reprex_aa()
if (in_temp_dir) {
# wd not specified --> reprex in sub-directory of session temp directory
# example: /private/var/.../.../.../reprex-98183d9c49-prior-boa/prior-boa
target_dir <- path_real(dir_create(glue("{ugly_dir}-{aa}")))
path(target_dir, aa)
} else {
# no infile, wd is specified
# example: prior-boa
aa
}
}
make_filebase <- function(infile = NULL, wd = NULL) {
if (is.null(infile)) {
if (is.null(wd)) {
reprex_default_filebase(in_temp_dir = TRUE)
} else {
if (wd == ".") {
reprex_default_filebase(in_temp_dir = FALSE)
} else {
path(wd, reprex_default_filebase(in_temp_dir = FALSE))
}
}
} else {
path_ext_remove(infile)
}
}
add_suffix <- function(x, suffix = "reprex") {
if (!nzchar(suffix)) {
return(x)
}
orig_ext <- path_ext(x)
filebase <- path_ext_remove(x)
suffix <- paste0("_", suffix)
if (endsWith(filebase, suffix)) {
return(x)
}
path_ext_set(paste0(filebase, suffix), orig_ext)
}
path_mutate <- function(path, suffix = "", ext = NULL) {
if (nzchar(suffix)) {
path <- add_suffix(path, suffix)
}
if (!is.null(ext)) {
path <- path_ext_set(path, ext)
}
path
}
r_file <- function(path) {
path_mutate(path, suffix = "reprex", ext = "R")
}
r_file_clean <- function(path) {
path_mutate(path, suffix = "clean", ext = "R")
}
r_file_rendered <- function(path) {
path_mutate(path, suffix = "r", ext = "R")
}
md_file <- function(path) {
path_mutate(path, ext = "md")
}
md_file_slack <- function(path) {
path_mutate(path, suffix = "slack", ext = "md")
}
std_file <- function(path) {
path_mutate(path, suffix = "std_out_err", ext = "txt")
}
html_file <- function(path) {
path_mutate(path, ext = "html")
}
rtf_file <- function(path) {
path_mutate(path, ext = "rtf")
}
rmd_file <- function(path) {
path_mutate(path, suffix = "reprex", ext = "Rmd")
}
preview_file <- function(path) {
path_mutate(path, suffix = "preview", ext = "html")
}
would_clobber <- function(path) {
if (!file_exists(path)) {
return(FALSE)
}
reprex_path("Oops, file already exists:", path, type = "warning")
if (!is_interactive()) {
return(TRUE)
}
nope("Carry on and overwrite it?")
}
# goals in order of preference:
# 1. put reprex output on clipboard
# 2. open file for manual copy
expose_reprex_output <- function(reprex_file, rtf = FALSE) {
if (reprex_clipboard()) {
if (rtf && is_windows()) {
write_clip_windows_rtf(reprex_file)
} else {
clipr::write_clip(read_lines(reprex_file))
}
reprex_success("Reprex output is on the clipboard.")
return(invisible())
}
if (!is_interactive()) {
return(invisible())
}
if (rtf) {
reprex_path("Attempting to open RTF output file:", reprex_file)
utils::browseURL(reprex_file)
return(invisible())
}
reprex_path("Opening output file for manual copy:", reprex_file)
if (in_rstudio()) {
rstudio_open_and_select_all(reprex_file)
} else {
withr::defer_parent(utils::file.edit(reprex_file))
}
invisible()
}
rstudio_open_and_select_all <- function(path) {
rstudioapi::navigateToFile(path)
# navigateToFile() is not synchronous, hence the while loop & sleep
# it takes an indeterminate amount of time for the active source file to
# actually be 'path'
#
# DO NOT fiddle with this unless you also do thorough manual tests,
# including on RSP, Cloud, using reprex() and the addin and the gadget
ct <- rstudioapi::getSourceEditorContext()
i <- 0
while (ct$path == "" || path_real(ct$path) != path_real(path)) {
if (i > 4) break
i <- i + 1
Sys.sleep(1)
ct <- rstudioapi::getSourceEditorContext()
}
rg <- rstudioapi::document_range(
start = rstudioapi::document_position(1, 1),
end = rstudioapi::document_position(Inf, Inf)
)
rstudioapi::setSelectionRanges(rg, id = ct$id)
invisible()
}
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.