r-lib / cli
1

2
cliapp <- function(theme = getOption("cli.theme"),
3
                   user_theme = getOption("cli.user_theme"),
4
                   output = c("auto", "message", "stdout", "stderr")) {
5

6 1
  app <- new_class(
7 1
    "cliapp",
8

9 1
    new = function(theme, user_theme, output)
10 1
      clii_init(app, theme, user_theme, output),
11

12
    ## Themes
13 1
    list_themes = function()
14 1
      clii_list_themes(app),
15 1
    add_theme = function(theme)
16 1
      clii_add_theme(app, theme),
17 1
    remove_theme = function(id)
18 1
      clii_remove_theme(app, id),
19

20
    ## Close container(s)
21 1
    end = function(id = NULL)
22 1
      clii_end(app, id),
23

24
    ## Generic container
25 1
    div = function(id = NULL, class = NULL, theme = NULL)
26 1
      clii_div(app, id, class, theme),
27

28
    ## Paragraphs
29 1
    par = function(id = NULL, class = NULL)
30 1
      clii_par(app, id, class),
31

32
    ## Text, wrapped
33 1
    text = function(text)
34 1
      clii_text(app, text),
35

36
    ## Text, not wrapped
37 1
    verbatim = function(...)
38 1
      clii_verbatim(app, ...),
39

40
    ## Markdow(ish) text, wrapped: emphasis, strong emphasis, links, code
41 1
    md_text = function(...)
42 1
      clii_md_text(app, ...),
43

44
    ## Headings
45 1
    h1 = function(text, id = NULL, class = NULL)
46 1
      clii_h1(app, text, id, class),
47 1
    h2 = function(text, id = NULL, class = NULL)
48 1
      clii_h2(app, text, id, class),
49 1
    h3 = function(text, id = NULL, class = NULL)
50 1
      clii_h3(app, text, id, class),
51

52
    ## Block quote
53 1
    blockquote = function(quote, citation = NULL, id, class = NULL)
54 1
      clii_blockquote(app, quote, citation, id, class),
55

56
    ## Lists
57 1
    ul = function(items = NULL, id = NULL, class = NULL, .close = TRUE)
58 1
      clii_ul(app, items, id, class, .close),
59 1
    ol = function(items = NULL, id = NULL, class = NULL, .close = TRUE)
60 1
      clii_ol(app, items, id, class, .close),
61 1
    dl = function(items = NULL, id = NULL, class = NULL, .close = TRUE)
62 1
      clii_dl(app, items, id, class, .close),
63 1
    li = function(items = NULL, id = NULL, class = NULL)
64 1
      clii_li(app, items, id, class),
65

66
    ## Tables
67 1
    table = function(cells, id = NULL, class = NULL)
68 1
      clii_table(app, cells, class),
69

70
    ## Alerts
71 1
    alert = function(text, id = NULL, class = NULL, wrap = FALSE)
72 1
      clii_alert(app, "alert", text, id, class, wrap),
73 1
    alert_success = function(text, id = NULL, class = NULL, wrap = FALSE)
74 1
      clii_alert(app, "alert-success", text, id, class, wrap),
75 1
    alert_danger = function(text, id = NULL, class = NULL, wrap = FALSE)
76 1
      clii_alert(app, "alert-danger", text, id, class, wrap),
77 1
    alert_warning = function(text, id = NULL, class = NULL, wrap = FALSE)
78 1
      clii_alert(app, "alert-warning", text, id, class, wrap),
79 1
    alert_info = function(text, id = NULL, class = NULL, wrap = FALSE)
80 1
      clii_alert(app, "alert-info", text, id, class, wrap),
81

82
    ## Horizontal rule
83 1
    rule = function(left, center, right, id = NULL)
84 1
      clii_rule(app, left, center, right, id),
85

86
    ## Status bar
87 1
    status = function(id = NULL, msg, msg_done = NULL, msg_failed = NULL,
88 1
                      keep, auto_result)
89 1
      clii_status(app, id, msg, msg_done, msg_failed, keep, auto_result),
90 1
    status_clear = function(id = NULL, result, msg_done = NULL, msg_failed = NULL)
91 1
      clii_status_clear(app, id, result, msg_done, msg_failed),
92 1
    status_update = function(id = NULL, msg, msg_done = NULL, msg_failed = NULL)
93 1
      clii_status_update(app, id, msg, msg_done, msg_failed),
94

95 1
    doc = NULL,
96 1
    themes = NULL,
97 1
    styles = NULL,
98 1
    delayed_item = NULL,
99 1
    status_bar = list(),
100

101 1
    margin = 0,
102 1
    output = NULL,
103

104 1
    get_current_style = function()
105 1
      tail(app$styles, 1)[[1]],
106

107 1
    xtext = function(text = NULL, .list = NULL, indent = 0, padding = 0)
108 1
      clii__xtext(app, text, .list = .list, indent = indent,
109 1
                  padding = padding),
110

111 1
    vspace = function(n = 1)
112 1
      clii__vspace(app, n),
113

114 1
    inline = function(text = NULL, .list = NULL)
115 1
      clii__inline(app, text, .list = .list),
116

117 1
    item_text = function(type, name, cnt_id, items = list(), .list = NULL)
118 1
      clii__item_text(app, type, name, cnt_id, items, .list = .list),
119

120 1
    get_width = function(extra = 0)
121 1
      clii__get_width(app, extra),
122 1
    cat = function(lines)
123 1
      clii__cat(app, lines),
124 1
    cat_ln = function(lines, indent = 0, padding = 0)
125 1
      clii__cat_ln(app, lines, indent, padding)
126
  )
127

128 1
  if (! inherits(output, "connection")) output <- match.arg(output)
129 1
  app$new(theme, user_theme, output)
130

131 1
  app
132
}
133

