r-lib / cli
1

2
is_interactive <- function() {
3 1
  opt <- getOption("rlib_interactive")
4 1
  if (isTRUE(opt)) {
5 1
    TRUE
6 1
  } else if (identical(opt, FALSE)) {
7 1
    FALSE
8 1
  } else if (tolower(getOption("knitr.in.progress", "false")) == "true") {
9 0
    FALSE
10 1
  } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") {
11 0
    FALSE
12 1
  } else if (identical(Sys.getenv("TESTTHAT"), "true")) {
13 1
    FALSE
14
  } else {
15 0
    interactive()
16
  }
17
}
18

19
#' The connection option that cli would use
20
#'
21
#' Note that this only refers to the current R process. If the output
22
#' is produced in another process, then it is not relevant.
23
#'
24
#' In interactive sessions the standard output is chosen, othrwise the
25
#' standard error is used. This is to avoid painting output messages red
26
#' in the R GUIs.
27
#'
28
#' @return Connection object.
29
#'
30
#' @export
31

32
cli_output_connection <- function() {
33 1
  if (is_interactive() && no_sink()) stdout() else stderr()
34
}
35

36
no_sink <- function() {
37 1
  sink.number() == 0 && sink.number("message") == 2
38
}
39

40
is_stdout <- function(stream) {
41 0
  identical(stream, stdout()) && sink.number() == 0
42
}
43

44
is_stderr <- function(stream) {
45 0
  identical(stream, stderr()) && sink.number("message") == 2
46
}
47

48
is_stdx <- function(stream){
49 0
  is_stdout(stream) || is_stderr(stream)
50
}
51

52
is_rstudio_dynamic_tty <- function(stream) {
53 0
  rstudio$detect()[["dynamic_tty"]] &&
54 0
    (is_stdout(stream) || is_stderr(stream))
55
}
56

57
is_rapp <- function() {
58 0
  Sys.getenv("R_GUI_APP_VERSION") != ""
59
}
60

61
is_rapp_stdx <- function(stream) {
62 0
  interactive() &&
63 0
    is_rapp() &&
64 0
    (is_stdout(stream) || is_stderr(stream))
65
}
66

67
is_emacs <- function() {
68 0
  Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != ""
69
}
70

71
is_rkward <- function() {
72 0
  "rkward" %in% (.packages())
73
}
74

75
is_rkward_stdx <- function(stream) {
76 0
  interactive() &&
77 0
    is_rkward() &&
78 0
    (is_stdout(stream) || is_stderr(stream))
79
}
80

81
#' Detect whether a stream supports `\\r` (Carriage return)
82
#'
83
#' In a terminal, `\\r` moves the cursor to the first position of the
84
#' same line. It is also supported by most R IDEs. `\\r` is typically
85
#' used to achive a more dynamic, less cluttered user interface, e.g.
86
#' to create progress bars.
87
#'
88
#' If the output is directed to a file, then `\\r` characters are typically
89
#' unwanted. This function detects if `\\r` can be used for the given
90
#' stream or not.
91
#'
92
#' The detection mechanism is as follows:
93
#' 1. If the `cli.dynamic` option is set to `TRUE`, `TRUE` is returned.
94
#' 2. If the `cli.dynamic` option is set to anything else, `FALSE` is
95
#'    returned.
96
#' 3. If the `R_CLI_DYNAMIC` environment variable is not empty and set to
97
#'    the string `"true"`, `"TRUE"` or `"True"`, `TRUE` is returned.
98
#' 4. If `R_CLI_DYNAMIC` is not empty and set to anything else, `FALSE` is
99
#'    returned.
100
#' 5. If the stream is a terminal, then `TRUE` is returned.
101
#' 6. If the stream is the standard output or error within RStudio,
102
#'    the macOS R app, or RKWard IDE, `TRUE` is returned.
103
#' 7. Otherwise `FALSE` is returned.
104
#'
105
#' @param stream The stream to inspect or manipulate, an R connection
106
#' object. It can also be a string, one of `"auto"`, `"message"`,
107
#' `"stdout"`, `"stderr"`. `"auto"` will select `stdout()` if the session is
108
#' interactive and there are no sinks.
109
#'
110
#' @family terminal capabilities
111
#' @export
112
#' @examples
113
#' is_dynamic_tty()
114
#' is_dynamic_tty(stdout())
115

