R/f7-inputs.R

Defines functions updateF7Form f7Form createOptions f7GroupInput groupInputDefaults updateF7Radio f7Radio updateF7Toggle f7Toggle updateF7Stepper f7Stepper updateF7Slider f7Slider f7Password f7TextArea updateF7Text f7Text createInputTag listify is_wrapped createInputLayout inputLayoutDefaults updateF7SmartSelect f7SmartSelect updateF7Select f7Select choicesWithNames createSelectOptions f7CheckboxChoice f7CheckboxGroup updateF7Checkbox f7Checkbox updateF7DatePicker f7DatePicker f7ColorPicker updateF7Picker buildConfig buildPickerInput f7Picker updateF7AutoComplete f7AutoComplete

Documented in buildConfig buildPickerInput createInputLayout createInputTag createOptions createSelectOptions f7AutoComplete f7Checkbox f7CheckboxChoice f7CheckboxGroup f7ColorPicker f7DatePicker f7Form f7GroupInput f7Password f7Picker f7Radio f7Select f7Slider f7SmartSelect f7Stepper f7Text f7TextArea f7Toggle groupInputDefaults inputLayoutDefaults is_wrapped listify updateF7AutoComplete updateF7Checkbox updateF7DatePicker updateF7Form updateF7Picker updateF7Radio updateF7Select updateF7Slider updateF7SmartSelect updateF7Stepper updateF7Text updateF7Toggle

#' Framework7 autocomplete input
#'
#' \code{f7AutoComplete} generates a Framework7 autocomplete input.
#'
#' @param inputId Autocomplete input id.
#' @param label Autocomplete label.
#' @param placeholder Text to write in the container.
#' @param value Autocomplete initial value, if any.
#' @param choices Autocomplete choices.
#' @param openIn Defines how to open Autocomplete,
#' can be page or popup (for Standalone) or dropdown.
#' @param typeahead Enables type ahead, will prefill input
#' value with first item in match. Only if openIn is "dropdown".
#' @param expandInput `r lifecycle::badge("deprecated")`:
#' removed from Framework7.
#' @param closeOnSelect Set to true and autocomplete will be closed when user picks value.
#' Not available if multiple is enabled. Only works
#' when openIn is 'popup' or 'page'.
#' @param dropdownPlaceholderText Specify dropdown placeholder text.
#' Only if openIn is "dropdown".
#' @param multiple Whether to allow multiple value selection. Only works
#' when openIn is 'popup' or 'page'.
#' @param limit Limit number of maximum displayed items in autocomplete per query.
#' @param ... Extra options.
#' See \url{https://framework7.io/docs/autocomplete#autocomplete-parameters}
#' @param style Autocomplete styling parameters.
#' Only available when `openIn` is "dropdown".
#'
#' @rdname autocomplete
#' @note Contrary to \link{f7Text}, this input can't be cleared.
#'
#' @example inst/examples/autocomplete/app.R
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7AutoComplete <- function(
    inputId, label = NULL, placeholder = NULL,
    value = NULL, choices,
    openIn = c("popup", "page", "dropdown"),
    typeahead = TRUE, expandInput = deprecated(), closeOnSelect = FALSE,
    dropdownPlaceholderText = NULL, multiple = FALSE, limit = NULL,
    style = list(
      media = NULL,
      description = NULL,
      floating = FALSE,
      outline = FALSE
    ), ...) {
  if (lifecycle::is_present(expandInput)) {
    lifecycle::deprecate_warn(
      when = "2.0.0",
      what = "f7AutoComplete(expandInput)",
      details = "expandInput has been
      removed from Framework7 and will be removed from shinyMobile
      in the next release."
    )
  }

  type <- match.arg(openIn)

  if (is.null(value)) value <- character()

  is_standalone <- type %in% c("page", "popup")

  config <- dropNulls(
    list(
      choices = choices,
      value = I(value),
      openIn = type,
      limit = limit,
      multiple = if (is_standalone) multiple,
      closeOnSelect = if (is_standalone) closeOnSelect,
      typeahead = if (!is_standalone) typeahead,
      dropdownPlaceholderText = if (!is_standalone) dropdownPlaceholderText,
      ...
    )
  )

  configTag <- buildConfig(inputId, config)

  # wrap props
  autoCompleteInnerTag <- if (!is_standalone) {
    shiny::tags$input(
      id = inputId,
      class = "autocomplete-input",
      type = "text",
      placeholder = placeholder,
      configTag
    )
  } else {
    tempTag <- shiny::tags$a(
      id = inputId,
      class = "autocomplete-input item-link item-content",
      href = "#",
      configTag
    )
    shiny::tagAppendChildren(
      tempTag,
      shiny::tags$input(type = "hidden"),
      shiny::tags$div(
        class = "item-inner",
        # label
        shiny::tags$div(class = "item-title", label),
        # input
        shiny::tags$div(class = "item-after")
      )
    )
  }

  # input tag + label wrapper
  style$clearable <- FALSE
  if (!is_standalone) {
    listify(
      htmltools::tagQuery(
        createInputLayout(
          label = label,
          autoCompleteInnerTag,
          style = style
        )
      )$
        find(".item-input")$
        addClass("inline-label")$
        allTags()
    )
  } else {
    listify(autoCompleteInnerTag)
  }
}

#' Update Framework7 autocomplete
#'
#' \code{updateF7AutoComplete} changes the value of an autocomplete input on the client.
#'
#' @param session The Shiny session object.
#'
#' @export
#' @rdname autocomplete
updateF7AutoComplete <- function(inputId, value = NULL, choices = NULL, ...,
                                 session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(
    list(
      value = I(value),
      choices = choices,
      ...
    )
  )
  session$sendInputMessage(inputId, message)
}

