r-lib / cli
1

2
## This is how the RDS file is created:
3

4
'
5
json <- "https://raw.githubusercontent.com/sindresorhus/cli-spinners/dac4fc6571059bb9e9bc204711e9dfe8f72e5c6f/spinners.json"
6
parsed <- jsonlite::fromJSON(json, simplifyVector = TRUE)
7
pasis <- lapply(parsed, function(x) { x$frames <- I(x$frames); x })
8
pdt <- as.data.frame(do.call(rbind, pasis))
9
pdt$name <- rownames(pdt)
10
rownames(pdt) <- NULL
11
spinners <- pdt[, c("name", "interval", "frames")]
12
usethis::use_data(spinners, internal = TRUE)
13
'
14

15
#' Character vector to put a spinner on the screen
16
#'
17
#' `cli` contains many different spinners, you choose one according to your
18
#' taste.
19
#'
20
#' @param which The name of the chosen spinner. The default depends on
21
#'   whether the platform supports Unicode.
22
#' @return A list with entries: `name`, `interval`: the suggested update
23
#'   interval in milliseconds and `frames`: the character vector of the
24
#'   spinner's frames.
25
#'
26
#' @family spinners
27
#' @export
28
#' @examples
29
#' get_spinner()
30
#' get_spinner("shark")
31

32
get_spinner <- function(which = NULL) {
33 1
  assert_that(is.null(which) || is_string(which))
34

35 1
  if (is.null(which)) {
36 1
    which <- if (is_utf8_output()) "dots" else "line"
37
  }
38

39 1
  row <- match(which, spinners$name)
40 1
  list(
41 1
    name = which,
42 1
    interval = spinners$interval[[row]],
43 1
    frames = spinners$frames[[row]])
44
}
45

46
#' List all available spinners
47
#'
48
#' @return Character vector of all available spinner names.
49
#'
50
#' @family spinners
51
#' @export
52
#' @examples
53
#' list_spinners()
54
#' get_spinner(list_spinners()[1])
55

56
list_spinners <- function() {
57 1
  spinners$name
58
}
59

60
#' Create a spinner
61
#'
62
#' @param template A template string, that will contain the spinner. The
63
#'   spinner itself will be substituted for `{spin}`. See example below.
64
#' @param stream The stream to use for the spinner. Typically this is
65
#'   standard error, or maybe the standard output stream.
66
#' @param static What to do if the terminal does not support dynamic
67
#'   displays:
68
#'   * `"dots"`: show a dot for each `$spin()` call.
69
#'   * `"print"`: just print the frames of the spinner, one after another.
70
#'   * `"print_line"`: print the frames of the spinner, each on its own line.
71
#'   * `"silent"` do not print anything, just the `template`.
72
#' @inheritParams get_spinner
73
#' @return A `cli_spinner` object, which is a list of functions. See
74
#'   its methods below.
75
#'
76
#' `cli_spinner` methods:
77
#' * `$spin()`: output the next frame of the spinner.
78
#' * `$finish()`: terminate the spinner. Depending on terminal capabilities
79
#'   this removes the spinner from the screen. Spinners can be reused,
80
#'   you can start calling the `$spin()` method again.
81
#'
82
#' All methods return the spinner object itself, invisibly.
83
#'
84
#' The spinner is automatically throttled to its ideal update frequency.
85
#'
86
#' @section Examples:
87
#' ```
88
#' ## Default spinner
89
#' sp1 <- make_spinner()
90
#' fun_with_spinner <- function() {
91
#'   lapply(1:100, function(x) { sp1$spin(); Sys.sleep(0.05) })
92
#'   sp1$finish()
93
#' }
94
#' ansi_with_hidden_cursor(fun_with_spinner())
95
#'
96
#' ## Spinner with a template
97
#' sp2 <- make_spinner(template = "Computing {spin}")
98
#' fun_with_spinner2 <- function() {
99
#'   lapply(1:100, function(x) { sp2$spin(); Sys.sleep(0.05) })
100
#'   sp2$finish()
101
#' }
102
#' ansi_with_hidden_cursor(fun_with_spinner2())
103
#'
104
#' ## Custom spinner
105
#' sp3 <- make_spinner("simpleDotsScrolling", template = "Downloading {spin}")
106
#' fun_with_spinner3 <- function() {
107
#'   lapply(1:100, function(x) { sp3$spin(); Sys.sleep(0.05) })
108
#'   sp2$finish()
109
#' }
110
#' ansi_with_hidden_cursor(fun_with_spinner3())
111
#' ```
112
#'
113
#' @family spinners
114
#' @export
115

