Add input_check_search()

DESCRIPTION

@@ -61,6 +61,7 @@ Collate:
     'deprecated.R'
     'files.R'
     'imports.R'
+    'input-check-search.R'
     'layout.R'
     'nav-items.R'
     'nav-update.R'

NAMESPACE

@@ -61,6 +61,7 @@ export(font_collection)
 export(font_face)
 export(font_google)
 export(font_link)
+export(input_check_search)
 export(is.card_item)
 export(is_bs_theme)
 export(layout_column_wrap)
@@ -94,6 +95,7 @@ export(showcase_left_center)
 export(showcase_top_right)
 export(theme_bootswatch)
 export(theme_version)
+export(update_check_search)
 export(value_box)
 export(version_default)
 export(versions)

R/input-check-search.R

@@ -0,0 +1,106 @@
+#' A searchable list of checkboxes
+#'
+#' @param id an input id.
+#' @param choices a vector/list of choices. If there are names on the on the vector, those names are used as the input value.
+#' @param selected a vector/list of choices to select by default.
+#' @param placeholder some text to appear when no search input is provided
+#' @param height a valid CSS unit for the height of the input.
+#'
+#' @export
+input_check_search <- function(id, choices, selected = NULL, placeholder = "🔍 Search", height = NULL, width = NULL) {
+
+  tag <- div(
+    id = id,
+    class = "bslib-check-search",
+    style = css(height = height, width = width),
+    tags$a(class = "clear-options", role = "button", "Clear all"),
+    tags$input(
+      type = "text",
+      id = paste0(id, "-search"),
+      class = "form-control form-control-sm",
+      class = "shiny-no-bind", # TODO: require shiny PR
+      placeholder = placeholder,
+      autocomplete = "off"
+    ),
+    check_search_choices(id, choices, selected),
+    check_search_dependency()
+  )
+
+  tag <- tag_require(tag, version = 5, caller = "input_check_search")
+
+  as_fragment(tag)
+}
+
+
+#' @export
+update_check_search <- function(id, choices = NULL, selected = NULL, placeholder = NULL, height = NULL, session = shiny::getDefaultReactiveDomain()) {
+  if (!is.null(choices)) {
+    choices <- process_ui(
+      check_search_choices(id, choices, selected),
+      session
+    )
+  }
+
+  message <- dropNulls(list(
+    choices = choices,
+    selected = as.list(selected), # make sure this is always a JS array
+    placeholder = placeholder,
+    height = height
+  ))
+  session$sendInputMessage(id, message)
+}
+
+check_search_choices <- function(id, choices, selected) {
+  if (is.null(names(choices)) && is.atomic(choices)) {
+    names(choices) <- choices
+  }
+  if (is.null(names(choices))) {
+    stop("names() must be provided on list() vectors provided to choices")
+  }
+
+  vals <- rlang::names2(choices)
+  #if (!all(nzchar(vals))) {
+  #  stop("Input values must be non-empty character strings")
+  #}
+
+  is_selected <- vapply(vals, function(x) {
+    isTRUE(x %in% selected) || identical(selected, I("all"))
+  }, logical(1))
+
+  checks <- unname(Map(
+    vals, choices, is_selected, paste0(id, "-", seq_along(is_selected)),
+    f = form_check
+  ))
+
+  # Always bring selections to the top
+  idx <- c(which(is_selected), which(!is_selected))
+
+  div(
+    class = "check-search-choices",
+    !!!checks[idx]
+  )
+}
+
+form_check <- function(val, lbl, checked, this_id) {
+  div(
+    class = "form-check", `data-value` = val,
+    tags$input(
+      type = "checkbox",
+      class = "form-check-input",
+      class = "shiny-no-bind",
+      id = this_id,
+      checked = if (checked) NA
+    ),
+    tags$label(class = "form-check-label", `for` = this_id, lbl)
+  )
+}
+
+check_search_dependency <- function() {
+  htmlDependency(
+    "bslib-check-search",
+    version = get_package_version("bslib"),
+    package = "bslib",
+    src = "components",
+    script = "check-search.js"
+  )
+}

