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

And also only populate the selectize payload once (allowing one to tack on more options after building, which can be useful for things like opt-groups)

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

@@ -381,12 +381,16 @@ 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
+    ctGroupId <- rlang::hash(i)
+    if (!identical(selectize, FALSE) && !(ctGroupId %in% names(p$x$selectize))) {
+      options <- list(items = data.frame(value = k, label = k), group = i)
+      if (!is.logical(selectize)) {
+        options <- utils::modifyList(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
-      )
+      p$x$selectize[[ctGroupId]] <- 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