add media list support for f7CheckboxGroup

NAMESPACE

@@ -19,6 +19,7 @@ export(f7BlockTitle)
 export(f7Button)
 export(f7Card)
 export(f7Checkbox)
+export(f7CheckboxChoice)
 export(f7CheckboxGroup)
 export(f7Chip)
 export(f7Col)

NEWS.md

@@ -30,6 +30,8 @@ We now return an object of objects which becomes a list of lists.
 - `f7Card()` get a new `raised` and `divider` parameters.
 - `f7CheckboxGroup()` has a new `position` parameter to control
 the check icon position. Default to left.
+- `f7CheckboxChoice()`: new function to pass inside `choices` in a
+`f7CheckboxGroup()`. Improved choice with title, subtitle, ...
 - Fix various issues in documentation.
 
 # shinyMobile 1.0.1

R/f7-inputs.R

@@ -944,8 +944,11 @@ updateF7Checkbox <- function(inputId, label = NULL, value = NULL,
 #'
 #' @param inputId Checkbox group input.
 #' @param label Checkbox group label.
-#' @param choices Checkbox group choices.
-#' @param selected Checkbox group selected value.
+#' @param choices Checkbox group choices. Can be a simple
+#' vector or named list or a list of \link{f7CheckboxChoice}.
+#' @param selected Checkbox group selected value. If you pass
+#' \link{f7CheckboxChoice} in choices, selected must be a numeric
+#' value corresponding to the element to select.
 #' @param position Check mark position.
 #' \code{"left"} or \code{"right"}.
 #'
@@ -961,35 +964,62 @@ f7CheckboxGroup <- function(
     "left" = "start",
     "right" = "end"
   )
-  selectedPosition <- if (!is.null(selected)) match(selected, choices) else NULL
+
+  has_media_list <- inherits(choices[[1]], "custom_choice")
+  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 f7CheckboxChoice, 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)
+    }
+  }
   choicesTag <- lapply(X = seq_along(choices), function(i) {
     shiny::tags$li(
       shiny::tags$label(
         class = sprintf("item-checkbox item-checkbox-icon-%s item-content", position),
         shiny::tags$input(
           type = "checkbox",
           name = inputId,
-          value = choices[[i]],
+          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 = "icon icon-checkbox"),
         shiny::tags$div(
           class = "item-inner",
-          shiny::tags$div(class = "item-title", choices[[i]])
+          if (has_media_list) {
+            choices[[i]]
+          } else {
+            shiny::tags$div(class = "item-title", choices[[i]])
+          }
         )
       )
     )
   })
 
+  mainCl <- "list list-strong-ios list-outline-ios list-dividers-ios shiny-input-checkboxgroup"
+  if (has_media_list) mainCl <- paste(mainCl, "media-list")
+
   shiny::tagList(
     shiny::tags$div(
       class = "block-title",
       label
     ),
     shiny::tags$div(
-      class = "list list-strong-ios list-outline-ios list-dividers-ios shiny-input-checkboxgroup",
+      class = mainCl,
       id = inputId,
       shiny::tags$ul(
         choicesTag
@@ -998,6 +1028,39 @@ f7CheckboxGroup <- function(
   )
 }
 
+#' 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) {
+  structure(
+    tagList(
+      shiny::tags$div(
+        class = "item-title-row",
+        shiny::tags$div(class = "item-title", title),
+        if (!is.null(after)) {
+          shiny::tags$div(
+            class = "item-after",
+            after
+          )
+        }
+      ),
+      if (!is.null(subtitle)) {
+        shiny::tags$div(class = "item-subtitle", subtitle)
+      },
+      shiny::tags$div(class = "item-text", ...)
+    ),
+    class = "custom_choice"
+  )
+}
+
 #' Create option html tag based on choice input
 #'
 #' Used by \link{f7SmartSelect} and \link{f7Select}

inst/examples/checkboxgroup/app.R

@@ -6,14 +6,41 @@ app <- shinyApp(
     title = "My app",
     f7SingleLayout(
       navbar = f7Navbar(title = "f7CheckboxGroup"),
+      f7BlockTitle("Simple choices", size = "large"),
       f7CheckboxGroup(
         inputId = "checkboxgroup",
         label = "Choose a variable:",
         choices = colnames(mtcars)[-1],
         selected = "disp",
         position = "right"
       ),
-      tableOutput("data")
+      tableOutput("data"),
+      f7BlockTitle("Custom choices: f7CheckboxChoice", size = "large"),
+      f7CheckboxGroup(
+        inputId = "checkboxgroup2",
+        label = "Custom choices",
+        choices = list(
+          f7CheckboxChoice(
+            "Lorem ipsum dolor sit amet, consectetur adipiscing elit.
+            Nulla sagittis tellus ut turpis condimentum,
+            ut dignissim lacus tincidunt",
+            title = "Choice 1",
+            subtitle = "David",
+            after = "March 16, 2024"
+          ),
+          f7CheckboxChoice(
+            "Cras dolor metus, ultrices condimentum sodales sit
+            amet, pharetra sodales eros. Phasellus vel felis tellus.
+            Mauris rutrum ligula nec dapibus feugiat",
+            title = "Choice 2",
+            subtitle = "Veerle",
+            after = "March 17, 2024"
+          )
+        ),
+        selected = 2,
+        position = "right"
+      ),
+      textOutput("selected")
     )
   ),
   server = function(input, output) {
@@ -23,6 +50,7 @@ app <- shinyApp(
       },
       rownames = TRUE
     )
+    output$selected <- renderText(input$checkboxgroup2)
   }
 )
 