inst/components/check-search.js

@@ -0,0 +1,106 @@
+const checkSearchInputBinding = new Shiny.InputBinding();
+$.extend(checkSearchInputBinding, {
+
+  find: function(scope) {
+    return $(scope).find(".bslib-check-search");
+  },
+
+  getValue: function(el) {
+    const inputs = $(el).find(".form-check-input");
+    let vals = [];
+    inputs.each(function(i) {
+      if (this.checked) {
+        vals.push($(this).parent(".form-check").attr("data-value"));
+      }
+    });
+    return vals.length > 0 ? vals : null;
+  },
+
+  subscribe: function(el, callback) {
+    const self = this;
+    $(el).on('change.checkSearch', function(event) {
+
+      const choices = $(event.target).parents(".check-search-choices");
+
+      // Move new selections to the top
+      const firstNotChecked = choices
+        .find("input:not(:checked)")
+        .parents(".form-check")
+        .last();
+      const thisForm = $(event.target).parent(".form-check");
+      firstNotChecked.before(thisForm);
+
+      // TODO: if we're unchecking a box, should we move it back to it's "original" position???
+
+      self._resolveClearVisibility(el);
+
+      callback(true);
+    });
+  },
+
+  unsubscribe: function(el) {
+    $(el).off(".checkSearchInputBinding");
+  },
+
+  initialize: function(el) {
+    el.oninput = onInput;
+
+    function onInput(e) {
+      const needle = e.target.value.toLowerCase();
+
+      const haystack = $(e.target.parentNode).find(".form-check");
+      haystack.each(function(i) {
+        const val = $(this).attr("data-value").toLowerCase();
+        const display = val.includes(needle) ? "" : "none";
+        $(this).css("display", display);
+      });
+    }
+
+    const clear = $(el).find(".clear-options");
+    const self = this;
+    clear.click(function() {
+      self.receiveMessage(el, {selected: []});
+    });
+
+    this._resolveClearVisibility(el);
+  },
+
+  receiveMessage: function(el, data) {
+    const $el = $(el);
+    if (data.hasOwnProperty("placeholder")) {
+      $el.find("input").attr("placeholder", data.placeholder);
+      return;
+    }
+    if (data.hasOwnProperty("height")) {
+      $el.css("height", data.height);
+      return;
+    }
+    // In this case, selected is already handled in the markup
+    if (data.hasOwnProperty("choices")) {
+      const choices = $el.find(".check-search-choices");
+      Shiny.renderContent(choices, data.choices);
+    } else if (data.hasOwnProperty("selected")) {
+      const checks = $el.find(".form-check");
+      checks.each(function(i) {
+        const val = $(this).attr("data-value");
+        const checked = data.selected.indexOf(val) > -1;
+        this.querySelector("input").checked = checked;
+      });
+    }
+
+    // Since we're possibly changed the input value at this point,
+    // trigger a subscribe() event, so that the input value will actually update
+    $el.trigger("change.checkSearch");
+
+    this._resolveClearVisibility(el);
+  },
+
+  _resolveClearVisibility: function(el) {
+    const clear = $(el).find(".clear-options");
+    const anySelected = $(el).find("input:checked").length > 0;
+    clear.css("visibility", anySelected ? "visible" : "hidden");
+  }
+
+});
+
+Shiny.inputBindings.register(checkSearchInputBinding);

inst/components/check-search.scss

@@ -0,0 +1,25 @@
+.bslib-check-search {
+  height: 200px;
+  width: fit-content;
+  width: -moz-fit-content;
+
+  .form-control {
+    position: sticky;
+    margin-bottom: 5px;
+  }
+
+  .clear-options {
+    visibility: hidden;
+    text-decoration: none;
+    float: right;
+    font-size: $font-size-sm;
+    font-weight: $font-weight-bold;
+  }
+
+  .check-search-choices {
+    overflow: scroll;
+    height: 100%;
+    width: 100%;
+    padding-left: 0.2rem;
+  }
+}