1 2enc2path <- function(x) { 3 if (is_windows()) { 4 enc2utf8(x) 5 } else { 6 enc2native(x) 7 } 8} 9 10`%||%` <- function(l, r) if (is.null(l)) r else l 11 12os_type <- function() { 13 .Platform$OS.type 14} 15 16is_windows <- function() { 17 .Platform$OS.type == "windows" 18} 19 20is_linux <- function() { 21 identical(tolower(Sys.info()[["sysname"]]), "linux") 22} 23 24last_char <- function(x) { 25 nc <- nchar(x) 26 substring(x, nc, nc) 27} 28 29# Given a filename, return an absolute path to that file. This has two important 30# differences from normalizePath(). (1) The file does not need to exist, and (2) 31# the path is merely absolute, whereas normalizePath() returns a canonical path, 32# which resolves symbolic links, gives canonical case, and, on Windows, may give 33# short names. 34# 35# On Windows, the returned path includes the drive ("C:") or network server 36# ("//myserver"). 37full_path <- function(path) { 38 assert_that(is_string(path)) 39 40 # Try expanding "~" 41 path <- path.expand(path) 42 43 # If relative path, prepend current dir. On Windows, also record current 44 # drive. 45 if (is_windows()) { 46 path <- gsub("\\", "/", path, fixed = TRUE) 47 48 if (grepl("^[a-zA-Z]:", path)) { 49 drive <- substring(path, 1, 2) 50 path <- substring(path, 3) 51 52 } else if (substring(path, 1, 2) == "//") { 53 # Extract server name, like "//server", and use as drive. 54 pos <- regexec("^(//[^/]*)(.*)", path)[[1]] 55 drive <- substring(path, pos[2], attr(pos, "match.length", exact = TRUE)[2]) 56 path <- substring(path, pos[3]) 57 58 # Must have a name, like "//server" 59 if (drive == "//") 60 throw(new_error("Server name not found in network path.")) 61 62 } else { 63 drive <- substring(getwd(), 1, 2) 64 65 if (substr(path, 1, 1) != "/") 66 path <- substring(file.path(getwd(), path), 3) 67 } 68 69 } else { 70 if (substr(path, 1, 1) != "/") 71 path <- file.path(getwd(), path) 72 } 73 74 parts <- strsplit(path, "/")[[1]] 75 76 # Collapse any "..", ".", and "" in path. 77 i <- 2 78 while (i <= length(parts)) { 79 if (parts[i] == "." || parts[i] == "") { 80 parts <- parts[-i] 81 82 } else if (parts[i] == "..") { 83 if (i == 2) { 84 parts <- parts[-i] 85 } else { 86 parts <- parts[-c(i-1, i)] 87 i <- i-1 88 } 89 } else { 90 i <- i+1 91 } 92 } 93 94 new_path <- paste(parts, collapse = "/") 95 if (new_path == "") 96 new_path <- "/" 97 98 if (is_windows()) 99 new_path <- paste0(drive, new_path) 100 101 new_path 102} 103 104vcapply <- function (X, FUN, ..., USE.NAMES = TRUE) { 105 vapply(X, FUN, FUN.VALUE = character(1), ..., USE.NAMES = USE.NAMES) 106} 107 108do_echo_cmd <- function(command, args) { 109 quoted <- sh_quote_smart(c("Running", command, args)) 110 111 out <- str_wrap_words(quoted, width = getOption("width") - 3) 112 113 if ((len <- length(out)) > 1) { 114 out[1:(len - 1)] <- paste0(out[1:(len - 1)], " \\") 115 } 116 cat(out, sep = "\n") 117} 118 119sh_quote_smart <- function(x) { 120 if (!length(x)) return(x) 121 ifelse(grepl("^[-a-zA-Z0-9/_\\.]*$", x), x, shQuote(x)) 122} 123 124strrep <- function(x, times) { 125 x <- as.character(x) 126 if (length(x) == 0L) return(x) 127 r <- .mapply( 128 function(x, times) { 129 if (is.na(x) || is.na(times)) return(NA_character_) 130 if (times <= 0L) return("") 131 paste0(replicate(times, x), collapse = "") 132 }, 133 list(x = x, times = times), 134 MoreArgs = list() 135 ) 136 137 unlist(r, use.names = FALSE) 138} 139 140str_wrap_words <- function(words, width, indent = 0, exdent = 2) { 141 word_widths <- nchar(words, type = "width") 142 out <- character() 143 144 current_width <- indent 145 current_line <- strrep(" ", indent) 146 first_word <- TRUE 147 148 i <- 1 149 while (i <= length(words)) { 150 if (first_word) { 151 current_width <- current_width + word_widths[i] 152 current_line <- paste0(current_line, words[i]) 153 first_word <- FALSE 154 i <- i + 1 155 156 } else if (current_width + 1 + word_widths[i] <= width) { 157 current_width <- current_width + word_widths[i] + 1 158 current_line <- paste0(current_line, " ", words[i]) 159 i <- i + 1 160 161 } else { 162 out <- c(out, current_line) 163 current_width <- exdent 164 current_line <- strrep(" ", exdent) 165 first_word <- TRUE 166 } 167 } 168 169 if (!first_word) out <- c(out, current_line) 170 171 out 172} 173 174set_names <- function(x, n) { 175 names(x) <- n 176 x 177} 178 179get_private <- function(x) { 180 x$.__enclos_env__$private 181} 182 183get_tool <- function(prog) { 184 if (os_type() == "windows") prog <- paste0(prog, ".exe") 185 exe <- system.file(package = "processx", "bin", .Platform$r_arch, prog) 186 if (exe == "") { 187 pkgpath <- system.file(package = "processx") 188 if (basename(pkgpath) == "inst") pkgpath <- dirname(pkgpath) 189 exe <- file.path(pkgpath, "src", "tools", prog) 190 if (!file.exists(exe)) return("") 191 } 192 exe 193} 194 195get_id <- function() { 196 paste0( 197 "PS", 198 paste(sample(c(LETTERS, 0:9), 10, replace = TRUE), collapse = ""), 199 "_", as.integer(asNamespace("base")$.Internal(Sys.time())) 200 ) 201} 202 203format_unix_time <- function(z) { 204 structure(z, class = c("POSIXct", "POSIXt"), tzone = "GMT") 205} 206 207file_size <- function(x) { 208 if (getRversion() >= "3.2.0") { 209 file.info(x, extra_cols = FALSE)$size 210 } else { 211 file.info(x)$size 212 } 213} 214 215disable_crash_dialog <- function() { 216 rethrow_call(c_processx_disable_crash_dialog) 217} 218 219has_package <- function(pkg) { 220 requireNamespace(pkg, quietly = TRUE) 221} 222 223tty_echo_off <- function() { 224 rethrow_call(c_processx__echo_off) 225} 226 227tty_echo_on <- function() { 228 rethrow_call(c_processx__echo_on) 229} 230 231str_trim <- function(x) { 232 sub("^\\s+", "", sub("\\s+$", "", x)) 233} 234 235new_not_implemented_error <- function(message, call) { 236 add_class(new_error(message, call. = call), 237 c("not_implemented_error", "not_implemented")) 238} 239 240add_class <- function(obj, class) { 241 class(obj) <- c(class, class(obj)) 242 obj 243} 244 245is_interactive <- function() { 246 opt <- getOption("rlib_interactive") 247 if (isTRUE(opt)) { 248 TRUE 249 } else if (identical(opt, FALSE)) { 250 FALSE 251 } else if (tolower(getOption("knitr.in.progress", "false")) == "true") { 252 FALSE 253 } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") { 254 FALSE 255 } else if (identical(Sys.getenv("TESTTHAT"), "true")) { 256 FALSE 257 } else { 258 interactive() 259 } 260} 261 262make_buffer <- function() { 263 con <- file(open = "w+b") 264 size <- 0L 265 list( 266 push = function(text) { 267 size <<- size + nchar(text, type = "bytes") 268 cat(text, file = con) 269 }, 270 read = function() { 271 readChar(con, size, useBytes = TRUE) 272 }, 273 done = function() { 274 close(con) 275 } 276 ) 277} 278 279update_vector <- function(x, y = NULL) { 280 if (length(y) == 0L) return(x) 281 c(x[!(names(x) %in% names(y))], y) 282} 283 284process_env <- function(env) { 285 current <- env == "current" & names(env) == "" 286 if (any(current)) env <- update_vector(Sys.getenv(), env[!current]) 287 enc2path(paste(names(env), sep = "=", env)) 288} 289