1
2#' Open a file, directory or URL
3#'
4#' Open a file, directory or URL, using the local platforms conventions,
5#' i.e. associated applications, default programs, etc. This is usually
6#' equivalent to double-clicking on the file in the GUI.
7#'
8#' @param target String, the path or URL to open.
9#' @param app Specify the app to open `target` with, and its arguments,
10#'   in a character vector. Note that app names are platform dependent.
11#' @param quiet Whether to echo the command to the screen, before
12#'   running it.
13#' @param ... Additional arguments, not used currently.
14#'
15#' @section Examples:
16#' ```
17#' xopen("test.R")
18#' xopen("https://ps.r-lib.org")
19#' xopen(tempdir())
20#' ```
21#' @export
22
23xopen <- function(target = NULL, app = NULL, quiet = FALSE, ...)
24  UseMethod("xopen")
25
26#' @export
27
28xopen.default <- function(target = NULL, app = NULL, quiet = FALSE, ...) {
29
30  xopen2(target, app, quiet)
31}
32
33xopen2 <- function(target, app, quiet, timeout1 = 2000, timeout2 = 5000) {
34
35  os <- get_os()
36  fun <- switch(os, win = xopen_win, macos = xopen_macos, xopen_other)
37  par <- fun(target, app)
38
39  err <- tempfile()
40  on.exit(unlink(err, recursive = TRUE), add = TRUE)
41  px <- processx::process$new(par[[1]], par[[2]], stderr = err,
42                              echo_cmd = !quiet)
43
44  ## Cleanup, if needed
45  if (par[[3]]) wait_for_finish(px, target, timeout1, timeout2)
46
47  invisible(px)
48}
49
50get_os <- function() {
51  if (.Platform$OS.type == "windows") {
52    "win"
53  } else if (Sys.info()[["sysname"]] == "Darwin") {
54    "macos"
55  } else {
56    "other"
57  }
58}
59
60xopen_macos <- function(target, app) {
61  cmd <- "open"
62  args <- if (length(app)) c("-a", app[1])
63  args <- c(args, target)
64  if (length(app)) args <- c(args, "--args", app[-1])
65  list(cmd, args, TRUE)
66}
67
68xopen_win <- function(target, app) {
69  cmd <- "cmd"
70  args <- c("/c", "start", "\"\"", "/b")
71  target <- gsub("&", "^&", target)
72  if (length(app)) args <- c(args, app)
73  args <- c(args, target)
74  list(cmd, args, TRUE)
75}
76
77xopen_other <- function(target, app) {
78  if (length(app)) {
79    cmd <- app[1]
80    args <- app[-1]
81    cleanup <- FALSE
82  } else  {
83    cmd <- Sys.which("xdg-open")
84    if (cmd == "") cmd <- system.file("xdg-open", package = "xopen")
85    args <- character()
86    cleanup <- TRUE
87  }
88  args <- c(args, target)
89  list(cmd, args, cleanup)
90}
91
92#' Wait for a process to finish
93#'
94#' With timeout(s), and interaction, if the session is interactive.
95#'
96#' First we wait for 2s. If the process is still alive, then we give
97#' it another 5s, but first let the user know that they can interrupt
98#' the process.
99#'
100#' @param process The process. It should not have `stdout` or `stderr`
101#'   pipes, because that can make it freeze.
102#' @param timeout1 Timeout before message.
103#' @param timeout2 Timeout after message.
104#'
105#' @keywords internal
106
107wait_for_finish <- function(process, target, timeout1 = 2000,
108                            timeout2 = 5000) {
109  on.exit(process$kill(), add = TRUE)
110  process$wait(timeout = timeout1)
111  if (process$is_alive()) {
112    message("Still trying to open ", encodeString(target, quote = "'"),
113            ", you can interrupt any time")
114    process$wait(timeout = timeout2)
115    process$kill()
116  }
117  if (stat <- process$get_exit_status()) {
118    err <- if (file.exists(ef <- process$get_error_file())) readLines(ef)
119    stop(
120      call. = FALSE,
121      "Could not open ", encodeString(target, quote = "'"), "\n",
122      "Exit status: ", stat, "\n",
123      if (length(err) && nzchar(err))
124        paste("Standard error:", err, collapse = "\n"))
125  }
126}
127