Search code examples
htmlcssrshinyrhandsontable

Is there a way to not set rhandsontable height to a huge value in order to have the dropdown menu correctly render?


Running the code at the bottom of this post presents a rhandsontable with dropdown choices. The only way to get the dropdowns to appear is to set a very large table height, but that has the ugly effect of pushing the actionButton() far down. If you comment-out the line for table height (noted in the code with # <<), the actionButton() position resolves but the table dropdowns no longer render, as shown in the below illustration. Is there a way for the dropdowns to overlay (or hover over) any objects rendered beneath them so you don't have to resort to this sort of silly table height?

A solution could be to move the actionButton() to the top, but in the fuller App this is intended for there are a series of action buttons which conditionally render important objects beneath them, so moving the actionButton() to the top is not feasible. It has to stay beneath the table.

Illustration:

enter image description here

Code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(br(),
  mainPanel(
    rHandsontableOutput("Tbl"),br(),br(),
    actionButton("add", "Add column"),
    )
  )

server <- function(input, output) {
  DF <- reactiveVal(
    data.frame(
      'Series 1' = NA_character_, 
      stringsAsFactors = FALSE,
      row.names = c("Select option"),
      check.names = FALSE
      )
    )
  
  observeEvent(input$Tbl,{DF(hot_to_r(input$Tbl))})
  
  output$Tbl <- renderRHandsontable({
    select_option <- c(NA_character_, "A","B","C","D","E","F","G","H","I","J","K")
    tmp <- rhandsontable(
      DF(), 
      rowHeaderWidth = 200, 
      selectCallback = TRUE, 
      height = 300 # << comment this line out to correctly position the action button
      ) %>%
    hot_cols(colWidths = 100) %>%
    hot_col("Series 1", 
            allowInvalid = FALSE, 
            type = "dropdown", 
            source = NA_character_, 
            readOnly = TRUE
            )
    tmp <- hot_col(tmp, 
                   col = names(DF()), 
                   allowInvalid = FALSE, 
                   type = "dropdown", 
                   source = select_option
                   ) %>% 
      hot_cell(row = input$Tbl_select$select$r, col = "Series 1", readOnly = FALSE)
    tmp
  })
  
  observeEvent(input$add, {
    newCol <- data.frame('Series 1' = NA_character_,stringsAsFactors = FALSE)
    names(newCol) <- paste("Series", ncol(hot_to_r(input$Tbl)) + 1)
    DF(cbind(DF(), newCol))
  })
  
}

shinyApp(ui = ui, server = server)

Solution

  • Changing height = 300 to overflow = "visible" solves the issue!