116
make_spinner <- function(which = NULL, stream = stderr(), template = "{spin}",
117
                         static = c("dots", "print", "print_line",
118
                                    "silent")) {
119

120 0
  assert_that(
121 0
    inherits(stream, "connection"),
122 0
    is_string(template))
123

124 0
  c_stream <- stream
125 0
  c_spinner <- get_spinner(which)
126 0
  c_template <- template
127 0
  c_static <- match.arg(static)
128 0
  c_state <- 1L
129 0
  c_first <- TRUE
130 0
  c_col <- 1L
131 0
  c_width <- console_width()
132 0
  c_last <- Sys.time() - as.difftime(1, units = "secs")
133 0
  c_int <- as.difftime(c_spinner$interval / 1000, units = "secs")
134

135 0
  c_res <- list()
136

137 0
  throttle <- function() Sys.time() - c_last < c_int
138 0
  clear_line <- function() {
139 0
    str <- paste0(c("\r", rep(" ", c_width), "\r"), collapse = "")
140 0
    cat(str, file = c_stream)
141
  }
142 0
  inc <- function() {
143 0
    c_state <<- c_state + 1L
144 0
    c_first <<- FALSE
145 0
    if (c_state > length(c_spinner$frames)) c_state <<- 1L
146 0
    c_last <<- Sys.time()
147 0
    invisible(c_res)
148
  }
149

150 0
  c_res$finish <- function() {
151 0
    c_state <<- 1L
152 0
    c_first <<- TRUE
153 0
    c_col <<- 1L
154 0
    c_last <<- Sys.time()
155 0
    if (is_dynamic_tty()) clear_line() else cat("\n", file = c_stream)
156 0
    invisible(c_res)
157
  }
158

159 0
  if (is_dynamic_tty()) {
160 0
    c_res$spin <- function(template = NULL) {
161 0
      if (!is.null(template)) c_template <<- template
162 0
      if (throttle()) return()
163 0
      line <- sub("{spin}", c_spinner$frames[[c_state]], c_template,
164 0
                  fixed = TRUE)
165 0
      cat("\r", line, sep = "", file = stream)
166 0
      inc()
167
    }
168

169
  } else {
170 0
    if (c_static == "dots") {
171 0
      c_res$spin <- function(template = NULL) {
172 0
        if (!is.null(template)) c_template <<- template
173 0
        if (c_first) cat(template, "\n", sep = "", file = c_stream)
174 0
        if (throttle()) return()
175 0
        cat(".", file = c_stream)
176 0
        c_col <<- c_col + 1L
177 0
        if (c_col == c_width) {
178 0
          cat("\n", file = c_stream)
179 0
          c_col <<- 1L
180
        }
181 0
        inc()
182
      }
183 0
    } else if (c_static == "print") {
184 0
      c_res$spin <- function(template = NULL) {
185 0
        if (!is.null(template)) c_template <<- template
186 0
        if (throttle()) return()
187 0
        line <- sub("{spin}", c_spinner$frames[[c_state]], c_template,
188 0
                    fixed = TRUE)
189 0
        cat(line, file = stream)
190 0
        inc()
191
      }
192 0
    } else if (c_static == "print_line") {
193 0
      c_res$spin <- function(template = NULL) {
194 0
        if (!is.null(template)) c_template <<- template
195 0
        if (throttle()) return()
196 0
        line <- sub("{spin}", c_spinner$frames[[c_state]], c_template,
197 0
                    fixed = TRUE)
198 0
        cat(line, "\n", sep = "", file = stream)
199 0
        inc()
200
      }
201 0
    } else if (c_static == "silent") {
202 0
      c_res$spin <- function(template = NULL) {
203 0
        if (!is.null(template)) c_template <<- template
204 0
        if (throttle()) return()
205 0
        inc()
206
      }
207
    }
208
  }
209

210 0
  class(c_res) <- "cli_spinner"
211 0
  c_res
212
}
213