#' Framework7 picker input
#'
#' \code{f7Picker} generates a picker input.
#'
#' @param inputId Picker input id.
#' @param label Picker label.
#' @param placeholder Text to write in the container.
#' @param value Picker initial value, if any.
#' @param choices Picker choices.
#' @param rotateEffect Enables 3D rotate effect. Default to TRUE.
#' @param openIn Can be auto, popover (to open picker in popover), sheet (to open in sheet modal).
#'  In case of auto will open in sheet modal on small screens and in popover on large screens. Default
#'  to auto.
#' @param scrollToInput Scroll viewport (page-content) to input when picker opened. Default
#'  to FALSE.
#' @param closeByOutsideClick If enabled, picker will be closed by clicking outside of picker or related input element.
#'  Default to TRUE.
#' @param toolbar Enables picker toolbar. Default to TRUE.
#' @param toolbarCloseText Text for Done/Close toolbar button.
#' @param sheetSwipeToClose Enables ability to close Picker sheet with swipe. Default to FALSE.
#' @param style Input style. Inherit from \link{f7List} options
#' such as outline, inset, strong and dividers.
#' @param ... Other options to pass to the picker. See
#' \url{https://framework7.io/docs/picker#picker-parameters}.
#'
#' @rdname picker
#' @example inst/examples/picker/app.R
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7Picker <- function(inputId, label, placeholder = NULL, value = choices[1], choices,
                     rotateEffect = TRUE, openIn = "auto", scrollToInput = FALSE,
                     closeByOutsideClick = TRUE, toolbar = TRUE, toolbarCloseText = "Done",
                     sheetSwipeToClose = FALSE, style = list(
                       inset = FALSE,
                       outline = FALSE,
                       strong = FALSE,
                       dividers = FALSE
                     ), ...) {
  if (length(value) > 1) stop("value must be a single element")

  # JS needs array
  if (!is.null(value)) {
    value <- list(value)
  } else {
    value <- list()
  }

  # TO DO: create helper function for sheet, picker, ...
  # since they're all the same ...
  config <- dropNulls(
    list(
      value = value,
      values = choices,
      displayValues = if (length(names(choices))) names(choices),
      rotateEffect = rotateEffect,
      openIn = openIn,
      scrollToInput = scrollToInput,
      closeByOutsideClick = closeByOutsideClick,
      toolbar = toolbar,
      toolbarCloseText = toolbarCloseText,
      sheetSwipeToClose = sheetSwipeToClose,
      ...
    )
  )

  buildPickerInput(
    inputId,
    label,
    config,
    "picker-input",
    placeholder,
    style
  )
}

#' Build input tag for picker elements
#'
#' @keywords internal
buildPickerInput <- function(id, label, config, class, placeholder = NULL, style = NULL) {
  pickerInnerTag <-
    shiny::tags$div(
      class = "item-input-wrap",
      shiny::tags$input(
        id = id,
        class = class,
        type = "text",
        placeholder = placeholder
      ),
      buildConfig(id, config)
    )

  # if not wrapped inside f7List, return "standalone" picker
  if (!is_wrapped()) {
    tagList(
      shiny::tags$div(
        class = "block-title",
        label
      ),
      listify(
        tagList(
          htmltools::tagQuery(f7ListItem())$
            find(".item-inner")$
            append(pickerInnerTag)$
            allTags()
        ),
        style
      )
    )
  } else {
    item <-
      listify(
        htmltools::tagQuery(
          f7ListItem(title = label)
        )$
          find(".item-inner")$
          append(pickerInnerTag)$
          allTags(),
        style
      )

    item <-
      htmltools::tagQuery(item)$
        find(".item-title")$
        addClass("item-label")$
        allTags()

    htmltools::tagQuery(item)$
      find(".item-content")$
      addClass("item-input")$
      allTags()
  }
}

#' Build config tag for JavaScript
#'
#' See \url{https://unleash-shiny.rinterface.com/shiny-input-system#boxes-on-steroids-more}
#'
#' @keywords internal
buildConfig <- function(id, config) {
  shiny::tags$script(
    type = "application/json",
    `data-for` = id,
    jsonlite::toJSON(
      x = config,
      auto_unbox = TRUE,
      json_verbatim = TRUE
    )
  )
}

#' Update Framework7 picker
#'
#' \code{updateF7Picker} changes the value of a picker input on the client.
#'
#' @param session The Shiny session object, usually the default value will suffice.
#'
#' @export
#' @rdname picker
updateF7Picker <- function(inputId, value = NULL, choices = NULL,
                           rotateEffect = NULL, openIn = NULL, scrollToInput = NULL,
                           closeByOutsideClick = NULL, toolbar = NULL, toolbarCloseText = NULL,
                           sheetSwipeToClose = NULL, ...,
                           session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(
    list(
      value = value,
      choices = choices,
      rotateEffect = rotateEffect,
      openIn = openIn,
      scrollToInput = scrollToInput,
      closeByOutsideClick = closeByOutsideClick,
      toolbar = toolbar,
      toolbarCloseText = toolbarCloseText,
      sheetSwipeToClose = sheetSwipeToClose,
      ...
    )
  )
  session$sendInputMessage(inputId, message)
}
f7ColorPickerPalettes <- list(
  c(
    "#FFEBEE", "#FFCDD2", "#EF9A9A",
    "#E57373", "#EF5350", "#F44336",
    "#E53935", "#D32F2F", "#C62828",
    "#B71C1C"
  ),
  c(
    "#F3E5F5", "#E1BEE7", "#CE93D8",
    "#BA68C8", "#AB47BC", "#9C27B0",
    "#8E24AA", "#7B1FA2", "#6A1B9A",
    "#4A148C"
  ),
  c(
    "#E8EAF6", "#C5CAE9", "#9FA8DA",
    "#7986CB", "#5C6BC0", "#3F51B5",
    "#3949AB", "#303F9F", "#283593",
    "#1A237E"
  ),
  c(
    "#E1F5FE", "#B3E5FC", "#81D4FA",
    "#4FC3F7", "#29B6F6", "#03A9F4",
    "#039BE5", "#0288D1", "#0277BD",
    "#01579B"
  ),
  c(
    "#E0F2F1", "#B2DFDB", "#80CBC4",
    "#4DB6AC", "#26A69A", "#009688",
    "#00897B", "#00796B", "#00695C",
    "#004D40"
  ),
  c(
    "#F1F8E9", "#DCEDC8", "#C5E1A5",
    "#AED581", "#9CCC65", "#8BC34A",
    "#7CB342", "#689F38", "#558B2F",
    "#33691E"
  ),
  c(
    "#FFFDE7", "#FFF9C4", "#FFF59D",
    "#FFF176", "#FFEE58", "#FFEB3B",
    "#FDD835", "#FBC02D", "#F9A825",
    "#F57F17"
  ),
  c(
    "#FFF3E0", "#FFE0B2", "#FFCC80",
    "#FFB74D", "#FFA726", "#FF9800",
    "#FB8C00", "#F57C00", "#EF6C00",
    "#E65100"
  )
)

f7ColorPickerModules <- c(
  "wheel", "sb-spectrum",
  "hue-slider", "hs-spectrum",
  "brightness-slider", "rgb-slider",
  "hsb-sliders", "alpha-slider",
  "rgb-bars", "palette", "hex",
  "current-color", "initial-current-colors"
)

globalVariables(c("f7ColorPickerPalettes", "f7ColorPickerModules"))

