Close #2216: allow highlight() selectize to contain selectize.js options

Author: cpsievert

R/highlight.R

@@ -115,7 +115,7 @@ highlight <- function(p, on = "plotly_click", off,
 
   # attach HTML dependencies (these libraries are used in the HTMLwidgets.renderValue() method)
   # TODO: only attach these when keys are present!
-  if (selectize) {
+  if (!identical(selectize, FALSE)) {
     p$dependencies <- c(p$dependencies, list(selectizeLib()))
   }
   if (dynamic) {

R/utils.R

@@ -368,6 +368,7 @@ supply_highlight_attrs <- function(p) {
 
   # defaults are now populated, allowing us to populate some other 
   # attributes such as the selectize widget definition
+  # TODO: this is wrong!!! What if set is missing and present?!
   sets <- unlist(lapply(p$x$data, "[[", "set"))
   keys <- setNames(lapply(p$x$data, "[[", "key"), sets)
   p$x$highlight$ctGroups <- i(unique(sets))
@@ -381,12 +382,29 @@ supply_highlight_attrs <- function(p) {
     hasKeys <- TRUE
 
     # include one selectize dropdown per "valid" SharedData layer
-    if (isTRUE(p$x$highlight$selectize)) {
+    selectize <- p$x$highlight$selectize %||% FALSE
+    if (!identical(selectize, FALSE)) {
+      options <- list(items = data.frame(value = k, label = k), group = i)
+      if (!is.logical(selectize)) {
+        options <- modify_list(options, selectize)
+      }
       # Hash i (the crosstalk group id) so that it can be used
       # as an HTML id client-side (i.e., key shouldn't contain spaces)
-      p$x$selectize[[rlang::hash(i)]] <- list(
-        items = data.frame(value = k, label = k), group = i
-      )
+      groupId <- rlang::hash(i)
+      
+      # If the selectize payload has already been built, use that already built payload
+      # (since it may have been modified at this point), unless there are new keys to consider
+      oldSelectize <- p$x$selectize[[groupId]]
+      if (length(oldSelectize) > 0) {
+        missingKeys <- setdiff(k, oldSelectize$items$value)
+        if (length(missingKeys) > 0) {
+          warning("Overwriting the existing selectize payload for group '", i, "'. If you've previously modified this payload in some way, consider modifying it again.")
+        } else {
+          options <- oldSelectize
+        }
+      } 
+      
+      p$x$selectize[[groupId]] <- options
     }
 
     # set default values via crosstalk api

inst/htmlwidgets/plotly.js

@@ -521,15 +521,17 @@ HTMLWidgets.widget({
       // communication between the widget and direct manipulation events
       if (x.selectize) {
         var selectizeID = Object.keys(x.selectize)[i];
-        var items = x.selectize[selectizeID].items;
+        var options = x.selectize[selectizeID];
         var first = [{value: "", label: "(All)"}];
-        var opts = {
-          options: first.concat(items),
-          searchField: "label",
-          valueField: "value",
-          labelField: "label",
-          maxItems: 50
-        };
+        var opts = $.extend({
+            options: first.concat(options.items),
+            searchField: "label",
+            valueField: "value",
+            labelField: "label",
+            maxItems: 50
+          }, 
+          options
+        );
         var select = $("#" + selectizeID).find("select")[0];
         var selectize = $(select).selectize(opts)[0].selectize;
         // NOTE: this callback is triggered when *directly* altering 

tests/testthat/test-animate-highlight.R

@@ -81,6 +81,49 @@ test_that("group_by.plotly() retains crosstalk set", {
   expect_true(all(b$x$data[[1]]$key == row.names(mtcars)))
 })
 
+test_that("highlight(selectize) produces a sensible payload", {
+  p <- mtcars %>%
+    highlight_key(~cyl, "Choose cylinder") %>%
+    plot_ly(x = ~wt, y = ~mpg) %>%
+    add_markers()
+  
+  # Builds basic payload when selectize=TRUE
+  b <- p %>%
+    highlight(selectize = TRUE) %>%
+    plotly_build()
+  
+  selectize <- list(
+    items = data.frame(value = c(6, 4, 8), label = c(6, 4, 8)), 
+    group = "Choose cylinder"
+  )
+  
+  expect_length(b$x$selectize, 1)
+  expect_equal(b$x$selectize[[1]], selectize)
+  
+  # Copies over any list() options
+  b2 <- p %>%
+    highlight(selectize = list(plugins = list("remove_button"))) %>%
+    plotly_build()
+  
+  selectize$plugins <- list("remove_button")
+  
+  expect_length(b2$x$selectize, 1)
+  expect_equal(b2$x$selectize[[1]], selectize)
+  
+  # Can also tack on options after building, and plotly_build() won't overwrite
+  b2$x$selectize[[1]] <- modifyList(
+    b2$x$selectize[[1]], list(foo = "bar")
+  )
+  
+  b2 <- plotly_build(b2)
+  
+  selectize$foo <- "bar"
+  
+  expect_equal(b2$x$selectize[[1]], selectize)
+  
+  
+})
+
 
 
 # Ignore for now https://github.com/ggobi/ggally/issues/264