fix: allow update input labels with HTML fixes rstudio#3995

R/update-input.R

@@ -37,7 +37,7 @@
 updateTextInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL, placeholder = NULL) {
   validate_session_object(session)
 
-  message <- dropNulls(list(label=label, value=value, placeholder=placeholder))
+  message <- dropNulls(list(label=label %convert% as.character, value=value, placeholder=placeholder))
   session$sendInputMessage(inputId, message)
 }
 
@@ -111,7 +111,7 @@ updateTextAreaInput <- updateTextInput
 updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL) {
   validate_session_object(session)
 
-  message <- dropNulls(list(label=label, value=value))
+  message <- dropNulls(list(label=label %convert% as.character, value=value))
   session$sendInputMessage(inputId, message)
 }
 
@@ -175,13 +175,13 @@ updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, la
   validate_session_object(session)
 
   if (!is.null(icon)) icon <- as.character(validateIcon(icon))
-  message <- dropNulls(list(label=label, icon=icon, disabled=disabled))
+  message <- dropNulls(list(label=label %convert% as.character, icon=icon, disabled=disabled))
   session$sendInputMessage(inputId, message)
 }
 #' @rdname updateActionButton
 #' @export
 updateActionLink <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL) {
-  updateActionButton(session, inputId=inputId, label=label, icon=icon)
+  updateActionButton(session, inputId=inputId, label=label %convert% as.character, icon=icon)
 }
 
 
@@ -225,7 +225,7 @@ updateDateInput <- function(session = getDefaultReactiveDomain(), inputId, label
   min   <- dateYMD(min, "min")
   max   <- dateYMD(max, "max")
 
-  message <- dropNulls(list(label=label, value=value, min=min, max=max))
+  message <- dropNulls(list(label=label %convert% as.character, value=value, min=min, max=max))
   session$sendInputMessage(inputId, message)
 }
 
@@ -275,7 +275,7 @@ updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId,
   max <- dateYMD(max, "max")
 
   message <- dropNulls(list(
-    label = label,
+    label = label %convert% as.character,
     value = dropNulls(list(start = start, end = end)),
     min = min,
     max = max
@@ -379,7 +379,7 @@ updateNumericInput <- function(session = getDefaultReactiveDomain(), inputId, la
   validate_session_object(session)
 
   message <- dropNulls(list(
-    label = label, value = formatNoSci(value),
+    label = label %convert% as.character, value = formatNoSci(value),
     min = formatNoSci(min), max = formatNoSci(max), step = formatNoSci(step)
   ))
   session$sendInputMessage(inputId, message)
@@ -460,7 +460,7 @@ updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, lab
   }
 
   message <- dropNulls(list(
-    label = label,
+    label = label %convert% as.character,
     value = formatNoSci(value),
     min = formatNoSci(min),
     max = formatNoSci(max),
@@ -491,7 +491,7 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
     ))
   }
 
-  message <- dropNulls(list(label = label, options = options, value = selected))
+  message <- dropNulls(list(label = label %convert% as.character, options = options, value = selected))
 
   session$sendInputMessage(inputId, message)
 }
@@ -644,7 +644,7 @@ updateSelectInput <- function(session = getDefaultReactiveDomain(), inputId, lab
   choices <- if (!is.null(choices)) choicesWithNames(choices)
   if (!is.null(selected)) selected <- as.character(selected)
   options <- if (!is.null(choices)) selectOptions(choices, selected, inputId, FALSE)
-  message <- dropNulls(list(label = label, options = options, value = selected))
+  message <- dropNulls(list(label = label %convert% as.character, options = options, value = selected))
   session$sendInputMessage(inputId, message)
 }
 

R/utils.R

@@ -1755,3 +1755,11 @@ cnd_some <- function(.cnd, .p, ...) {
 
   FALSE
 }
+
+`%convert%` <- function(lhs, rhs) {
+  if (is.null(lhs)) {
+    lhs
+  } 
+
+  rhs(lhs)
+}

srcts/src/utils/index.ts

@@ -119,8 +119,8 @@ function makeResizeFilter(
   el: HTMLElement,
   func: (
     width: HTMLElement["offsetWidth"],
-    height: HTMLElement["offsetHeight"]
-  ) => void
+    height: HTMLElement["offsetHeight"],
+  ) => void,
 ): () => void {
   let lastSize: LastSizeInterface = {};
 
@@ -170,7 +170,7 @@ function scopeExprToFunc(expr: string): (scope: unknown) => boolean {
           console.error('Error evaluating expression: ${exprEscaped}');
           throw e;
         }
-      }`
+      }`,
     );
   } catch (e) {
     console.error("Error parsing expression: " + expr);
@@ -192,7 +192,7 @@ function asArray<T>(value: T | T[] | null | undefined): T[] {
 // bindings by priority and insertion order.
 function mergeSort<Item>(
   list: Item[],
-  sortfunc: (a: Item, b: Item) => boolean | number
+  sortfunc: (a: Item, b: Item) => boolean | number,
 ): Item[] {
   function merge(a: Item[], b: Item[]) {
     let ia = 0;
@@ -241,7 +241,7 @@ function $escape(val: string | undefined): string | undefined {
 // function from lodash.
 function mapValues<T extends { [key: string]: any }, R>(
   obj: T,
-  f: (value: MapValuesUnion<T>, key: string, object: typeof obj) => R
+  f: (value: MapValuesUnion<T>, key: string, object: typeof obj) => R,
 ): MapWithResult<T, R> {
   const newObj = {} as MapWithResult<T, R>;
 
@@ -302,7 +302,7 @@ function equal(...args: unknown[]): boolean {
 const compareVersion = function (
   a: string,
   op: "<" | "<=" | "==" | ">" | ">=",
-  b: string
+  b: string,
 ): boolean {
   function versionParts(ver: string) {
     return (ver + "")
@@ -338,7 +338,7 @@ const compareVersion = function (
 
 function updateLabel(
   labelTxt: string | undefined,
-  labelNode: JQuery<HTMLElement>
+  labelNode: JQuery<HTMLElement>,
 ): void {
   // Only update if label was specified in the update method
   if (typeof labelTxt === "undefined") return;
@@ -352,7 +352,7 @@ function updateLabel(
   if (emptyLabel) {
     labelNode.addClass("shiny-label-null");
   } else {
-    labelNode.text(labelTxt);
+    labelNode.html(labelTxt);
     labelNode.removeClass("shiny-label-null");
   }
 }