1#' User interface 2#' 3#' @description 4#' These functions are used to construct the user interface of usethis. Use 5#' them in your own package so that your `use_` functions work the same way 6#' as usethis. 7#' 8#' The `ui_` functions can be broken down into four main categories: 9#' 10#' * block styles: `ui_line()`, `ui_done()`, `ui_todo()`, `ui_oops()`, 11#' `ui_info()`. 12#' * conditions: `ui_stop()`, `ui_warn()`. 13#' * questions: [ui_yeah()], [ui_nope()]. 14#' * inline styles: `ui_field()`, `ui_value()`, `ui_path()`, `ui_code()`, 15#' `ui_unset()`. 16#' 17#' The question functions [ui_yeah()] and [ui_nope()] have their own [help 18#' page][ui-questions]. 19#' 20#' @section Silencing output: 21#' All UI output (apart from `ui_yeah()`/`ui_nope()` prompts) can be silenced 22#' by setting `options(usethis.quiet = TRUE)`. Use `ui_silence()` to silence 23#' selected actions. 24#' 25#' @param x A character vector. 26#' 27#' For block styles, conditions, and questions, each element of the 28#' vector becomes a line, and the result is processed by [glue::glue()]. 29#' For inline styles, each element of the vector becomes an entry in a 30#' comma separated list. 31#' @param .envir Used to ensure that [glue::glue()] gets the correct 32#' environment. For expert use only. 33#' 34#' @return The block styles, conditions, and questions are called for their 35#' side-effect. The inline styles return a string. 36#' @keywords internal 37#' @family user interface functions 38#' @name ui 39#' @examples 40#' new_val <- "oxnard" 41#' ui_done("{ui_field('name')} set to {ui_value(new_val)}") 42#' ui_todo("Redocument with {ui_code('devtools::document()')}") 43#' 44#' ui_code_block(c( 45#' "Line 1", 46#' "Line 2", 47#' "Line 3" 48#' )) 49NULL 50 51# Block styles ------------------------------------------------------------ 52 53#' @rdname ui 54#' @export 55ui_line <- function(x = character(), .envir = parent.frame()) { 56 x <- glue_collapse(x, "\n") 57 x <- glue(x, .envir = .envir) 58 ui_inform(x) 59} 60 61#' @rdname ui 62#' @export 63ui_todo <- function(x, .envir = parent.frame()) { 64 x <- glue_collapse(x, "\n") 65 x <- glue(x, .envir = .envir) 66 ui_bullet(x, crayon::red(cli::symbol$bullet)) 67} 68 69#' @rdname ui 70#' @export 71ui_done <- function(x, .envir = parent.frame()) { 72 x <- glue_collapse(x, "\n") 73 x <- glue(x, .envir = .envir) 74 ui_bullet(x, crayon::green(cli::symbol$tick)) 75} 76 77#' @rdname ui 78#' @export 79ui_oops <- function(x, .envir = parent.frame()) { 80 x <- glue_collapse(x, "\n") 81 x <- glue(x, .envir = .envir) 82 ui_bullet(x, crayon::red(cli::symbol$cross)) 83} 84 85#' @rdname ui 86#' @export 87ui_info <- function(x, .envir = parent.frame()) { 88 x <- glue_collapse(x, "\n") 89 x <- glue(x, .envir = .envir) 90 ui_bullet(x, crayon::yellow(cli::symbol$info)) 91} 92 93#' @param copy If `TRUE`, the session is interactive, and the clipr package 94#' is installed, will copy the code block to the clipboard. 95#' @rdname ui 96#' @export 97ui_code_block <- function(x, 98 copy = rlang::is_interactive(), 99 .envir = parent.frame()) { 100 x <- glue_collapse(x, "\n") 101 x <- glue(x, .envir = .envir) 102 103 block <- indent(x, " ") 104 block <- crayon::silver(block) 105 ui_inform(block) 106 107 if (copy && clipr::clipr_available()) { 108 x <- crayon::strip_style(x) 109 clipr::write_clip(x) 110 ui_inform(" [Copied to clipboard]") 111 } 112} 113 114# Conditions -------------------------------------------------------------- 115 116#' @rdname ui 117#' @export 118ui_stop <- function(x, .envir = parent.frame()) { 119 x <- glue_collapse(x, "\n") 120 x <- glue(x, .envir = .envir) 121 122 cnd <- structure( 123 class = c("usethis_error", "error", "condition"), 124 list(message = x) 125 ) 126 127 stop(cnd) 128} 129 130#' @rdname ui 131#' @export 132ui_warn <- function(x, .envir = parent.frame()) { 133 x <- glue_collapse(x, "\n") 134 x <- glue(x, .envir = .envir) 135 136 warning(x, call. = FALSE, immediate. = TRUE) 137} 138 139 140# Silence ----------------------------------------------------------------- 141 142#' @rdname ui 143#' @param code Code to execute with usual UI output silenced. 144#' @export 145ui_silence <- function(code) { 146 withr::with_options(list(usethis.quiet = TRUE), code) 147} 148 149# Questions --------------------------------------------------------------- 150 151#' User interface - Questions 152#' 153#' These functions are used to interact with the user by posing a simple yes or 154#' no question. For details on the other `ui_*()` functions, see the [ui] help 155#' page. 156#' 157#' @inheritParams ui 158#' @param yes A character vector of "yes" strings, which are randomly sampled to 159#' populate the menu. 160#' @param no A character vector of "no" strings, which are randomly sampled to 161#' populate the menu. 162#' @param n_yes An integer. The number of "yes" strings to include. 163#' @param n_no An integer. The number of "no" strings to include. 164#' @param shuffle A logical. Should the order of the menu options be randomly 165#' shuffled? 166#' 167#' @return A logical. `ui_yeah()` returns `TRUE` when the user selects a "yes" 168#' option and `FALSE` otherwise, i.e. when user selects a "no" option or 169#' refuses to make a selection (cancels). `ui_nope()` is the logical opposite 170#' of `ui_yeah()`. 171#' @name ui-questions 172#' @keywords internal 173#' @family user interface functions 174#' @examples 175#' \dontrun{ 176#' ui_yeah("Do you like R?") 177#' ui_nope("Have you tried turning it off and on again?", n_yes = 1, n_no = 1) 178#' ui_yeah("Are you sure its plugged in?", yes = "Yes", no = "No", shuffle = FALSE) 179#' } 180NULL 181 182#' @rdname ui-questions 183#' @export 184ui_yeah <- function(x, 185 yes = c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely"), 186 no = c("No way", "Not now", "Negative", "No", "Nope", "Absolutely not"), 187 n_yes = 1, n_no = 2, shuffle = TRUE, 188 .envir = parent.frame()) { 189 x <- glue_collapse(x, "\n") 190 x <- glue(x, .envir = .envir) 191 192 if (!is_interactive()) { 193 ui_stop(c( 194 "User input required, but session is not interactive.", 195 "Query: {x}" 196 )) 197 } 198 199 n_yes <- min(n_yes, length(yes)) 200 n_no <- min(n_no, length(no)) 201 202 qs <- c(sample(yes, n_yes), sample(no, n_no)) 203 204 if (shuffle) { 205 qs <- sample(qs) 206 } 207 208 # TODO: should this be ui_inform()? 209 rlang::inform(x) 210 out <- utils::menu(qs) 211 out != 0L && qs[[out]] %in% yes 212} 213 214#' @rdname ui-questions 215#' @export 216ui_nope <- function(x, 217 yes = c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely"), 218 no = c("No way", "Not now", "Negative", "No", "Nope", "Absolutely not"), 219 n_yes = 1, n_no = 2, shuffle = TRUE, 220 .envir = parent.frame()) { 221 # TODO(jennybc): is this correct in the case of no selection / cancelling? 222 !ui_yeah( 223 x = x, yes = yes, no = no, 224 n_yes = n_yes, n_no = n_no, 225 shuffle = shuffle, 226 .envir = .envir 227 ) 228} 229 230# Inline styles ----------------------------------------------------------- 231 232#' @rdname ui 233#' @export 234ui_field <- function(x) { 235 x <- crayon::green(x) 236 x <- glue_collapse(x, sep = ", ") 237 x 238} 239 240#' @rdname ui 241#' @export 242ui_value <- function(x) { 243 if (is.character(x)) { 244 x <- encodeString(x, quote = "'") 245 } 246 x <- crayon::blue(x) 247 x <- glue_collapse(x, sep = ", ") 248 x 249} 250 251#' @rdname ui 252#' @export 253#' @param base If specified, paths will be displayed relative to this path. 254ui_path <- function(x, base = NULL) { 255 is_directory <- is_dir(x) | grepl("/$", x) 256 if (is.null(base)) { 257 x <- proj_rel_path(x) 258 } else if (!identical(base, NA)) { 259 x <- path_rel(x, base) 260 } 261 262 # rationalize trailing slashes 263 x <- path_tidy(x) 264 x <- ifelse(is_directory, paste0(x, "/"), x) 265 266 ui_value(x) 267} 268 269#' @rdname ui 270#' @export 271ui_code <- function(x) { 272 x <- encodeString(x, quote = "`") 273 x <- crayon::silver(x) 274 x <- glue_collapse(x, sep = ", ") 275 x 276} 277 278#' @rdname ui 279#' @export 280ui_unset <- function(x = "unset") { 281 stopifnot(length(x) == 1) 282 x <- glue("<{x}>") 283 x <- crayon::silver(x) 284 x 285} 286 287# rlang::inform() wrappers ----------------------------------------------------- 288 289indent <- function(x, first = " ", indent = first) { 290 x <- gsub("\n", paste0("\n", indent), x) 291 paste0(first, x) 292} 293 294ui_bullet <- function(x, bullet = cli::symbol$bullet) { 295 bullet <- paste0(bullet, " ") 296 x <- indent(x, bullet, " ") 297 ui_inform(x) 298} 299 300# All UI output must eventually go through ui_inform() so that it 301# can be quieted with 'usethis.quiet' when needed. 302ui_inform <- function(..., quiet = getOption("usethis.quiet", default = FALSE)) { 303 if (!quiet) { 304 inform(paste0(...)) 305 } 306 307 invisible() 308} 309 310# Sitrep helpers --------------------------------------------------------------- 311 312hd_line <- function(name) { 313 ui_inform(crayon::bold(name)) 314} 315 316kv_line <- function(key, value, .envir = parent.frame()) { 317 value <- if (is.null(value)) ui_unset() else ui_value(value) 318 key <- glue(key, .envir = .envir) 319 ui_inform(glue("{cli::symbol$bullet} {key}: {value}")) 320} 321