134
clii_init <- function(app, theme, user_theme, output) {
135 1
  app$doc <- list()
136 1
  app$output <- output
137 1
  app$styles <- NULL
138

139 1
  app$add_theme(builtin_theme())
140 1
  app$add_theme(theme)
141 1
  app$add_theme(user_theme)
142

143 1
  clii__container_start(app, "body", id = "body")
144

145 1
  invisible(app)
146
}
147

148
## Text -------------------------------------------------------------
149

150
clii_text <- function(app, text) {
151 1
  app$xtext(text)
152
}
153

154
clii_verbatim <- function(app, ..., .envir) {
155 1
  style <- app$get_current_style()
156 1
  text <- unlist(strsplit(unlist(list(...)), "\n", fixed = TRUE))
157 1
  if (!is.null(style$fmt)) text <- style$fmt(text)
158 1
  app$cat_ln(text)
159 1
  invisible(app)
160
}
161

162
clii_md_text <- function(app, ...) {
163 0
  stop("Markdown text is not implemented yet")
164
}
165

166
## Headings ----------------------------------------------------------
167

168
clii_h1 <- function(app, text, id, class) {
169 1
  clii__heading(app, "h1", text, id, class)
170
}
171

172
clii_h2 <- function(app, text, id, class) {
173 1
  clii__heading(app, "h2", text, id, class)
174
}
175

176
clii_h3 <- function(app, text, id, class) {
177 1
  clii__heading(app, "h3", text, id, class)
178
}
179

180
clii__heading <- function(app, type, text, id, class) {
181 1
  id <- new_uuid()
182 1
  clii__container_start(app, type, id = id, class = class)
183 1
  on.exit(clii__container_end(app, id), add = TRUE)
184 1
  text <- app$inline(text)
185 1
  style <- app$get_current_style()
186 1
  if (is.function(style$fmt)) text <- style$fmt(text)
187 1
  app$cat_ln(text)
188 1
  invisible(app)
189
}
190

191
## Block quote ------------------------------------------------------
192

193
clii_blockquote <- function(app, quote, citation, id, class) {
194 0
  c1 <- clii__container_start(app, "blockquote", id = id, class = class)
195 0
  on.exit(clii__container_end(app, id), add = TRUE)
196 0
  app$xtext(quote)
197

198 0
  c2 <- clii__container_start(app, "cite", id = new_uuid())
199 0
  app$xtext(citation)
200
}
201

202
## Table ------------------------------------------------------------
203

204
clii_table <- function(app, cells, id, class) {
205 0
  stop("Tables are not implemented yet")
206
}
207

208
## Rule -------------------------------------------------------------
209

210
clii_rule <- function(app, left, center, right, id) {
211 0
  left <- app$inline(left)
212 0
  center <- app$inline(center)
213 0
  right <- app$inline(right)
214 0
  clii__container_start(app, "rule", id = id)
215 0
  on.exit(clii__container_end(app, id), add = TRUE)
216 0
  style <- app$get_current_style()
217 0
  width <- console_width() -
218 0
    nchar_fixed(style$before %||% "") - nchar_fixed(style$after %||% "")
219 0
  text <- rule(left, center, right, line = style$`line-type` %||% 1)
220 0
  text[1] <- paste0(style$before, text[1])
221 0
  text[length(text)] <- paste0(text[length(text)], style$after)
222 0
  if (is.function(style$fmt)) text <- style$fmt(text)
223 0
  app$cat_ln(text)
224
}
225

226
## Alerts -----------------------------------------------------------
227

228
clii_alert <- function(app, type, text, id, class, wrap) {
229 1
  clii__container_start(app, "div", id = id,
230 1
                       class = paste(class, "alert", type))
231 1
  on.exit(clii__container_end(app, id), add = TRUE)
232 1
  text <- app$inline(text)
233 1
  style <- app$get_current_style()
234 1
  text[1] <- paste0(style$before, text[1])
235 1
  text[length(text)] <- paste0(text[length(text)], style$after)
236 0
  if (is.function(style$fmt)) text <- style$fmt(text)
237 0
  if (wrap) text <- strwrap_fixed(text, exdent = 2)
238 1
  app$cat_ln(text)
239
}

Read our documentation on viewing source code .

Loading