#' Create a Framework7 color picker input
#'
#' @param inputId Color picker input.
#' @param label Color picker label.
#' @param value Initial picker value in hex.
#' @param placeholder Color picker placeholder.
#' @param modules Picker color modules. Choose at least one.
#' @param palettes Picker color predefined palettes. Must be a list
#' of color vectors, each value specified as HEX string.
#' @param sliderValue When enabled, it will display sliders values.
#' @param sliderValueEditable When enabled, it will display sliders values as <input>
#' elements to edit directly.
#' @param sliderLabel When enabled, it will display sliders labels with text.
#' @param hexLabel When enabled, it will display HEX module label text, e.g. HEX.
#' @param hexValueEditable When enabled, it will display HEX module value as <input> element to edit directly.
#' @param groupedModules When enabled it will add more exposure
#' to sliders modules to make them look more separated.
#' @param style Input style. Inherit from \link{f7List} options
#' such as outline, inset, strong and dividers.
#' @param ... Other options to pass to the picker. See
#' \url{https://framework7.io/docs/color-picker#color-picker-parameters}.
#'
#' @return The return value is a list and includes hex, rgb, hsl, hsb, alpha, hue, rgba, and hsla values.
#' See \url{https://framework7.io/docs/color-picker#color-picker-value}.
#'
#' @example inst/examples/colorpicker/app.R
#'
#' @export
f7ColorPicker <- function(inputId, label, value = "#ff0000", placeholder = NULL,
                          modules = f7ColorPickerModules, palettes = f7ColorPickerPalettes,
                          sliderValue = TRUE, sliderValueEditable = TRUE,
                          sliderLabel = TRUE, hexLabel = TRUE,
                          hexValueEditable = TRUE, groupedModules = TRUE,
                          style = list(
                            outline = FALSE,
                            inset = FALSE,
                            strong = FALSE,
                            dividers = FALSE
                          ), ...) {
  if (!is.null(value) && length(value) == 1) {
    # needed by JS (array)
    value <- list(hex = value)
  } else {
    stop("value cannot be NULL and must be a single color")
  }

  config <- dropNulls(list(
    value = value,
    modules = modules,
    palettes = palettes,
    sliderValue = sliderValue,
    sliderValueEditable = sliderValueEditable,
    sliderLabel = sliderLabel,
    hexLabel = hexLabel,
    hexValueEditable = hexValueEditable,
    groupedModules = groupedModules,
    ...
  ))

  buildPickerInput(
    inputId,
    label,
    config,
    "color-picker-input",
    placeholder,
    style
  )
}

#' Framework7 date picker
#'
#' \code{f7DatePicker} creates a Framework7 date picker input.
#'
#' @param inputId Date input id.
#' @param label Input label.
#' @param value Array with initial selected dates. Each array item represents selected date.
#' If timePicker enabled, the value needs to be an object of type POSIXct.
#' @param multiple If \code{TRUE} allow to select multiple dates.
#' @param direction Months layout direction, could be 'horizontal' or 'vertical'.
#' @param minDate Minimum allowed date.
#' @param maxDate Maximum allowed date.
#' @param dateFormat Date format: "yyyy-mm-dd", for instance.
#' @param openIn Can be auto, popover (to open calendar in popover), sheet
#' (to open in sheet modal) or customModal (to open in custom Calendar modal overlay).
#' In case of auto will open in sheet modal on small screens and in popover on large screens.
#' @param scrollToInput Scroll viewport (page-content) to input when calendar opened.
#' @param closeByOutsideClick If enabled, picker will be closed by clicking outside of picker or related input element.
#' @param toolbar Enables calendar toolbar.
#' @param toolbarCloseText Text for Done/Close toolbar button.
#' @param header Enables calendar header.
#' @param headerPlaceholder Default calendar header placeholder text.
#' @param style Input style. Inherit from \link{f7List} options
#' such as outline, inset, strong and dividers.
#' @param ... Other options to pass to the picker. See
#' \url{https://framework7.io/docs/calendar#calendar-parameters}.
#'
#' @importFrom jsonlite toJSON
#' @rdname datepicker
#'
#' @return a \code{Date} vector.
#'
#' @export
#' @example inst/examples/datepicker/app.R
f7DatePicker <- function(inputId, label, value = NULL, multiple = FALSE, direction = c("horizontal", "vertical"),
                         minDate = NULL, maxDate = NULL, dateFormat = "yyyy-mm-dd",
                         openIn = c("auto", "popover", "sheet", "customModal"),
                         scrollToInput = FALSE, closeByOutsideClick = TRUE,
                         toolbar = TRUE, toolbarCloseText = "Done", header = FALSE,
                         headerPlaceholder = "Select date",
                         style = list(
                           outline = FALSE,
                           inset = FALSE,
                           strong = FALSE,
                           dividers = FALSE
                         ), ...) {
  direction <- match.arg(direction)
  openIn <- match.arg(openIn)

  if (!is.null(value) && length(value) == 1) {
    value <- list(value)
  }

  config <- dropNulls(list(
    value = value,
    multiple = multiple,
    direction = direction,
    minDate = minDate,
    maxDate = maxDate,
    dateFormat = dateFormat,
    openIn = openIn,
    scrollToInput = scrollToInput,
    closeByClickOutside = closeByOutsideClick,
    toolbar = toolbar,
    toolbarCloseText = toolbarCloseText,
    header = header,
    headerPlaceholder = headerPlaceholder,
    ...
  ))

  buildPickerInput(
    inputId,
    label,
    config,
    "calendar-input",
    style = style
  )
}

#' Update Framework7 date picker
#'
#' \code{updateF7DatePicker} changes the value of a date picker input on the client.
#'
#' @param session The Shiny session object, usually the default value will suffice.
#'
#' @export
#'
#' @rdname datepicker
updateF7DatePicker <- function(inputId, value = NULL, ...,
                               session = shiny::getDefaultReactiveDomain()) {
  if (!is.null(value)) {
    if (length(value) == 1) {
      value <- list(as.character(value))
    } else {
      value <- as.character(value)
    }
  }
  config <- dropNulls(list(...))
  if (length(config) == 0) {
    config <- NULL
  }
  message <- dropNulls(list(
    value = value,
    config = config
  ))
  session$sendInputMessage(inputId, message)
}