214
#' @export
215

216
print.cli_spinner <- function(x, ...) {
217 0
  cat("<cli_spinner>\n")
218 0
  invisible(x)
219
}
220

221
## nocov start
222

223
#' Show a demo of some (by default all) spinners
224
#'
225
#' Each spinner is shown for about 2-3 seconds.
226
#'
227
#' @param which Character vector, which spinners to demo.
228
#'
229
#' @family spinners
230
#' @export
231
#' @examples
232
#' \dontrun{
233
#'   demo_spinners(sample(list_spinners(), 10))
234
#' }
235

236
demo_spinners <- function(which = NULL) {
237
  assert_that(is.null(which) || is.character(which))
238

239
  all <- list_spinners()
240
  which <- which %||% all
241

242
  if (length(bad <- setdiff(which, all))) {
243
    stop("Unknown spinners: ", paste(bad, collapse = ", "))
244
  }
245

246
  for (w in which) {
247
    sp <- get_spinner(w)
248
    interval <- sp$interval / 1000
249
    frames <- sp$frames
250
    cycles <- max(round(2.5 / ((length(frames) - 1) * interval)), 1)
251
    for (i in 1:(length(frames) * cycles) - 1) {
252
      fr <- unclass(frames[i %% length(frames) + 1])
253
      cat("\r", rpad(fr, width = 10), w, sep = "")
254
      Sys.sleep(interval)
255
    }
256
    cat("\n")
257
  }
258
}
259

260
demo_spinners_terminal <- function() {
261
  up <- function(n) cat(paste0("\u001B[", n, "A"))
262
  show <- function() cat("\u001b[?25h")
263
  hide <- function() cat("\u001b[?25l")
264

265
  on.exit(show(), add = TRUE)
266

267
  names <- unlist(spinners$name)
268
  frames <- spinners$frames
269
  intervals <- unlist(spinners$interval)
270
  num_frames <- viapply(frames, length)
271
  spin_width <- viapply(frames, function(x) max(nchar(x, type = "width")))
272
  name_width <- nchar(names, type = "width")
273
  col_width <- spin_width + max(name_width) + 3
274
  col1_width <- max(col_width[1:(length(col_width)/2)])
275

276
  frames <- mapply(
277
    frames,
278
    names,
279
    FUN = function(f, n) {
280
      rpad(paste(lpad(n, max(name_width) + 2), f), col1_width)
281
    }
282
  )
283

284
  hide()
285

286
  for (tick in 0:1000000) {
287
    tic <- Sys.time()
288
    wframe <- trunc(tick / intervals) %% num_frames + 1
289
    sp <- mapply(frames, wframe, FUN = "[")
290

291
    sp2 <- paste(
292
      sep = "  ",
293
      sp[1:(length(sp) / 2)],
294
      sp[(length(sp) / 2 + 1):length(sp)]
295
    )
296

297
    cat(sp2, sep = "\n")
298
    up(length(sp2))
299
    took <- Sys.time() - tic
300
    togo <- as.difftime(1/1000, units = "secs") - took
301
    if (togo > 0) Sys.sleep(togo)
302
  }
303

304
}
305

306
## nocov end

Read our documentation on viewing source code .

Loading