Add "control-label" class to `colourInput()`

[obenno]

Hi @daattali,

Thanks a lot for the wonderful package!

I found the label of colourInput() is not consistent with shiny's input functions (e.g. textInput()). Shiny's inputs has a special css class for their labels: control-label. Is it possible to add this class to colourInput()'s label as well? I don't know if this would affect its usage under other scenarios (e.g. with rmarkdown), but hope it helps.

colourpicker: v1.1.1 via cran shiny: v1.7.1 via cran

Thanks again, obenno

[daattali]

It seems that this css class was added to shiny somewhat recently, it was not in previous versions of shiny. Is it very important? I try not to play catchup with shiny since their inputs evolve all the time, and it would be an endless effort

[obenno]

If that's the case, then I guess no further modification is need. I could add a custom version of colourInput() function and maunally added the class. Thank you!

[daattali]

Do you mind sharing the usecase? I'm not explicitly opposed to this particular change, I want to see how it's useful

[obenno]

No problem. I used colourInput() in a shiny application with {bslib} package and bootstrap version 5. Please find a minmum working example below:

library(shiny)
library(bslib)
library(colourpicker)

source(file = "utils.R", local = T, encoding = "UTF-8")

ui <- navbarPage(
    theme = bs_theme(version = 5,bootswatch = "flatly"),
    title = "Test",
    tabPanel(
        "Main View",
        fluidRow(
            column(
                width = 3,
                colourInput(
                    inputId = "colors",
                    label = "Choose Color",
                    value = "grey"
                )
            ),
            column(
                width = 9,
                textInput(
                    inputId = "text",
                    label = "Input Some Text",
                    value = ""
                )
            )
        ),
        )
)

server <- function(input, output, session){

}

shinyApp(ui, server)

utils.R

## Altered label of colourInput
colourInput <- function (inputId, label, value = "white", showColour = c("both",
    "text", "background"), palette = c("square", "limited"),
    allowedCols = NULL, allowTransparent = FALSE, returnName = FALSE,
    closeOnClick = FALSE)
{
    showColour <- match.arg(showColour)
    palette <- match.arg(palette)
    value <- restoreInput(id = inputId, default = value)
    shiny::addResourcePath("colourpicker-binding", system.file("srcjs",
        package = "colourpicker"))
    shiny::addResourcePath("colourpicker-lib", system.file("www",
        "shared", "colourpicker", package = "colourpicker"))
    deps <- list(htmltools::htmlDependency("colourpicker-binding",
        "0.1.0", c(href = "colourpicker-binding"), script = "input_binding_colour.js"),
        htmltools::htmlDependency("colourpicker-lib", "0.1.0",
            c(href = "colourpicker-lib"), script = "js/colourpicker.min.js",
            stylesheet = "css/colourpicker.min.css"))
    inputTag <- shiny::tags$input(id = inputId, type = "text",
        class = "form-control shiny-colour-input", `data-init-value` = value,
        `data-show-colour` = showColour, `data-palette` = palette)
    if (!is.null(allowedCols)) {
        allowedCols <- jsonlite::toJSON(allowedCols)
        inputTag <- shiny::tagAppendAttributes(inputTag, `data-allowed-cols` = allowedCols)
    }
    if (returnName) {
        inputTag <- shiny::tagAppendAttributes(inputTag, `data-return-name` = "true")
    }
    if (allowTransparent) {
        inputTag <- shiny::tagAppendAttributes(inputTag, `data-allow-alpha` = "true")
    }
    if (closeOnClick) {
        inputTag <- shiny::tagAppendAttributes(inputTag, `data-close-on-click` = "true")
    }
    inputTag <- shiny::div(class = "form-group shiny-input-container",
        `data-shiny-input-type` = "colour", label %AND% shiny::tags$label(label, class="control-label",
            `for` = inputId), inputTag)
    htmltools::attachDependencies(inputTag, deps)
}

# copied from shiny since it's not exported
`%AND%` <- function(x, y) {
  if (!is.null(x) && !isTRUE(is.na(x)))
    if (!is.null(y) && !isTRUE(is.na(y)))
      return(y)
  return(NULL)
}

sessionInfo:

R version 4.1.2 (2021-11-01)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.3 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale:
 [1] LC_CTYPE=en_HK.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_HK.UTF-8        LC_COLLATE=en_HK.UTF-8    
 [5] LC_MONETARY=en_HK.UTF-8    LC_MESSAGES=en_HK.UTF-8   
 [7] LC_PAPER=en_HK.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_HK.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] colourpicker_1.1.1 bslib_0.3.1        shiny_1.7.1       

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7        digest_0.6.29     later_1.3.0       mime_0.12        
 [5] R6_2.5.1          jsonlite_1.7.2    lifecycle_1.0.1   xtable_1.8-4     
 [9] magrittr_2.0.1    rlang_0.4.12      miniUI_0.1.1.1    promises_1.2.0.1 
[13] jquerylib_0.1.4   ellipsis_0.3.2    tools_4.1.2       htmlwidgets_1.5.4
[17] httpuv_1.6.3      fastmap_1.1.0     compiler_4.1.2    htmltools_0.5.2  
[21] sass_0.4.0

[daattali]

Thanks for the code, now I see why it helps - anyone using bs5 will have the label looking a bit off. In that case, this does warrant a fix, thanks for letting me know!