#' Framework7 checkbox
#'
#' \link{f7Checkbox} creates a checkbox input.
#'
#' @param inputId The input slot that will be used to access the value.
#' @param label Display label for the control, or NULL for no label.
#' @param value Initial value (TRUE or FALSE).
#'
#' @rdname checkbox
#' @example inst/examples/checkbox/app.R
#' @export
f7Checkbox <- function(inputId, label, value = FALSE) {
  value <- shiny::restoreInput(id = inputId, default = value)
  inputTag <- shiny::tags$input(id = inputId, type = "checkbox")
  if (!is.null(value) && value) {
    inputTag$attribs$checked <- "checked"
  }
  shiny::tagList(
    shiny::tags$span(label),
    shiny::tags$label(
      class = "checkbox",
      inputTag,
      shiny::tags$i(class = "icon-checkbox"),
    )
  )
}

#' Update Framework7 checkbox
#'
#' \code{updateF7Checkbox} changes the value of a checkbox input on the client.
#'
#' @rdname checkbox
#' @param session The Shiny session object.
#' @export
updateF7Checkbox <- function(inputId, label = NULL, value = NULL,
                             session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(label = label, value = value))
  session$sendInputMessage(inputId, message)
}

#' Framework7 checkbox group
#'
#' \code{f7CheckboxGroup} creates a checkbox group input
#'
#' @inheritParams f7GroupInput
#'
#' @export
#' @rdname checkboxgroup
#'
#' @example inst/examples/checkboxgroup/app.R
f7CheckboxGroup <- function(
    inputId, label, choices = NULL, selected = NULL,
    position = c("left", "right"), style = list(
      inset = FALSE,
      outline = FALSE, dividers = FALSE, strong = FALSE
    )) {
  position <- match.arg(position)
  f7GroupInput(
    type = "checkbox",
    inputId = inputId,
    label = label,
    choices = choices,
    selected = selected,
    position = position,
    style = style
  )
}

#' Framework7 checkbox group custom choice
#'
#' Custom choice item for \link{f7CheckboxGroup}.
#'
#' @param ... Choice content. Text is striped if too long.
#' @param title Item title.
#' @param subtitle Item subtitle.
#' @param after Display at the right of title.
#'
#' @export
#' @rdname checkboxgroup
f7CheckboxChoice <- function(..., title, subtitle = NULL, after = NULL) {
  # We can benefit from f7ListItem, though we don't
  # need all of the generated tag, hence the use of
  # htmltools::tagQuery ...
  structure(
    htmltools::tagQuery(
      f7ListItem(
        ...,
        media = f7Icon(), # fake item to force layout
        title = title,
        subtitle = subtitle,
        right = after,
        mode = "media"
      )
    )$
      find(".item-inner")$
      selectedTags()[[1]]$
      children,
    class = "custom_choice"
  )
}

#' Create option html tag based on choice input
#'
#' Used by \link{f7SmartSelect} and \link{f7Select}
#'
#' @param choices Vector of possibilities.
#' @param selected Default selected value.
#' @keywords internal
createSelectOptions <- function(choices, selected) {
  choices <- choicesWithNames(choices)
  lapply(X = seq_along(choices), function(i) {
    if (inherits(choices[[1]], "list")) {
      shiny::tags$optgroup(
        label = names(choices)[i],
        lapply(X = seq_along(choices[[i]]), function(j) {
          shiny::tags$option(
            value = choices[[i]][[j]],
            names(choices[[i]])[j],
            selected = if (!is.null(selected)) {
              if (choices[[i]][[j]] %in% selected) NA else NULL
            }
          )
        })
      )
    } else {
      shiny::tags$option(
        value = choices[[i]],
        names(choices)[i],
        selected = if (!is.null(selected)) {
          if (choices[[i]] %in% selected) NA else NULL
        }
      )
    }
  })
}

choicesWithNames <- function(choices) {
  listify <- function(obj) {
    makeNamed <- function(x) {
      if (is.null(names(x))) {
        names(x) <- character(length(x))
      }
      x
    }
    res <- lapply(obj, function(val) {
      if (is.list(val)) {
        listify(val)
      } else if (length(val) == 1 && is.null(names(val))) {
        val
      } else {
        makeNamed(as.list(val))
      }
    })
    makeNamed(res)
  }
  choices <- listify(choices)
  if (length(choices) == 0) {
    return(choices)
  }
  choices <- mapply(choices, names(choices), FUN = function(choice,
                                                            name) {
    if (!is.list(choice)) {
      return(choice)
    }
    if (name == "") {
      stop("All sub-lists in \"choices\" must be named.")
    }
    choicesWithNames(choice)
  }, SIMPLIFY = FALSE)
  missing <- names(choices) == ""
  names(choices)[missing] <- as.character(choices)[missing]
  choices
}

#' Framework7 select input
#'
#' \code{f7Select} creates a select input.
#'
#' @param choices Select input choices.
#' @param selected Select input default selected value.
#' @param width The width of the input, e.g. \code{400px}, or \code{100\%}.
#' @inheritParams f7Text
#'
#' @note Contrary to \link{f7Text}, \link{f7Select} can't be cleared and
#' label can't float.
#'
#' @export
#' @rdname select
#'
#' @example inst/examples/select/app.R
f7Select <- function(
    inputId, label, choices, selected = NULL, width = NULL,
    style = list(
      media = NULL,
      description = NULL,
      outline = FALSE
    )) {
  options <- createSelectOptions(choices, selected)

  style$clearable <- FALSE # Can't be cleared
  style$floating <- FALSE # Can't be changed because can't be cleared

  selectTag <- createInputLayout(
    shiny::tags$select(
      class = "input-select",
      id = inputId,
      placeholder = "Please choose...",
      options
    ),
    label = label,
    dropdown = TRUE,
    style = style
  )

  if (!is.null(width)) {
    selectTag$attribs$style <- paste0("width:", htmltools::validateCssUnit(width), ";")
  }

  selectTag
}

#' Update Framework7 select
#'
#' \code{updateF7Select} changes the value of a select input on the client
#'
#' @param session The Shiny session object, usually the default value will suffice.
#'
#' @export
#' @rdname select
updateF7Select <- function(inputId, selected = NULL,
                           session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(
    selected = selected
  ))
  session$sendInputMessage(inputId, message)
}

