Update width argument

- It applies to the whole input group
- Includes debug shiny app to test behavior in bslib

DESCRIPTION

@@ -20,4 +20,5 @@ Language: en-US
 Suggests:
     testthat (>= 2.1.0),
     spelling,
-    hms
+    hms,
+    bslib

R/input-time.R

@@ -59,7 +59,7 @@
 #' @importFrom htmltools tagList singleton tags
 #' @export
 timeInput <- function(inputId, label, value = NULL, seconds = TRUE,
-                      minute.steps = NULL, use.civilian = FALSE, width = "8ch") {
+                      minute.steps = NULL, use.civilian = FALSE, width = NULL) {
   if(is.null(value)) value <- getDefaultTime()
   if(is.character(value)) value <- strptime(value, format = "%T")
   if(!is.null(minute.steps)) {
@@ -68,7 +68,12 @@ timeInput <- function(inputId, label, value = NULL, seconds = TRUE,
     value <- roundTime(value, minute.steps)
   }
   value_list <- dateToTimeList(value)
-  style <- paste0("width: ", htmltools::validateCssUnit(width))
+
+  div_style <- htmltools::css(width = shiny::validateCssUnit(width))
+  el_width <- "65px"
+  el_style <- htmltools::css(`min-width` = shiny::validateCssUnit(el_width),
+                             flex = "1 1 auto")
+
   input.class <- "form-control"
   # Set hour values
   if(use.civilian){
@@ -92,24 +97,28 @@ timeInput <- function(inputId, label, value = NULL, seconds = TRUE,
     )),
     tags$div(
       id = inputId,
-      class = "my-shiny-time-input form-group shiny input-container",
+      class = "my-shiny-time-input form-group shiny-input-container",
+      style = div_style,
       shinyInputLabel(inputId, label, control = TRUE),
       tags$div(
         class = "input-group",
+        style = htmltools::css(display = "flex",
+                               `flex-direction` = "row",
+                               `flex-wrap` = "nowrap"),
         tags$input(
           type="number", min = min_hour, max = max_hour, step = "1",
-          value = value_hour, style = style,
+          value = value_hour, style = el_style,
           class = paste(c(input.class, 'shinytime-hours'), collapse = " ")
         ),
         tags$input(
           type="number", min = "0", max = "59", step = minute.steps,
-          value = value_list$min, style = style,
+          value = value_list$min, style = el_style,
           class = paste(c(input.class, 'shinytime-mins'), collapse = " ")
         ),
         if(seconds){
           tags$input(
             type="number", min = "0", max = "59", step = "1",
-            value = value_list$sec, style = style,
+            value = value_list$sec, style = el_style,
             class = paste(c(input.class, 'shinytime-secs'), collapse =  " ")
           )
         } else NULL,
@@ -123,7 +132,8 @@ timeInput <- function(inputId, label, value = NULL, seconds = TRUE,
               value = "PM", "PM",
               selected = if(value_list$civilian == "PM") TRUE else NULL
             ),
-            style = "width: 70px",
+            style = htmltools::css(`min-width` = shiny::validateCssUnit("70px"),
+                                   flex = "1 1 auto"),
             class = paste(c(input.class, 'shinytime-civilian'), collapse =  " ")
           )
         } else NULL
@@ -176,3 +186,12 @@ updateTimeInput <- function(session, inputId, label = NULL, value = NULL) {
 shinyTimeExample <- function() {
   runApp(system.file('example', package='shinyTime', mustWork=T), display.mode='showcase')
 }
+
+#' Show the shinyTime debug app
+#'
+#' App to test the input with a variety of options
+#'
+#' @importFrom shiny runApp
+shinyTimeDebug <- function() {
+  runApp(system.file('debug', package='shinyTime', mustWork=T), display.mode='normal')
+}

inst/debug/app.R

@@ -0,0 +1,85 @@
+library(shiny)
+library(bslib)
+library(shinyTime)
+
+start_time <- "23:34:56"
+
+getTimeInput <- local({
+  nTimeInputs <- 0
+  timeInputs <- c()
+  function(label = NULL, value = strptime(start_time, "%T"), ...) {
+    nTimeInputs <<- nTimeInputs + 1
+    if(is.null(label)) label <- paste("genTimeInput", nTimeInputs)
+    id <- paste0("gen_time_input", nTimeInputs)
+    timeInputs <<- c(timeInputs, id)
+    timeInput(id, label, value, ...)
+  }
+})
+
+getTimeInputs <- function(widths, ...) {
+  purrr::map(widths, \(x) getTimeInput(width = paste0(x, "px"), ...))
+}
+
+widths <- seq(100,500,50)
+
+cards <- list(
+  card(
+    full_screen = TRUE,
+    card_header("Width"),
+    layout_column_wrap(
+      width = 1/3,
+      card(
+        card_header("5-minute steps"),
+        !!!getTimeInputs(widths = widths, minute.steps = 5)
+      ),
+      card(
+        card_header("24H"),
+        !!!getTimeInputs(widths = widths)
+      ),
+      card(
+        card_header("12H"),
+        !!!getTimeInputs(widths = widths, use.civilian = TRUE)
+      )
+    )
+  ),
+  card(
+    full_screen = TRUE,
+    card_header("Alignment"),
+    card(
+        textInput("text_example", 'Example text input'),
+        getTimeInput(label = "Enter time"),
+        getTimeInput(label = "Enter time (5 minute steps)", minute.steps = 5),
+        getTimeInput(label = "Enter time (civilian)", use.civilian = TRUE)
+    )
+  )
+)
+
+sb <- sidebar(
+  timeInput("source_time", "Desired time",
+            value = strptime("00:00:00", "%T")),
+
+  actionButton("to_desired_time", "Apply desired time"),
+  actionButton("to_current_time", "Set to current time")
+)
+
+ui <- page_navbar(
+  title = "shinyTimeDebug",
+  sidebar = sb,
+  nav_spacer(),
+  nav_panel("Width", cards[[1]]),
+  nav_panel("Alignment", cards[[2]])
+)
+
+server <- function(input, output, session) {
+  updateAllTimeInputs <- function(time, update_source = F) {
+    timeInputIds <- get("timeInputs", envir = environment(getTimeInput))
+    if(update_source) timeInputIds <- c("source_time",timeInputIds)
+    purrr::map(timeInputIds, \(x) updateTimeInput(session, x, value = time))
+  }
+
+  observeEvent(input$to_current_time, updateAllTimeInputs(Sys.time(), update_source = T))
+  observeEvent(input$to_desired_time, updateAllTimeInputs(input$source_time))
+
+}
+
+shinyApp(ui, server)

inst/example/app.R

@@ -18,26 +18,28 @@ ui <- fluidPage(
    sidebarLayout(
 
       sidebarPanel(
-        width = 3,
+        width = 4,
         timeInput(
           "time_input1", "Enter time",
           value = strptime(start_time, "%T")
         ),
         timeInput(
           "time_input2", "Enter time (5 minute steps)",
           value = strptime(start_time, "%T"),
-          minute.steps = 5
+          minute.steps = 5,
+          width = "100px"
         ),
         timeInput(
           "time_input3", "Enter time",
           value = strptime(start_time, "%T"),
           use.civilian = TRUE,
-          width = "60px"
+          width = "300px"
         ),
         actionButton("to_current_time", "Current time")
       ),
 
       mainPanel(
+        width = 8,
         textOutput("time_output1"),
         textOutput("time_output2"),
         textOutput("time_output3")
@@ -48,7 +50,7 @@ ui <- fluidPage(
 server <- function(input, output, session) {
   output$time_output1 <- renderText(strftime(input$time_input1, "%T"))
   output$time_output2 <- renderText(strftime(input$time_input2, "%R"))
-  output$time_output3 <- renderText(strftime(input$time_input3, "%I:%M:%S %p"))
+  output$time_output3 <- renderText(strftime(input$time_input3, "%r"))
 
   observeEvent(input$to_current_time, {
     updateTimeInput(session, "time_input1", value = Sys.time())