Nothing
#' Activate or deactivate a menu item
#'
#' Activates a menu item with the same syntax as [dplyr::pull()].
#' Activating a menu item allows you to perform operations on the active item.
#' `activate()` turns a `navigatr_nav_menu` object into an `navigatr_item`
#' object, and `deactivate()` turns it back.
#'
#' @param .data A `navigatr_nav_menu` object.
#' @param ... In `activate()`, one or more variables passed to [dplyr::pull()].
#' In `deactivate()`, unused (for extensibility).
#' @param .add Whether to add new variables to the path indices.
#' If `FALSE` (default value), the menu will be deactivated first by
#' `deactivate()`.
#' @param x A `navigatr_nav_menu` object.
#' @param deep If `TRUE` (default value), deactivate recursively.
#'
#' @return In `activate()`, An `navigatr_item` object.
#' If it inherits from class `navigatr_nav_menu`, the menu will be displayed
#' hierarchically.
#' Otherwise, the active data will be displayed.
#' In `deactivate()`, A `navigatr_nav_menu` object.
#'
#' @examples
#' library(dplyr)
#'
#' mn1 <- new_nav_menu(key = c("band_members", "band_instruments"),
#' value = list(band_members, band_instruments))
#'
#' mn1 |>
#' activate(band_members) |>
#' filter(band == "Beatles")
#'
#' # Items can also be specified as integers
#' mn1 |>
#' activate(2)
#'
#' mn1 |>
#' activate(-1) |>
#' deactivate()
#'
#' # To activate items in a nested menu, specify multiple variables
#' mn2 <- new_nav_menu(key = c("key1", "key2"),
#' value = list(mn1, mn1))
#' mn2 |>
#' activate(key1, band_members)
#'
#' @export
activate <- function(.data, ...,
.add = FALSE) {
UseMethod("activate")
}
#' @rdname activate
#' @export
activate.navigatr_nav_menu <- function(.data, ...,
.add = FALSE) {
vars <- enquos(...)
if (!is_empty(vars)) {
key <- .data$key
loc <- which(key == tidyselect::vars_pull(key, !!vars[[1]]))
# item
child <- vec_slice(.data, loc)
x <- child$value[[1]]
attrs <- purrr::modify(as.list(child$attrs),
function(x) {
x[[1]]
})
tree <- list(key = key[[loc]],
parent = .data,
path = c(item_path(.data), loc),
attr_names = names2(attrs))
.data <- item(x,
attrs = attrs,
tree = tree)
# activate recursively
vars <- vars[-1]
if (!is_empty(vars)) {
.data <- activate(.data, !!!vars,
.add = TRUE)
}
}
.data
}
#' @rdname activate
#' @export
activate.navigatr_item <- function(.data, ...,
.add = FALSE) {
if (!.add) {
.data <- deactivate(.data)
}
if (!is_nav_menu(.data)) {
abort("Too many variables to activate.")
}
activate.navigatr_nav_menu(.data, ...)
}
#' @rdname activate
#' @export
deactivate <- function(x, ...,
deep = TRUE) {
UseMethod("deactivate")
}
#' @rdname activate
#' @export
deactivate.navigatr_nav_menu <- function(x, ...,
deep = TRUE) {
x
}
#' @rdname activate
#' @export
deactivate.navigatr_item <- function(x, ...,
deep = TRUE) {
key <- item_key(x)
parent <- item_parent(x)
path <- item_path(x)
attr_names <- item_attr_names(x)
loc <- path[[vec_size(path)]]
stopifnot(
!key %in% parent$key[-loc]
)
parent$key[[loc]] <- key
parent$value[[loc]] <- unitem(x)
for (attr_name in attr_names) {
parent$attrs[[attr_name]][[loc]] <- attr(x, attr_name)
}
if (deep) {
parent <- deactivate(parent)
}
parent
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.