fix clicking on tag clear button in a dropdown

dreamRs · Jan 31, 2025 · 3195ea7 · 3195ea7
1 parent 955a82a
commit 3195ea7
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 22 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: shinyWidgets
 Title: Custom Inputs Widgets for Shiny
-Version: 0.8.7.9200
+Version: 0.8.7.9300
 Authors@R: c(
   person("Victor", "Perrier", email = "[email protected]", role = c("aut", "cre", "cph")),
   person("Fanny", "Meyer", role = "aut"),

diff --git a/R/dependencies.R b/R/dependencies.R
@@ -15,14 +15,14 @@ attachShinyWidgetsDep <- function(tag, widget = NULL, extra_deps = NULL) {
     if (widget == "picker") {
       dependencies <- list(
         dependencies,
-        # htmltools::htmlDependencies(shiny::fluidPage())[[1]],
+        # htmlDependencies(shiny::fluidPage())[[1]],
         html_dependency_picker()
       )
     } else if (widget == "awesome") {
       dependencies <- list(
         dependencies,
         html_dependency_awesome(),
-        htmltools::findDependencies(shiny::icon("rebel"))[[1]]
+        findDependencies(shiny::icon("rebel"))[[1]]
       )
     } else if (widget == "bsswitch") {
       dependencies <- c(
@@ -42,7 +42,7 @@ attachShinyWidgetsDep <- function(tag, widget = NULL, extra_deps = NULL) {
     } else if (widget == "dropdown") {
       dependencies <- list(
         dependencies,
-        htmltools::htmlDependency(
+        htmlDependency(
           name = "dropdown-patch",
           version = packageVersion("shinyWidgets"),
           src = c(href = "shinyWidgets/dropdown"),
@@ -52,7 +52,7 @@ attachShinyWidgetsDep <- function(tag, widget = NULL, extra_deps = NULL) {
     } else if (widget == "sw-dropdown") {
       dependencies <- list(
         dependencies,
-        htmltools::htmlDependency(
+        htmlDependency(
           name = "sw-dropdown",
           version = packageVersion("shinyWidgets"),
           src = c(href = "shinyWidgets/sw-dropdown"),
@@ -95,7 +95,7 @@ attachShinyWidgetsDep <- function(tag, widget = NULL, extra_deps = NULL) {
   } else {
     dependencies <- c(list(dependencies), extra_deps)
   }
-  htmltools::attachDependencies(
+  attachDependencies(
     x = tag,
     value = dependencies,
     append = TRUE
@@ -104,7 +104,7 @@ attachShinyWidgetsDep <- function(tag, widget = NULL, extra_deps = NULL) {
 
 
 html_dependency_shinyWidgets <- function() {
-  htmltools::htmlDependency(
+  htmlDependency(
     name = "shinyWidgets",
     version = packageVersion("shinyWidgets"),
     src = c(href = "shinyWidgets", file = "assets"),

diff --git a/R/sw-dropdown.R b/R/sw-dropdown.R
@@ -20,7 +20,7 @@
 #'
 #' @seealso [dropMenu()] for a more robust alternative.
 #'
-#' @importFrom htmltools validateCssUnit tagList singleton tags tagAppendChild
+#' @importFrom htmltools validateCssUnit tagList singleton tags tagAppendChild css tagFunction
 #'
 #' @export
 #' @examples
@@ -119,13 +119,13 @@ dropdown <- function(...,
   has_tooltip <- !is.null(tooltip) && !identical(tooltip, FALSE)
 
   # Dropdown content
-  dropcontent <- htmltools::tags$div(
+  dropcontent <- tags$div(
     id = contentId,
     class = "sw-dropdown-content animated",
     class = if (up) "sw-dropup-content",
     class = if (right) "sw-dropright-content",
-    style = htmltools::css(width = htmltools::validateCssUnit(width)),
-    htmltools::tags$div(class = "sw-dropdown-in", ...)
+    style = css(width = validateCssUnit(width)),
+    tags$div(class = "sw-dropdown-in", ...)
   )
   # Button
   if (style == "default") {
@@ -136,7 +136,7 @@ dropdown <- function(...,
       ),
       class = "action-button",
       type = "button", id = inputId, list(icon, label),
-      htmltools::tags$span(
+      tags$span(
         class = ifelse(
           test = up,
           yes = "glyphicon glyphicon-triangle-top",
@@ -158,7 +158,7 @@ dropdown <- function(...,
   }
 
   if (has_tooltip) {
-    btn <- htmltools::tagAppendAttributes(
+    btn <- tagAppendAttributes(
       btn,
       `data-bs-toggle` = "tooltip",
       `data-bs-title` = tooltip$title,
@@ -168,7 +168,7 @@ dropdown <- function(...,
   }
 
   # Final tag
-  dropdownTag <- htmltools::tags$div(class = "sw-dropdown", id = dropId, btn, dropcontent)
+  dropdownTag <- tags$div(class = "sw-dropdown", id = dropId, btn, dropcontent)
 
   if (has_tooltip) {
     tooltip <- lapply(tooltip, function(x) {
@@ -178,7 +178,7 @@ dropdown <- function(...,
         "false"
       else x
     })
-    tooltipJs <- htmltools::tagFunction(function() {
+    tooltipJs <- tagFunction(function() {
       theme <- shiny::getCurrentTheme()
       if (!bslib::is_bs_theme(theme)) {
         return(dropdown_tooltip_bs3(inputId, tooltip))
@@ -188,16 +188,17 @@ dropdown <- function(...,
       }
       dropdown_tooltip_bs3(inputId, tooltip)
     })
-    dropdownTag <- htmltools::tagAppendChild(dropdownTag, tooltipJs)
+    dropdownTag <- tagAppendChild(dropdownTag, tooltipJs)
   }
 
   # Animate
   if (identical(animate, TRUE))
     animate <- animateOptions()
 
   if (!is.null(animate) && !identical(animate, FALSE)) {
-    dropdownTag <- htmltools::tagAppendChild(
-      dropdownTag, htmltools::tags$script(
+    dropdownTag <- tagAppendChild(
+      dropdownTag,
+      tags$script(
         sprintf(
           "$(function() {swDrop('%s', '%s', '%s', '%s', '%s', '%s');});",
           inputId, contentId, dropId,
@@ -207,8 +208,9 @@ dropdown <- function(...,
     )
     dropdownTag <- attachShinyWidgetsDep(dropdownTag, "animate")
   } else {
-    dropdownTag <- htmltools::tagAppendChild(
-      dropdownTag, htmltools::tags$script(
+    dropdownTag <- tagAppendChild(
+      dropdownTag,
+      tags$script(
         sprintf(
           "$(function() {swDrop('%s', '%s', '%s', '%s', '%s', '%s');});",
           inputId, contentId, dropId, "sw-none", "sw-none", "1"
@@ -223,7 +225,7 @@ dropdown <- function(...,
 
 
 dropdown_tooltip_bs3 <- function(inputId, tooltip) {
-  htmltools::tags$script(
+  tags$script(
     sprintf(
       "$('#%s').tooltip({ placement: '%s', title: '%s', html: %s });",
       inputId, tooltip$placement, tooltip$title, tooltip$html
@@ -232,7 +234,7 @@ dropdown_tooltip_bs3 <- function(inputId, tooltip) {
 }
 
 dropdown_tooltip_bs5 <- function(inputId, tooltip) {
-  htmltools::tags$script(
+  tags$script(
     sprintf("const el = document.getElementById('%s');", inputId),
     "new bootstrap.Tooltip(el);"
   )

diff --git a/inst/assets/sw-dropdown/sw-dropdown.js b/inst/assets/sw-dropdown/sw-dropdown.js
@@ -84,6 +84,9 @@ function swDrop(
       !(
         $(e.target).parents('.bootstrap-select').length
       ) && // hack for pickr color
+      !(
+        $(e.target).parents('.vscomp-value-tag-clear-button').length
+      ) && // hack for pickr color
       !(
         $(e.target).parents('.pcr-app').length
       ) && // hack for shinytree