fixes #257

.Rbuildignore

@@ -14,3 +14,6 @@
 ^tools$
 ^index\.Rmd$
 ^CRAN-SUBMISSION$
+^shinyMobile\.Rcheck$
+^shinyMobile.*\.tar\.gz$
+^shinyMobile.*\.tgz$

.gitignore

@@ -11,3 +11,6 @@ inst/examples/chat_widget
 docs
 inst/examples/chat_widget
 inst/tests/**
+shinyMobile.Rcheck/
+shinyMobile*.tar.gz
+shinyMobile*.tgz

DESCRIPTION

@@ -23,7 +23,7 @@ License: GPL-2
 Encoding: UTF-8
 URL: https://github.com/RinteRface/shinyMobile, https://rinterface.github.io/shinyMobile/
 BugReports: https://github.com/RinteRface/shinyMobile/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests: 
     knitr,
     rmarkdown,

NAMESPACE

@@ -76,6 +76,7 @@ export(f7Picker)
 export(f7Popover)
 export(f7PopoverTarget)
 export(f7Popup)
+export(f7Popup2)
 export(f7Progress)
 export(f7Radio)
 export(f7RemoveTab)

R/f7Card.R

@@ -266,7 +266,7 @@ f7SocialCard <- function(..., image = NULL, author = NULL, date = NULL,
 #' @export
 f7ExpandableCard <- function(..., id = NULL, title = NULL,
                              subtitle = NULL, color = NULL,
-                             image = NULL, fullBackground = FALSE) {
+                             image = NULL, fullBackground = FALSE, height = "300px") {
 
   cardColorCl <- if (!is.null(color)) paste0("bg-color-", color)
 
@@ -328,6 +328,7 @@ f7ExpandableCard <- function(..., id = NULL, title = NULL,
   # main wrapper
   shiny::tags$div(
     class = "card card-expandable",
+    style = paste0("height: ",height),
     `data-card` = paste0("#", id),
     id = id,
     shiny::tags$div(
@@ -345,6 +346,7 @@ f7ExpandableCard <- function(..., id = NULL, title = NULL,
       } else {
         shiny::tags$div(
           class = cardColorCl,
+          #style = paste0("height: ",height),
           style = "height: 300px;",
           cardHeader,
           closeCard

R/f7Popup2.R

@@ -0,0 +1,75 @@
+#' Title
+#'
+#' @param ...
+#' @param id
+#' @param title
+#' @param backdrop
+#' @param closeByBackdropClick
+#' @param closeOnEscape
+#' @param animate
+#' @param swipeToClose
+#' @param fullsize
+#' @param closeButton
+#' @param session
+#'
+#' @return
+#' @export
+#'
+#' @examples
+f7Popup2 <- function(..., id, title = NULL,
+                     backdrop = TRUE,
+                     closeByBackdropClick = TRUE,
+                     closeOnEscape = FALSE,
+                     animate = TRUE,
+                     swipeToClose = FALSE,
+                     fullsize = FALSE,
+                     closeButton = TRUE,
+                     session = shiny::getDefaultReactiveDomain()) {
+
+  message <- dropNulls(
+    list(
+      id = session$ns(id),
+      backdrop = backdrop,
+      closeByBackdropClick = closeByBackdropClick,
+      closeOnEscape = closeOnEscape,
+      animate = animate,
+      swipeToClose = swipeToClose
+    )
+  )
+
+  content <- shiny::tags$div(
+    class = "block",
+    if (!is.null(title)) shiny::tags$div(class = "block-title", title),
+    ...
+  )
+
+  if (closeButton) {
+    content <- htmltools::tagAppendChild(
+      content,
+      shiny::tags$a(
+        class = "link popup-close",
+        style = "position: absolute; top: -15px; left: 10px;",
+        href = "#",
+        #f7Icon("multiply")
+        f7Icon("arrow_left")
+      )
+    )
+  }
+
+  popup_tag <- shiny::tags$div(
+    class = paste0("popup", if (fullsize) "popup-tablet-fullscreen"),
+    content
+  )
+
+  message$content <- as.character(popup_tag)
+
+  # see my-app.js function
+  session$sendCustomMessage(
+    type = "popup",
+    message = jsonlite::toJSON(
+      message,
+      auto_unbox = TRUE,
+      json_verbatim = TRUE
+    )
+  )
+}

R/f7PopupKai.R

@@ -0,0 +1,125 @@
+#' Framework7 popup
+#'
+#' \code{f7Popup} creates a popup window with any UI content that pops up over App's main content.
+#' Popup as all other overlays is part of so called "Temporary Views".
+#'
+#' @param ... UI elements for the body of the popup window.
+#' @param id Popup unique id. Useful if you want to access the popup state.
+#' input$<id> is TRUE when the popup is opened and inversely.
+#' @param title Title for the popup window, use \code{NULL} for no title.
+#' @param backdrop Enables Popup backdrop (dark semi transparent layer behind).
+#'  Default to \code{TRUE}.
+#' @param closeByBackdropClick When enabled, popup will be closed on backdrop click.
+#'  Default to \code{TRUE}.
+#' @param closeOnEscape When enabled, popup will be closed on ESC keyboard key press.
+#'  Default to \code{FALSE}.
+#' @param animate Whether the Popup should be opened/closed with animation or not.
+#'  Default to \code{TRUE}.
+#' @param swipeToClose Whether the Popup can be closed with swipe gesture.
+#'  Can be true to allow to close popup with swipes to top and to bottom.
+#'  Default to \code{FALSE}.
+#' @param fullsize Open popup in full width or not. Default to \code{FALSE}.
+#' @param closeButton Add or not a button to easily close the popup.
+#'  Default to \code{TRUE}.
+#' @param session Shiny session object.
+#'
+#' @export
+#'
+#' @examples
+#' if (interactive()) {
+#'  library(shiny)
+#'  library(shinyMobile)
+#'  shinyApp(
+#'    ui = f7Page(
+#'      title = "Popup",
+#'      f7SingleLayout(
+#'       navbar = f7Navbar(
+#'         title = "f7Popup",
+#'         hairline = FALSE,
+#'         shadow = TRUE
+#'       ),
+#'       f7Button("togglePopup", "Toggle Popup")
+#'      )
+#'    ),
+#'    server = function(input, output, session) {
+#'
+#'     output$popupContent <- renderPrint(input$text)
+#'
+#'     observeEvent(input$togglePopup, {
+#'      f7Popup(
+#'        id = "popup1",
+#'        title = "My first popup",
+#'        f7Text("text", "Popup content", "This is my first popup ever, I swear!"),
+#'        verbatimTextOutput("popupContent")
+#'       )
+#'     })
+#'
+#'     observeEvent(input$popup1, {
+#'
+#'      popupStatus <- if (input$popup1) "opened" else "closed"
+#'
+#'      f7Toast(
+#'       position = "top",
+#'       text = paste("Popup is", popupStatus)
+#'      )
+#'     })
+#'    }
+#'  )
+#' }
+f7Popup2 <- function(..., id, title = NULL,
+                    backdrop = TRUE,
+                    closeByBackdropClick = TRUE,
+                    closeOnEscape = FALSE,
+                    animate = TRUE,
+                    swipeToClose = FALSE,
+                    fullsize = FALSE,
+                    closeButton = TRUE,
+                    closeButtonIcon = f7Icon("arrow_left"),
+                    session = shiny::getDefaultReactiveDomain()) {
+
+  message <- dropNulls(
+    list(
+      id = session$ns(id),
+      backdrop = backdrop,
+      closeByBackdropClick = closeByBackdropClick,
+      closeOnEscape = closeOnEscape,
+      animate = animate,
+      swipeToClose = swipeToClose
+    )
+  )
+
+  content <- shiny::tags$div(
+    class = "block",
+    if (!is.null(title)) shiny::tags$div(class = "block-title", title),
+    ...
+  )
+
+  if (closeButton) {
+    content <- htmltools::tagAppendChild(
+      content,
+      shiny::tags$a(
+        class = "link popup-close",
+        style = "position: absolute; top: -15px; left: 10px;",
+        href = "#",
+        closeButtonIcon
+      )
+    )
+  }
+
+  popup_tag <- shiny::tags$div(
+    class = paste0("popup", if (fullsize) "popup-tablet-fullscreen"),
+    content
+  )
+
+  message$content <- as.character(popup_tag)
+
+    # see my-app.js function
+    session$sendCustomMessage(
+      type = "popup",
+      message = jsonlite::toJSON(
+        message,
+        auto_unbox = TRUE,
+        json_verbatim = TRUE
+      )
+    )
+}