#' Framework7 smart select
#'
#' \code{f7SmartSelect} is smarter than the classic \link{f7Select},
#' allows for choices filtering, ...
#'
#' @param inputId Select input id.
#' @param label Select input label.
#' @param choices Select input choices.
#' @param selected Default selected item. If NULL, the first item is selected.
#' @param openIn Smart select type: either \code{c("sheet", "popup", "popover")}.
#' Note that the search bar is only available when the type is popup.
#' @param searchbar Whether to enable the search bar. TRUE by default.
#' @param multiple Whether to allow multiple values. FALSE by default.
#' @param maxLength Maximum items to select when multiple is TRUE.
#' @param virtualList Enable Virtual List for smart select if your select has a lot
#' of options. Default to FALSE.
#' @param ... Other options. See \url{https://framework7.io/docs/smart-select#smart-select-parameters}.
#'
#' @rdname smartselect
#'
#' @export
#'
#' @example inst/examples/smartselect/app.R
f7SmartSelect <- function(inputId, label, choices, selected = NULL,
                          openIn = c("page", "sheet", "popup", "popover"),
                          searchbar = TRUE, multiple = FALSE, maxLength = NULL,
                          virtualList = FALSE, ...) {
  options <- createSelectOptions(choices, selected)
  type <- match.arg(openIn)

  config <- dropNulls(list(
    openIn = type,
    searchbar = searchbar,
    searchbarPlaceholder = "Search",
    virtualList = virtualList,
    maxLength = maxLength,
    ...
  ))

  listify(
    shiny::tags$li(
      shiny::tags$a(
        class = "item-link smart-select",
        id = inputId,
        shiny::tags$select(
          multiple = if (multiple) NA else NULL,
          options
        ),
        htmltools::tagQuery(
          f7ListItem(title = label)
        )$
          find(".item-content")$
          selectedTags(),
        buildConfig(inputId, config)
      )
    )
  )
}

#' Update Framework7 smart select
#'
#' \code{updateF7SmartSelect} changes the value of a smart select input on the client.
#'
#' @param session The Shiny session object, usually the default value will suffice.
#'
#' @rdname smartselect
#' @export
updateF7SmartSelect <- function(inputId, selected = NULL, choices = NULL, multiple = NULL,
                                maxLength = NULL, ...,
                                session = shiny::getDefaultReactiveDomain()) {
  if (!is.null(selected)) {
    if (length(selected) == 1) {
      selected <- list(as.character(selected))
    } else {
      selected <- as.character(selected)
    }
  }
  config <- dropNulls(list(...))
  if (length(config) == 0) {
    config <- NULL
  }
  message <- dropNulls(list(
    selected = selected,
    choices = choices,
    multiple = multiple,
    maxLength = maxLength,
    config = config
  ))
  session$sendInputMessage(inputId, message)
}

#' Input layout default options
#'
#' @keywords internal
inputLayoutDefaults <- function() {
  list(
    media = NULL,
    description = NULL,
    floating = FALSE,
    outline = FALSE,
    clearable = TRUE
  )
}

#' Create common input layout
#'
#' See \url{https://framework7.io/docs/inputs#inputs-layout}.
#'
#' @importFrom utils modifyList
#'
#' @keywords internal
createInputLayout <- function(
    ..., label = NULL, style, dropdown = FALSE) {

  # make sure style does contain all defaults
  # this prevents an error when the users only provides
  # a subset of the style options
  style <- modifyList(inputLayoutDefaults(), style)

  if (style$floating && is.null(label)) {
    stop("floating can't be used when label is NULL")
  }

  item <- f7ListItem(
    media = style$media, # icon
    title = label # label
  )

  classes <- c(
    "item-input",
    if (style$outline) "item-input-outline",
    if (!is.null(style$description)) "item-input-with-info"
  )

  item <- htmltools::tagQuery(item)$
    find(".item-content")$
    addClass(classes)$
    allTags()

  # Add label on title + add input wrap sibling
  if (!is.null(label)) {
    item <- htmltools::tagQuery(item)$
      find(".item-title")$
      addClass("item-label")$
      allTags()
  }

  innerItems <- shiny::tags$div(
    class = paste0(
      "item-input-wrap",
      if (dropdown) " input-dropdown-wrap"
    ),
    ...,
    if (style$clearable) shiny::span(class = "input-clear-button"),
    if (!is.null(style$description)) {
      shiny::tags$div(
        class = "item-input-info",
        style$description
      )
    }
  )

  item <- if (is.null(label)) {
    htmltools::tagQuery(item)$
      find(".item-inner")$
      append(innerItems)$
      allTags()
  } else {
    htmltools::tagQuery(item)$
      find(".item-title")$
      after(innerItems)$
      allTags()
  }

  if (style$floating) {
    item <- htmltools::tagQuery(item)$
      find(".item-title")$
      removeClass("item-label")$
      addClass("item-floating-label")$
      allTags()
  }

  # Is item wrapped in a f7List? If yes, we return it,
  # if no, we wrap it to avoid rendering issues.
  # This list can't be styled as this would conflict
  # with the input style.
  listify(item)
}

#' Check if f7List is in call stack
#' @keywords internal
is_wrapped <- function() {
  sum(
    grepl(
      "^f7List",
      perl = TRUE,
      as.character(sys.calls())
    )
  ) == 1
}

#' Listify a tag
#' @keywords internal
listify <- function(tag, style = NULL) {
  # This list can only be styled by inputs making use
  # of the buildPicker function. For others, it would
  # conflict with the input style.
  if (!is.null(style) & !is_wrapped()) {
    do.call(f7List, c(tag, style))
  } else if (!is_wrapped()) {
    f7List(tag)
  } else {
    tag
  }
}

#' Create an input tag
#'
#' Useful for text inputs, password input ...
#'
#' @keywords internal
createInputTag <- function(inputId, value = NULL, type, placeholder, ...) {
  tagFunc <- if (type %in% c("textarea", "select")) {
    shiny::tags[[type]]
  } else {
    shiny::tags$input
  }

  tagFunc(
    id = inputId,
    value = value,
    if (type == "textarea") value,
    type = type,
    placeholder = placeholder,
    ...
  )
}

#' Framework7 text input
#'
#' \code{f7Text} creates a text input container.
#'
#' @param inputId Text input id.
#' @param label Text input label.
#' @param value Text input value.
#' @param placeholder Text input placeholder.
#' @param style Input style. A list with media (image or icon),
#' description (text), floating, outline and clearable (booleans).
#'
#' @rdname text
#'
#' @export
#'
#' @example inst/examples/text/app.R
f7Text <- function(
    inputId, label = NULL, value = "", placeholder = NULL,
    style = list(
      media = NULL,
      description = NULL,
      floating = FALSE,
      outline = FALSE,
      clearable = TRUE
    )) {
  inputTag <- createInputTag(
    inputId = inputId,
    value = value,
    type = "text",
    placeholder = placeholder
  )

  do.call(
    createInputLayout,
    list(
      inputTag,
      label = label,
      style = style
    )
  )
}

