Merge pull request #327 from RinteRface/dev

2.2.1 CRAN release

Author: DivadNojnarg

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 2.1.0
-Date: 2022-05-05 10:02:55 UTC
-SHA: bc925b4fc8e80f314309110b7dbbdbef519a015d
+Version: 2.2.0
+Date: 2022-12-19 15:31:26 UTC
+SHA: 1dd37a54211d349f24da52fde1390218510e5d6c

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bs4Dash
 Type: Package
 Title: A 'Bootstrap 4' Version of 'shinydashboard'
-Version: 2.1.0
+Version: 2.2.1
 Authors@R: c(
   person("David", "Granjon", email = "dgranjon@ymail.com", role = c("aut", "cre")),
   person(family = "RinteRface", role = "cph"),
@@ -28,7 +28,6 @@ Suggests:
     knitr,
     rmarkdown,
     testthat (>= 2.1.0),
-    covr,
     golem,
     DT, 
     thematic (>= 0.1.2)

NAMESPACE

@@ -115,6 +115,8 @@ export(menuSubItem)
 export(messageItem)
 export(multiProgressBar)
 export(notificationItem)
+export(pagination)
+export(paginationItem)
 export(popover)
 export(productList)
 export(productListItem)
@@ -156,6 +158,7 @@ export(updateCard)
 export(updateCardSidebar)
 export(updateControlbar)
 export(updateControlbarMenu)
+export(updatePagination)
 export(updateSidebar)
 export(updateTabItems)
 export(updateUserMessages)

NEWS.md

@@ -1,3 +1,27 @@
+# bs4Dash 2.2.1
+
+## New features
+- New `pagination()` and `updatePagination()`. Bootstrap 4 implementation of
+[pagination](https://getbootstrap.com/docs/4.0/components/pagination/).
+
+## Minor change
+- Fix #323: remove sidebar collapse animation on app startup. JS code moved
+back to R. Thanks @lucas-alcantara for reporting.
+
+## Bug fixes
+- Fix #325: `menuItem()` applied wrong class to any nested element that is not
+a `menuSubItem()`. Thanks @echoplaza for reporting. 
+- Fix #322: `notificationItem()` href does not work. 
+- Fix #306: Dynamic `menuSubItems()` with apply() adds some extra text. Added __.list__
+param to `menuItem()` to programmatically pass `menuSubItem()` as list. 
+- Fix #297: `tabsetPanel()` renders below the list of `tabPanels` when vertical = TRUE. 
+Changed layout to `fluidRow`. Thanks @lucas-alcantara for reporting. 
+- Fix #296: Documentation issue for `valueBox()` and `infoBox()` in the render function section.
+Thanks @corderoortiz for reporting.
+- Fix #293: Navbar stays keeps white background, even when dark mode is selected/toggled. Related to a previous PR. Thanks to @JJohnson-DA for reporting.
+- Fix #290: don't set `data-toggle="tab"` when `href` is not NULL in `tabsetPanel()`. Thanks @veer0318 for reporting.
+- Fix #243: `tabsetPanel()` id's not properly generated when inserting tabs to non-empty tabset. Thanks @DarkSideOfTheMat for reporting and giving hints.
+
 # bs4Dash 2.1.0
 
 ## Breaking change
@@ -435,4 +459,4 @@ htmltools
 - update Readme
 
 # bs4Dash 0.1.0
-- initial release
+- initial release

R/dashboardHeader.R

@@ -480,7 +480,7 @@ messageItem <- function(from, message, icon = shiny::icon("user"), time = NULL,
 #'   \item \code{teal}: \Sexpr[results=rd, stage=render]{bs4Dash:::rd_color_tag("#39cccc")}.
 #'   \item \code{olive}: \Sexpr[results=rd, stage=render]{bs4Dash:::rd_color_tag("#3d9970")}.
 #' }
-#' @param href An optional URL to link to.
+#' @param href An optional URL to link to. When inputId is set, href will be ignored.
 #' @param inputId Whether to allow the item to act as a \link[shiny]{actionButton}.
 #'
 #' @rdname dropdownMenu
@@ -504,9 +504,9 @@ notificationItem <- function(text, icon = shiny::icon("triangle-exclamation"),
       class = itemCl,
       `disabled` = if (is.null(inputId)) NA else NULL,
       href = if (is.null(inputId)) {
-        "#"
+        if (!is.null(href)) href else "#"
       } else {
-        href
+        "#"
       },
       target = if (is.null(inputId)) {
         if (!is.null(href)) "_blank"

R/dashboardPage.R

@@ -97,6 +97,8 @@ bs4DashPage <- function(header, sidebar, body, controlbar = NULL, footer = NULL,
   titleTag <- header[[2]]
 
   sidebarDisabled <- sidebar$attribs$`data-disable`
+  sidebarCollapsed <- sidebar$attribs$`data-collapsed`
+  sidebarMini <- sidebar$attribs$`data-minified`
 
   # layout changes if main sidebar is disabled
   if (!sidebarDisabled) {
@@ -121,7 +123,22 @@ bs4DashPage <- function(header, sidebar, body, controlbar = NULL, footer = NULL,
     # remove navbar padding to better fit the brand logo
     header[[1]]$attribs$style <- "padding: 0rem 0rem;"
   }
-
+  
+  bodyCl <- if (sidebarDisabled) "layout-top-nav" else NULL
+  if (sidebarCollapsed) {
+    bodyCl <- if (is.null(bodyCl)) {
+      "sidebar-collapse"
+    } else {
+      paste(bodyCl, "sidebar-collapse")
+    }
+  }
+  if (sidebarMini) {
+    bodyCl <- if (is.null(bodyCl)) {
+      "sidebar-mini"
+    } else {
+      paste(bodyCl, "sidebar-mini")
+    }
+  }
 
   # some checks
   tagAssert(header[[1]], type = "nav", class = "main-header")
@@ -174,7 +191,7 @@ bs4DashPage <- function(header, sidebar, body, controlbar = NULL, footer = NULL,
           0
         },
         `data-scrollToTop` = if (scrollToTop) 1 else 0,
-        class = if (sidebarDisabled) "layout-top-nav",
+        class = bodyCl,
         if (!is.null(preloader)) {
           shiny::tagList(
             waiter::useWaiter(), # dependencies

R/dashboardSidebar.R

@@ -125,9 +125,9 @@ bs4DashSidebar <- function(..., disable = FALSE, width = NULL,
     customCSS,
     id = id,
     `data-fixed` = tolower(fixed),
-    `data-minified` = if (minified) "true" else "false",
-    `data-collapsed` = dataValueString,
-    `data-disable` = if (disable) TRUE else FALSE,
+    `data-minified` = minified,
+    `data-collapsed` = collapsed,
+    `data-disable` = disable,
     class = paste0(
       "main-sidebar sidebar-", skin, "-",
       status, " elevation-", elevation,
@@ -311,6 +311,9 @@ findSidebarItem <- function(items, regex) {
 #' @param startExpanded Whether to expand the \link{menuItem} at start.
 #' @param condition When using \link{menuItem} with \link[shiny]{conditionalPanel},
 #' write the condition here (see \url{https://github.com/RinteRface/bs4Dash/issues/35}).
+#' @param .list An optional list containing items to put in the menu Same as the
+#' \code{...} arguments, but in list format. This can be useful when working
+#' with programmatically generated items.
 #'
 #' @rdname dashboardSidebar
 #'
@@ -360,8 +363,8 @@ bs4SidebarMenuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeC
                                tabName = NULL, href = NULL,
                                newTab = TRUE, selected = NULL,
                                expandedName = as.character(gsub("[[:space:]]", "", text)),
-                               startExpanded = FALSE, condition = NULL) {
-  subItems <- list(...)
+                               startExpanded = FALSE, condition = NULL, .list = NULL) {
+  subItems <- c(list(...), .list)
 
   if (!is.null(icon)) {
     tagAssert(icon, type = "i")
@@ -404,7 +407,7 @@ bs4SidebarMenuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeC
           target = if (!is.null(href)) {
             if (newTab) "_blank"
           },
-          `data-toggle` = "tab",
+          `data-toggle` = if (is.null(href)) "tab",
           `data-value` = if (!is.null(tabName)) tabName,
           # needed by leftSidebar.js
           `data-start-selected` = if (isTRUE(selected)) 1 else NULL,
@@ -415,13 +418,15 @@ bs4SidebarMenuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeC
     )
     # in case we have multiple subitems
   } else {
-
     # add special class for leftSidebar.js
     for (i in seq_along(subItems)) {
-      subItems[[i]]$children[[1]]$attribs$class <- paste(
-        subItems[[i]]$children[[1]]$attribs$class,
-        "treeview-link"
-      )
+      # Only apply if element is menuSubItem.
+      if (subItems[[i]]$attribs$class == "nav-item") {
+        subItems[[i]]$children[[1]]$attribs$class <- paste(
+          subItems[[i]]$children[[1]]$attribs$class,
+          "treeview-link"
+        )
+      }
     }
 
     # If we're restoring a bookmarked app, this holds the value of what menuItem (if any)
@@ -507,7 +512,7 @@ bs4SidebarMenuSubItem <- function(text, tabName = NULL, href = NULL,
       target = if (!is.null(href)) {
         if (newTab) "_blank"
       },
-      `data-toggle` = "tab",
+      `data-toggle` = if (is.null(href)) "tab",
       `data-value` = tabName,
       # below this is needed by leftSidebar.js
       `data-start-selected` = if (isTRUE(selected)) 1 else NULL,

R/render-functions.R

@@ -14,36 +14,38 @@
 #'   library(bs4Dash)
 #'
 #'   shiny::shinyApp(
-#'     ui = bs4DashPage(
-#'       header = bs4DashNavbar(),
-#'       sidebar = bs4DashSidebar(),
-#'       controlbar = bs4DashControlbar(),
-#'       footer = bs4DashFooter(),
+#'     ui = dashboardPage(
+#'       header = dashboardHeader(),
+#'       sidebar = dashboardSidebar(),
+#'       controlbar = dashboardControlbar(),
+#'       footer = dashboardFooter(),
 #'       title = "test",
-#'       body = bs4DashBody(
+#'       body = dashboardBody(
 #'         fluidRow(
-#'           bs4ValueBoxOutput("vbox"),
-#'           bs4InfoBoxOutput("ibox")
+#'           valueBoxOutput("vbox"),
+#'           infoBoxOutput("ibox")
 #'         )
 #'       )
 #'     ),
 #'     server = function(input, output) {
-#'       output$vbox <- renderbs4ValueBox({
-#'         bs4ValueBox(
+#'       output$vbox <- renderValueBox({
+#'         valueBox(
 #'           value = 150,
 #'           subtitle = "New orders",
-#'           status = "primary",
-#'           icon = "shopping-cart",
+#'           color = "primary",
+#'           icon = icon("shopping-cart"),
 #'           href = "#"
 #'         )
 #'       })
 #'
-#'       output$ibox <- renderbs4InfoBox({
-#'         bs4InfoBox(
+#'       output$ibox <- renderInfoBox({
+#'         infoBox(
 #'           title = "Comments",
-#'           gradientColor = "success",
+#'           fill = TRUE,
+#'           gradient = TRUE,
+#'           color = "success",
 #'           value = 41410,
-#'           icon = "comments"
+#'           icon = icon("comments")
 #'         )
 #'       })
 #'     }

R/tabs.R

@@ -216,12 +216,10 @@ tabsetPanel <- function(..., id = NULL, selected = NULL,
     if (item$attribs$class == "nav-item dropdown") {
       item$children[[2]]$children[[1]] <- lapply(item$children[[2]]$children[[1]], function(subitem) {
         subitem$attribs$`data-target` <- subitem$attribs$href
-        subitem$attribs$href <- "#"
         subitem
       })
     } else {
       item$children[[1]]$attribs$`data-target` <- item$children[[1]]$attribs$href
-      item$children[[1]]$attribs$href <- "#"
     }
     item
   })
@@ -243,12 +241,12 @@ tabsetPanel <- function(..., id = NULL, selected = NULL,
     tabsetContent <- temp_tabset$children[[2]]
 
     if (side == "left") {
-      shiny::tagList(
+      shiny::fluidRow(
         shiny::column(width = 2, tabsetMenu),
         shiny::column(width = 10, tabsetContent)
       )
     } else {
-      shiny::tagList(
+      shiny::fluidRow(
         shiny::column(width = 10, tabsetContent),
         shiny::column(width = 2, tabsetMenu)
       )