rexport landing_popup function just for tests

insightsengineering · Oct 16, 2023 · 1bdc926 · 1bdc926
1 parent 4e55d5a
commit 1bdc926
Show file tree

Hide file tree

Showing 3 changed files with 24 additions and 0 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -10,6 +10,7 @@ S3method(create_sparklines,logical)
 S3method(create_sparklines,numeric)
 export(add_facet_labels)
 export(get_scatterplotmatrix_stats)
+export(landing_popup)
 export(tm_a_pca)
 export(tm_a_regression)
 export(tm_data_table)

diff --git a/R/tm_landing_popup.R b/R/tm_landing_popup.R
@@ -92,3 +92,23 @@ srv_landing_popup <- function(id, title, content, buttons) {
 ui_landing_popup <- function(id, ...) {
   NULL
 }
+
+#' @rdname tm_landing_popup
+#' @export
+landing_popup <- function(title = NULL, content = NULL, buttons = modalButton("Accept")) {
+  checkmate::assert_string(title, null.ok = TRUE)
+  checkmate::assert_multi_class(
+    content,
+    classes = c("character", "shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE
+  )
+  checkmate::assert_multi_class(buttons, classes = c("shiny.tag", "shiny.tag.list"), null.ok = TRUE)
+
+  showModal(
+    modalDialog(
+      id = "landingpopup",
+      title = title,
+      content,
+      footer = buttons
+    )
+  )
+}
diff --git a/man/tm_landing_popup.Rd b/man/tm_landing_popup.Rd