#' Update Framework7 text input
#'
#' \code{updateF7Text} changes the value of a text input on the client.
#'
#' @param session The Shiny session object, usually the default value will suffice.
#' @note Updating label does not work yet.
#' @export
#' @rdname text
updateF7Text <- function(
    inputId, label = NULL, value = NULL, placeholder = NULL,
    session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(label = label, value = value, placeholder = placeholder))
  session$sendInputMessage(inputId, message)
}

#' Framework7 text area input
#'
#' \code{f7TextArea} creates a f7 text area input.
#'
#' @param resize Whether to box can be resized. Default to FALSE.
#'
#' @export
#' @rdname text
f7TextArea <- function(inputId, label, value = "", placeholder = NULL,
                       resize = FALSE, style = list(
                         media = NULL,
                         description = NULL,
                         floating = FALSE,
                         outline = FALSE,
                         clearable = TRUE
                       )) {
  inputTag <- createInputTag(
    inputId = inputId,
    value = value,
    type = "textarea",
    placeholder = placeholder,
    class = if (resize) "resizable" else NULL
  )

  do.call(
    createInputLayout,
    list(
      inputTag,
      label = label,
      style = style
    )
  )
}

#' Update Framework7 text area input
#'
#' \code{updateF7TextArea} changes the value of a text area input on the client.
#'
#' @rdname text
#' @export
updateF7TextArea <- updateF7Text

#' Create an f7 password input
#'
#' \link{f7Password} creates a password input.
#'
#' @export
#' @rdname text
f7Password <- function(
    inputId, label, placeholder = NULL,
    style = list(
      media = NULL,
      description = NULL,
      floating = FALSE,
      outline = FALSE,
      clearable = TRUE
    )) {
  inputTag <- createInputTag(
    inputId = inputId,
    type = "password",
    placeholder = placeholder
  )

  do.call(
    createInputLayout,
    list(
      inputTag,
      label = label,
      style = style
    )
  )
}

#' Framework7 range slider
#'
#' \code{f7Slider} creates a f7 slider input.
#'
#' @param inputId Slider input id.
#' @param label Slider label.
#' @param min Slider minimum range.
#' @param max Slider maximum range.
#' @param value Slider value or a vector containing 2 values (for a range).
#' @param step Slider increase step size.
#' @param scale Slider scale.
#' @param scaleSteps Number of scale steps.
#' @param scaleSubSteps Number of scale sub steps (each step will be divided by this value).
#' @param vertical Whether to apply a vertical display. FALSE by default.
#' @param verticalReversed Makes vertical range slider reversed (vertical must be also enabled).
#' FALSE by default.
#' @param labels Enables additional label around range slider knob. List of 2 \link{f7Icon}
#' expected.
#' @param color See \link{getF7Colors} for valid colors.
#' @param noSwipping Prevent swiping when slider is manipulated in an \link{f7TabLayout}.
#' @param showLabel Allow bubble containing the slider value. Default
#' to TRUE.
#' @param ... Other options to pass to the widget. See
#' \url{https://framework7.io/docs/range-slider#range-slider-parameters}.
#' @param style Allows to style the input. inset, outline and strong are available.
#'
#' @note labels option only works when vertical is FALSE!
#'
#' @rdname slider
#'
#' @export
#'
#' @example inst/examples/slider/app.R
f7Slider <- function(inputId, label, min, max, value, step = 1, scale = FALSE,
                     scaleSteps = 5, scaleSubSteps = 0, vertical = FALSE,
                     verticalReversed = FALSE, labels = NULL, color = NULL,
                     noSwipping = TRUE, showLabel = TRUE, ...,
                     style = list(
                       inset = FALSE,
                       outline = FALSE,
                       strong = FALSE
                     )) {
  if (!is.null(labels)) {
    if (length(labels) < 2) stop("labels must be a tagList with 2 elements.")
  }

  sliderCl <- "range-slider"
  if (!is.null(color)) sliderCl <- paste0(sliderCl, " color-", color)

  if (isTRUE(noSwipping)) {
    sliderCl <- paste(sliderCl, "swiper-no-swiping")
  }

  config <- dropNulls(
    list(
      dual = if (length(value) == 2) TRUE else FALSE,
      min = min,
      max = max,
      vertical = vertical,
      verticalReversed = if (vertical) verticalReversed,
      label = showLabel,
      step = step,
      value = value,
      scale = scale,
      scaleSteps = scaleSteps,
      scaleSubSteps = scaleSubSteps
    )
  )

  # wrap props
  rangeTag <- shiny::tags$div(
    class = sliderCl,
    id = inputId,
    style = if (vertical) {
      if (scale) {
        "height: 160px; margin: 20px;"
      } else {
        "height: 160px;"
      }
    } else {
      NULL
    },
    buildConfig(inputId, config)
  )

  labels <- if (!is.null(labels)) {
    lapply(seq_along(labels), function(i) {
      isF7Icon <- grepl(x = labels[[i]]$attribs$class, pattern = "f7-icons")
      if (!inherits(labels[[i]], "shiny.tag") || !isF7Icon) {
        stop("Label must be a f7Icon.")
      }
      shiny::tags$div(
        labels[[i]]
      )
    })
  }

  # wrapper
  shiny::tagList(
    # HTML skeleton
    shiny::tags$div(class = "block-title", label),
    if (!is.null(labels)) {
      f7List(
        mode = "simple",
        inset = style$inset,
        outline = style$outline,
        strong = style$strong,
        shiny::tags$li(
          labels[[1]],
          shiny::tags$div(
            style = "width: 100%; margin: 0 16px",
            rangeTag
          ),
          labels[[2]]
        )
      )
    } else {
      f7Block(
        inset = style$inset,
        outline = style$outline,
        strong = style$strong,
        rangeTag
      )
    }
  )
}

#' Update Framework7 range slider
#'
#' \code{updateF7Slider} changes the value of a slider input on the client.
#'
#' @param session The Shiny session object.
#'
#' @export
#' @rdname slider
#'
#' @note Important: you cannot transform a range slider into a simple slider and inversely.
updateF7Slider <- function(inputId, min = NULL, max = NULL, value = NULL,
                           scale = FALSE, scaleSteps = NULL, scaleSubSteps = NULL,
                           step = NULL, color = NULL, ...,
                           session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(
    value = value,
    min = min,
    max = max,
    scale = scale,
    step = step,
    scaleSteps = scaleSteps,
    scaleSubSteps = scaleSubSteps,
    color = color,
    ...
  ))
  session$sendInputMessage(inputId, message)
}