116
is_dynamic_tty <- function(stream = "auto") {
117

118 0
  stream <- get_real_output(stream)
119

120
  ## Option?
121 0
  if (!is.null(x <- getOption("cli.dynamic"))) {
122 0
    return(isTRUE(x))
123
  }
124

125
  ## Env var?
126 0
  if ((x <- Sys.getenv("R_CLI_DYNAMIC", "")) != "") {
127 0
    return(isTRUE(as.logical(x)))
128
  }
129

130
  ## Autodetect...
131
  ## RGui has isatty(stdout()) and isatty(stderr()), so we don't need
132
  ## to check that explicitly
133 0
  isatty(stream) ||
134 0
    is_rstudio_dynamic_tty(stream) ||
135 0
    is_rapp_stdx(stream) ||
136 0
    is_rkward_stdx(stream)
137
}
138

139
ANSI_ESC <- "\u001B["
140
ANSI_HIDE_CURSOR <- paste0(ANSI_ESC, "?25l")
141
ANSI_SHOW_CURSOR <- paste0(ANSI_ESC, "?25h")
142
ANSI_EL <- paste0(ANSI_ESC, "K")
143

144
#' Detect if a stream support ANSI escape characters
145
#'
146
#' We check that all of the following hold:
147
#' * The stream is a terminal.
148
#' * The platform is Unix.
149
#' * R is not running inside R.app (the macOS GUI).
150
#' * R is not running inside RStudio.
151
#' * R is not running inside Emacs.
152
#' * The terminal is not "dumb".
153
#' * `stream` is either the standard output or the standard error stream.
154
#'
155
#' @inheritParams is_dynamic_tty
156
#' @return `TRUE` or `FALSE`.
157
#'
158
#' @family terminal capabilities
159
#' @export
160
#' @examples
161
#' is_ansi_tty()
162

163
is_ansi_tty <- function(stream = "auto") {
164

165 1
  stream <- get_real_output(stream)
166

167
  # Option takes precedence
168 1
  opt <- getOption("cli.ansi")
169 1
  if (isTRUE(opt)) {
170 0
    return(TRUE)
171 1
  } else if (identical(opt, FALSE)) {
172 1
    return(FALSE)
173
  }
174

175
  # RStudio is handled separately
176 0
  if (rstudio$detect()[["ansi_tty"]] && is_stdx(stream)) return(TRUE)
177

178 1
  isatty(stream) &&
179 1
    .Platform$OS.type == "unix" &&
180 1
    !is_rapp() &&
181 1
    !is_emacs() &&
182 1
    Sys.getenv("TERM", "") != "dumb" &&
183 1
    is_stdx(stream)
184
}
185

186
#' Hide/show cursor in a terminal
187
#'
188
#' This only works in terminal emulators. In other environments, it
189
#' does nothing.
190
#'
191
#' `ansi_hide_cursor()` hides the cursor.
192
#'
193
#' `ansi_show_cursor()` shows the cursor.
194
#'
195
#' `ansi_with_hidden_cursor()` temporarily hides the cursor for
196
#' evaluating an expression.
197
#'
198
#' @inheritParams is_dynamic_tty
199
#' @param expr R expression to evaluate.
200
#'
201
#' @family terminal capabiltiies
202
#' @export
203

204
ansi_hide_cursor <- function(stream = "auto") {
205 0
  stream <- get_real_output(stream)
206 0
  if (is_ansi_tty(stream)) cat(ANSI_HIDE_CURSOR, file = stream)
207
}
208

209
#' @export
210
#' @name ansi_hide_cursor
211

212
ansi_show_cursor <- function(stream = "auto") {
213 0
  stream <- get_real_output(stream)
214 0
  if (is_ansi_tty(stream)) cat(ANSI_SHOW_CURSOR, file = stream)
215
}
216

217
#' @export
218
#' @name ansi_hide_cursor
219

220
ansi_with_hidden_cursor <- function(expr, stream = "auto") {
221 0
  stream <- get_real_output(stream)
222 0
  ansi_hide_cursor(stream)
223 0
  on.exit(ansi_show_cursor(), add = TRUE)
224 0
  expr
225
}

Read our documentation on viewing source code .

Loading