r-lib / cli
1

2
add_child <- function(x, tag, ...) {
3 1
  push(x, list(tag = tag, ...))
4
}
5

6
#' @importFrom glue glue
7

8
clii__container_start <- function(app, tag, class = NULL,
9
                                  id = NULL, theme = NULL) {
10

11 1
  id <- id %||% new_uuid()
12 1
  if (!length(class)) class <- ""
13 1
  class <- setdiff(unique(strsplit(class, " ", fixed = TRUE)[[1]]), "")
14

15 1
  app$doc <- add_child(app$doc, tag, id = id, class = class,
16 1
                           theme = theme)
17

18
  ## Go over all themes, and collect the selectors that match the
19
  ## current element
20 1
  new_sels <- list()
21 1
  for (t in seq_along(app$themes)) {
22 1
    theme <- app$themes[[t]]
23 1
    for (i in seq_len(nrow(theme))) {
24 1
      if (is.na(theme$cnt[i]) &&
25 1
          match_selector(theme$parsed[[i]], app$doc)) {
26 1
        app$themes[[t]]$cnt[i] <- id
27 1
        new_sels <- modifyList(new_sels, theme$style[[i]])
28
      }
29
    }
30
  }
31 1
  new_style <- merge_embedded_styles(last(app$styles) %||% list(), new_sels)
32 1
  app$styles <- push(app$styles, new_style, name = id)
33

34
  ## Top margin, if any
35 1
  app$vspace(new_style$`margin-top` %||% 0)
36

37 1
  invisible(id)
38
}
39

40
#' @importFrom utils head
41
#' @importFrom stats na.omit
42

43
clii__container_end <- function(app, id) {
44
  ## Defaults to last container
45 1
  if (is.null(id) || is.na(id)) id <- last(app$doc)$id
46

47
  ## Do not remove the <body>
48 0
  if (id == "body") return(invisible(app))
49

50
  ## Do we have 'id' at all?
51 1
  wh <- which(vlapply(app$doc, function(x) identical(x$id, id)))[1]
52 1
  if (is.na(wh)) return(invisible(app))
53

54
  ## ids to remove
55 1
  del_ids <- unlist(lapply(tail(app$doc, - (wh - 1L)), "[[", "id"))
56

57
  ## themes to remove
58 1
  del_thm <- unlist(lapply(tail(app$doc, - (wh - 1L)), "[[", "theme"))
59

60
  ## Remove the whole subtree of 'cnt'
61 1
  app$doc <- head(app$doc, wh - 1L)
62

63
  ## Bottom margin
64 1
  del_from <- match(id, names(app$styles))
65 1
  bottom <- max(viapply(
66 1
    app$styles[del_from:length(app$styles)],
67 1
    function(x) as.integer(x$`margin-bottom` %||% 0L)
68
  ))
69 1
  app$vspace(bottom)
70

71
  ## Remove styles
72 1
  app$styles <- head(app$styles, del_from - 1L)
73

74
  ## Remove claimed styles that are not used any more
75 1
  for (t in seq_along(app$themes)) {
76 1
    m <- app$themes[[t]]$cnt %in% del_ids
77 1
    app$themes[[t]]$cnt[m] <- NA_character_
78
  }
79

80
  ## Remove themes
81 1
  app$themes <- app$themes[setdiff(names(app$themes), del_thm)]
82

83 1
  invisible(app)
84
}
85

86
## div --------------------------------------------------------------
87

88
clii_div <- function(app, id, class, theme) {
89 1
  theme_id <- app$add_theme(theme)
90 1
  clii__container_start(app, "div", class, id, theme = theme_id)
91 1
  id
92
}
93

94
## Paragraph --------------------------------------------------------
95

96
clii_par <- function(app, id, class) {
97 1
  clii__container_start(app, "par", class, id)
98
}
99

100
## Lists ------------------------------------------------------------
101

102
clii_ul <- function(app, items, id, class, .close) {
103 1
  id <- clii__container_start(app, "ul", id = id, class = class)
104 0
  if (length(items)) { app$li(items); if (.close) app$end(id) }
105 1
  invisible(id)
106
}
107

108
clii_ol <- function(app, items, id, class, .close) {
109 1
  id <- clii__container_start(app, "ol", id = id, class = class)
110 0
  if (length(items)) { app$li(items); if (.close) app$end(id) }
111 1
  invisible(id)
112
}
113

114
clii_dl <- function(app, items, id, class, .close) {
115 1
  id <- clii__container_start(app, "dl", id = id, class = class)
116 0
  if (length(items)) { app$li(items); if (.close) app$end(id) }
117 1
  invisible(id)
118
}
119

120
clii_li <- function(app, items, id, class) {
121 1
  id <- id %||% new_uuid()
122

123
  ## check the last active list container
124 1
  last <- length(app$doc)
125 1
  while (! app$doc[[last]]$tag %in% c("ul", "ol", "dl", "body")) {
126 1
    last <- last - 1L
127
  }
128

129
  ## if not the last container, close the ones below it
130 1
  if (app$doc[[last]]$tag != "body" &&
131 1
      last != length(app$doc)) {
132 1
    app$end(app$doc[[last + 1L]]$id)
133
  }
134

135
  ## if none, then create an ul container
136 1
  if (app$doc[[last]]$tag == "body") {
137 1
    cnt_id <- app$ul()
138 1
    type <- "ul"
139
  } else {
140 1
    cnt_id <- app$doc[[last]]$id
141 1
    type <- app$doc[[last]]$tag
142
  }
143

144 1
  if (length(items) > 0) {
145 1
    for (i in seq_along(items)) {
146 1
      id <- clii__container_start(app, "li", id = id, class = class)
147 1
      app$item_text(type, names(items)[i], cnt_id, items[[i]])
148 1
      if (i < length(items)) app$end(id)
149
    }
150
  } else {
151 0
    app$delayed_item <- list(type = type, cnt_id = cnt_id)
152 0
    id <- clii__container_start(app, "li", id = id, class = class)
153
  }
154

155 1
  invisible(id)
156
}
157

158
clii__item_text <- function(app, type, name, cnt_id, text, .list) {
159

160 1
  style <- app$get_current_style()
161 1
  cnt_style <- app$styles[[cnt_id]]
162

163 1
  head <- if (type == "ul") {
164 1
    paste0(style$`list-style-type` %||% "*", " ")
165 1
  } else if (type == "ol") {
166 1
    res <- paste0(cnt_style$start %||% 1L, ". ")
167 1
    app$styles[[cnt_id]]$start <- (cnt_style$start %||% 1L) + 1L
168 1
    res
169 1
  } else if (type == "dl") {
170 1
    paste0(name, ": ")
171
  }
172

173 1
  app$xtext(
174 1
    .list = c(list(glue_delay(head)), list(text), .list),
175 1
    indent = - style$`padding-left` %||% 0,
176 1
    padding = cnt_style$`padding-left` %||% 0
177
  )
178
}
179

180
## Close container(s) -----------------------------------------------
181

182
clii_end <- function(app, id) {
183 1
  clii__container_end(app, id)
184
}

Read our documentation on viewing source code .

Loading