#' Framework7 stepper input
#'
#' \code{f7Stepper} creates a stepper input.
#'
#' @param inputId Stepper input id.
#' @param label Stepper label.
#' @param min Stepper minimum value.
#' @param max Stepper maximum value.
#' @param value Stepper value. Must belong to \code{\[min, max\]}.
#' @param step Increment step. 1 by default.
#' @param fill Whether to fill the stepper. FALSE by default.
#' @param rounded Whether to round the stepper. FALSE by default.
#' @param raised Whether to put a relied around the stepper. FALSE by default.
#' @param size Stepper size: "small", "large" or NULL.
#' @param color Stepper color: NULL or "red", "green", "blue", "pink", "yellow", "orange", "grey" and "black".
#' @param wraps In wraps mode incrementing beyond maximum value sets value to minimum value,
#' likewise, decrementing below minimum value sets value to maximum value. FALSE by default.
#' @param autorepeat Pressing and holding one of its buttons increments or decrements the stepper’s
#' value repeatedly. With dynamic autorepeat, the rate of change depends on how long the user
#' continues pressing the control. TRUE by default.
#' @param manual It is possible to enter value manually from keyboard or mobile keypad. When click on
#' input field, stepper enter into manual input mode, which allow type value from keyboar and check
#' fractional part with defined accurancy. Click outside or enter Return key, ending manual mode.
#' TRUE by default.
#' @param decimalPoint Number of digits after dot, when in manual input mode.
#' @param buttonsEndInputMode Disables manual input mode on Stepper's minus or plus button click.
#'
#' @rdname stepper
#' @example inst/examples/stepper/app.R
#' @export
f7Stepper <- function(inputId, label, min, max, value, step = 1,
                      fill = FALSE, rounded = FALSE, raised = FALSE, size = NULL,
                      color = NULL, wraps = FALSE, autorepeat = TRUE, manual = FALSE,
                      decimalPoint = 4, buttonsEndInputMode = TRUE) {
  stepperCl <- "stepper"
  if (fill) stepperCl <- paste(stepperCl, "stepper-fill")
  if (rounded) stepperCl <- paste(stepperCl, "stepper-round")
  if (!is.null(size)) {
    stepperCl <- paste0(stepperCl, " stepper-", size)
  }
  if (raised) stepperCl <- paste(stepperCl, "stepper-raised")
  if (!is.null(color)) stepperCl <- paste0(stepperCl, " color-", color)

  # stepper props
  config <- dropNulls(
    list(
      min = min,
      max = max,
      step = step,
      value = value,
      decimalPoint = decimalPoint,
      wraps = wraps,
      autorepeat = autorepeat,
      autorepeatDynamic = autorepeat,
      manualInputMode = manual,
      buttonsEndInputMode = buttonsEndInputMode
    )
  )

  # wrap props
  stepperTag <- shiny::tags$div(
    class = stepperCl,
    id = inputId,
    buildConfig(inputId, config)
  )

  stepperTag <- shiny::tagAppendChildren(
    stepperTag,
    shiny::tags$div(class = "stepper-button-minus"),
    shiny::tags$div(
      class = "stepper-input-wrap",
      shiny::tags$input(
        type = "text",
        value = value,
        min = min,
        max = max,
        step = step
      )
    ),
    shiny::tags$div(class = "stepper-button-plus")
  )

  # if not wrapped inside f7List, return "standalone" toggle
  if (!is_wrapped()) {
    shiny::div(
      # stepper tag
      style = "display: flex; align-items: center;",
      shiny::tags$small(label, style = "padding: 5px"),
      stepperTag
    )
  } else {
    listify(
      f7ListItem(
        title = label,
        right = stepperTag
      )
    )
  }
}

#' Update Framework7 stepper
#'
#' \code{updateF7Stepper} changes the value of a stepper input on the client.
#'
#' @param session The Shiny session object, usually the default value will suffice.
#'
#' @export
#' @rdname stepper
#'
#' @note While updating, the autorepeat field does not work correctly.
updateF7Stepper <- function(inputId, min = NULL, max = NULL,
                            value = NULL, step = NULL, fill = NULL,
                            rounded = NULL, raised = NULL, size = NULL,
                            color = NULL, wraps = NULL, decimalPoint = NULL,
                            autorepeat = NULL, manual = NULL,
                            session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(
    min = min,
    max = max,
    value = value,
    step = step,
    fill = fill,
    rounded = rounded,
    raised = raised,
    size = size,
    color = color,
    wraps = wraps,
    decimalPoint = decimalPoint,
    autorepeat = autorepeat,
    manual = manual
  ))
  session$sendInputMessage(inputId, message)
}

#' Framework7 toggle input
#'
#' \code{f7Toggle} creates a F7 toggle switch input.
#'
#' @param inputId Toggle input id.
#' @param label Toggle label.
#' @param checked Whether to check the toggle. FALSE by default.
#' @param color
#' Toggle color: NULL or "primary", "red", "green", "blue",
#' "pink", "yellow", "orange", "purple", "deeppurple", "lightblue",
#' "teal, "lime", "deeporange", "gray", "white", "black".
#'
#' @rdname toggle
#' @example inst/examples/toggle/app.R
#' @export
f7Toggle <- function(inputId, label, checked = FALSE, color = NULL) {
  toggleCl <- "toggle"
  if (!is.null(color)) toggleCl <- paste0(toggleCl, " color-", color)

  toggleInnerTag <-
    shiny::tags$label(
      class = toggleCl,
      id = inputId,
      shiny::tags$input(
        type = "checkbox",
        checked = if (checked) NA else NULL
      ),
      shiny::tags$span(class = "toggle-icon")
    )

  # if not wrapped inside f7List, return "standalone" toggle
  if (!is_wrapped()) {
    tagList(
      shiny::tags$span(label,
        style = "padding: 5px"
      ),
      toggleInnerTag
    )
  } else {
    listify(
      f7ListItem(
        title = label,
        right = toggleInnerTag
      )
    )
  }
}

#' Update Framework7 toggle input
#'
#' \code{updateF7Toggle} changes the value of a toggle input on the client.
#'
#' @param session The Shiny session object.
#'
#' @export
#' @rdname toggle
updateF7Toggle <- function(inputId, checked = NULL, color = NULL,
                           session = shiny::getDefaultReactiveDomain()) {
  message <- dropNulls(list(
    checked = checked,
    color = color
  ))
  session$sendInputMessage(inputId, message)
}

#' Framework7 radio input
#'
#' \code{f7Radio} creates a radio button input.
#'
#' @inheritParams f7GroupInput
#'
#' @export
#' @rdname radio
#' @example inst/examples/radio/app.R
f7Radio <- function(
    inputId, label, choices = NULL, selected = NULL,
    position = c("left", "right"), style = list(
      inset = FALSE,
      outline = FALSE, dividers = FALSE, strong = FALSE
    )) {
  position <- match.arg(position)
  f7GroupInput(
    type = "radio",
    inputId = inputId,
    label = label,
    choices = choices,
    selected = selected,
    position = position,
    style = style
  )
}

