r-lib / cli
1

2
cliappenv <- new.env()
3
cliappenv$stack <- list()
4
cliappenv$pid <- Sys.getpid()
5

6
#' Start, stop, query the default cli application
7
#'
8
#' `start_app` creates an app, and places it on the top of the app stack.
9
#'
10
#' `stop_app` removes the top app, or multiple apps from the app stack.
11
#'
12
#' `default_app` returns the default app, the one on the top of the stack.
13
#'
14
#' @param theme Theme to use.
15
#' @param output How to print the output.
16
#' @param .auto_close Whether to stop the app, when the calling frame
17
#'   is destroyed.
18
#' @param .envir The environment to use, instead of the calling frame,
19
#'   to trigger the stop of the app.
20
#' @param app App to stop. If `NULL`, the current default app is stopped.
21
#'   Otherwise we find the supplied app in the app stack, and remote it,
22
#'   together with all the apps above it.
23
#' @return
24
#'   `start_app` returns the new app, `default_app` returns the default app.
25
#'   `stop_app` does not return anything.
26
#'
27
#' @export
28

29
start_app <- function(theme = getOption("cli.theme"),
30
                      output = c("auto", "message", "stdout", "stderr"),
31
                      .auto_close = TRUE, .envir = parent.frame()) {
32

33 1
  if (! inherits(output, "connection")) output <- match.arg(output)
34

35 1
  app <- cliapp(
36 1
    theme = theme,
37 1
    user_theme = getOption("cli.user_theme"),
38 1
    output = output
39
  )
40 1
  cliappenv$stack[[length(cliappenv$stack) + 1]] <- app
41

42 1
  if (.auto_close && !identical(.envir, globalenv())) {
43 1
    defer(stop_app(app = app), envir = .envir, priority = "first")
44
  }
45

46 1
  invisible(app)
47
}
48

49
#' @export
50
#' @importFrom utils head
51
#' @name start_app
52

53
stop_app <- function(app = NULL) {
54 1
  if (is.null(app)) {
55 1
    cliappenv$stack <- head(cliappenv$stack, -1)
56

57
  } else {
58 0
    if (!inherits(app, "cliapp")) stop("Not a CLI app")
59 1
    ndl <- format.default(app)
60 1
    nms <- vapply(cliappenv$stack, format.default, character(1))
61 1
    if (! ndl %in% nms) {
62 0
      warning("No app to end")
63 0
      return()
64
    }
65 1
    wh <- which(nms == ndl)[1]
66 1
    cliappenv$stack <- head(cliappenv$stack, wh - 1)
67
  }
68

69 1
  invisible()
70
}
71

72
#' @export
73
#' @importFrom utils tail
74
#' @name start_app
75

76
default_app <- function() {
77 1
  top <- tail(cliappenv$stack, 1)
78 1
  if (length(top)) top[[1]] else NULL
79
}

Read our documentation on viewing source code .

Loading