tests/testthat/_snaps/mac-4.3/checkbox/checkboxgroup-app-001.json

@@ -1,5 +1,6 @@
 {
   "input": {
-    "checkboxgroup": "disp"
+    "checkboxgroup": "disp",
+    "checkboxgroup2": "2"
   }
 }

tests/testthat/_snaps/mac-4.3/checkbox/checkboxgroup-app-002.json

@@ -1,5 +1,6 @@
 {
   "input": {
-    "checkboxgroup": "wt"
+    "checkboxgroup": "wt",
+    "checkboxgroup2": "1"
   }
 }

tests/testthat/test-checkbox.R

@@ -45,6 +45,41 @@ test_that("checkboxgroup tag", {
     selectedTag()
 
   expect_length(items, length(colnames(mtcars)) - 1)
+
+  # With f7CheckboxChoice
+  expect_error(
+    f7CheckboxGroup(
+      inputId = "checkboxgroup2",
+      label = "Custom choices",
+      choices = list(
+        f7CheckboxChoice(
+          "Lorem ipsum dolor sit amet, consectetur adipiscing elit.
+        Nulla sagittis tellus ut turpis condimentum,
+        ut dignissim lacus tincidunt",
+          title = "Choice 1",
+          subtitle = "David",
+          after = "March 16, 2024"
+        )
+      ),
+      selected = 2
+    )
+  )
+  checkbox_group <- f7CheckboxGroup(
+    inputId = "checkboxgroup2",
+    label = "Custom choices",
+    choices = list(
+      f7CheckboxChoice(
+        "Lorem ipsum dolor sit amet, consectetur adipiscing elit.
+        Nulla sagittis tellus ut turpis condimentum,
+        ut dignissim lacus tincidunt",
+        title = "Choice 1",
+        subtitle = "David",
+        after = "March 16, 2024"
+      )
+    )
+  )
+
+  expect_true(grepl("media-list", checkbox_group[[2]]$attribs$class))
 })
 
 library(shinytest2)
@@ -58,7 +93,7 @@ test_that("checkboxgroup works as expected", {
     name = "checkboxgroup-app",
     variant = platform_variant()
   )
-  app$expect_values(input = "checkboxgroup")
-  app$set_inputs("checkboxgroup" = "wt")
-  app$expect_values(input = "checkboxgroup")
+  app$expect_values(input = c("checkboxgroup", "checkboxgroup2"))
+  app$set_inputs("checkboxgroup" = "wt", "checkboxgroup2" = "1")
+  app$expect_values(input = c("checkboxgroup", "checkboxgroup2"))
 })