#' Update Framework7 radio buttons
#'
#' \code{updateF7Radio} updates a radio button input.
#'
#' @param session Shiny session object.
#'
#' @rdname radio
#' @export
updateF7Radio <- function(inputId, label = NULL, choices = NULL,
                          selected = NULL, session = shiny::getDefaultReactiveDomain()) {
  if (is.null(selected)) {
    if (!is.null(choices)) {
      selected <- choices[[1]]
    }
  }

  options <- NULL
  if (!is.null(choices)) {
    options <- as.character(
      shiny::tags$ul(
        createOptions(inputId, choices, selected, type = "radio")
      )
    )
  }

  message <- dropNulls(
    list(
      label = label,
      options = options,
      value = selected
    )
  )

  session$sendInputMessage(inputId, message)
}

#' @export
#' @inheritParams f7CheckboxChoice
#' @rdname radio
f7RadioChoice <- f7CheckboxChoice

#' Group input default options
#'
#' @keywords internal
groupInputDefaults <- function() {
  style = list(
    inset = FALSE,
    outline = FALSE,
    dividers = FALSE,
    strong = FALSE
  )
}

#' Framework7 group input
#'
#' Useful to create \code{f7Radio} and \link{f7CheckboxGroup}.
#'
#' @param inputId Input id.
#' @param label Input label
#' @param choices List of choices. Can be a simple
#' vector or named list or a list of \link{f7RadioChoice} or
#' \link{f7CheckboxChoice}
#' @param selected Selected element. NULL by default. If you pass
#' \link{f7RadioChoice} or \link{f7CheckboxChoice} in choices,
#' selected must be a numeric value corresponding to the index of the element to select.
#' @param position Check mark side.
#' \code{"left"} or \code{"right"}.
#' @param style Input style. Inherit from \link{f7List} options
#' such as outline, inset, strong and dividers.
#'
#' @importFrom utils modifyList
#'
#' @keywords internal
f7GroupInput <- function(
    type, inputId, label, choices, selected, position, style) {

  # make sure style does contain all defaults
  # this prevents an error when the users only provides
  # a subset of the style options
  style <- modifyList(groupInputDefaults(), style)
  has_media_list <- inherits(choices[[1]], "custom_choice")

  mainCl <- sprintf("shiny-input-%sgroup", type)
  position <- switch(position,
    "left" = "start",
    "right" = "end"
  )

  tmp <- f7List(
    mode = if (has_media_list) "media" else NULL,
    inset = style$inset,
    outline = style$outline,
    dividers = style$dividers,
    strong = style$strong,
    createOptions(
      inputId,
      choices,
      selected,
      position,
      has_media_list,
      type = type
    )
  )

  tmp$attribs$id <- inputId
  tmp$attribs$class <- paste(
    tmp$attribs$class,
    mainCl
  )

  shiny::tagList(
    shiny::tags$div(
      class = "block-title",
      label
    ),
    tmp
  )
}

#' Generates a list of option
#'
#' For \link{f7Radio} and \link{f7CheckboxGroup}
#'
#' @param inputId Radio input id.
#' @param choices List of choices.
#' @param selected Selected value
#' @param position Check mark position.
#' @param has_media_list For custom choices.
#' @param type Choose either "checkbox" or "radio"
#'
#' @keywords internal
createOptions <- function(
    inputId, choices, selected,
    position = "start", has_media_list = FALSE, type) {
  if (has_media_list) position <- "start"

  selectedPosition <- NULL
  selectedPosition <- if (!is.null(selected)) {
    if (has_media_list) {
      if (!is.numeric(selected) || selected > length(choices)) {
        stop("When using f7*Choice (Radio or Checkbox),
        selected must be a numeric value of the choice to select.
        selected can't be higher than the total number of choices.")
      }
      selected
    } else {
      match(selected, choices)
    }
  }

  lapply(X = seq_along(choices), function(i) {
    shiny::tags$li(
      shiny::tags$label(
        class = sprintf(
          "item-%s item-%s-icon-%s item-content",
          type,
          type,
          position
        ),
        shiny::tags$input(
          type = type,
          name = inputId,
          value = if (has_media_list) {
            names(choices)[[i]] %OR% i
          } else {
            choices[[i]]
          },
          checked = if (!is.null(selectedPosition)) {
            if (i == selectedPosition) NA
          }
        ),
        shiny::tags$i(class = sprintf("icon icon-%s", type)),
        shiny::tags$div(
          class = "item-inner",
          if (has_media_list) {
            choices[[i]]
          } else {
            shiny::tags$div(class = "item-title", choices[[i]])
          }
        )
      )
    )
  })
}

#' Creates an input form
#'
#' Instead of having shiny return one input
#' at a time, a form is a collection of related inputs.
#' The form returns a list with all sub-inputs as elements.
#' This avoids to have to deal with too many inputs.
#'
#' This only works with elements having
#' an input HTML tag.
#'
#' @param id Form unique id. Using `input$<id>` gives
#' the form result.
#' @param ... A list of input elements.
#'
#' @export
#' @rdname form-inputs
#' @example inst/examples/forms/app.R
f7Form <- function(id, ...) {
  inputs <- list(...)
  # All inputs must have a name + no binding
  inputs <- lapply(inputs, \(input) {
    # Test for different input types
    valid_inputs <- c("input", "textarea", "select")
    target <- NULL
    for (el in valid_inputs) {
      tmp <- htmltools::tagQuery(input)$
        find(el)$
        selectedTags()

      if (length(tmp) > 0) target <- el
    }
    query <- htmltools::tagQuery(input)$
      find(target)
    id <- query$
      selectedTags()[[1]]$
      attribs$id

    query$
      addAttrs(
      name = id,
      `data-shiny-no-bind-input` = NA
    )$allTags()
  })
  shiny::tags$form(class = "inputs-form", id = id, inputs)
}

#' Update a form on the server
#'
#' \link{updateF7Form} update form inputs on the server.
#'
#' @param data New form data.
#' @param session Shiny session objects.
#' @rdname form-inputs
#' @export
updateF7Form <- function(id, data, session = shiny::getDefaultReactiveDomain()) {
  session$sendInputMessage(id, data)
}

Try the shinyMobile package in your browser

Any scripts or data that you put into this service are public.

shinyMobile documentation built on May 29, 2024, 4:42 a.m.