Add styling for interactive tables

rstudio · Aug 7, 2024 · 8578da7 · 8578da7
1 parent aebc2b1
commit 8578da7
Show file tree

Hide file tree

Showing 3 changed files with 164 additions and 36 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -6,12 +6,12 @@
 
 ## Interactive table support
 
-* Interactive tables will show no border if `opt_table_lines(extent = "none")` is specified (#1307).
+* Interactive tables respect`opt_table_lines(extent = "none")` and `opt_table_lines(extent = "all")` is specified (#1307).
 
 * Interactive tables now respect more styling options. 
 
   * `column_labels.background.color`, `row_group.background.color`, `row_group.font.weight`, `table_body.hlines.style`,
-     `table.font.weight`, `table.font.size`, `stub.font.weight` (#1693).
+     `table.font.weight`, `table.font.size`, `stub.font.weight`, `stub_background.color` (#1693).
 
 * `opt_interactive()` now works when columns are merged with `cols_merge()` (@olivroy, #1785). 
 

diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R
@@ -171,35 +171,57 @@ render_as_ihtml <- function(data, id) {
 
   table_width <- opt_val(data = data, option = "table_width")
   table_background_color <- opt_val(data = data, option = "table_background_color")
+  table_font_size   <- opt_val(data = data, "table_font_size")
   table_font_names <- opt_val(data = data, option = "table_font_names")
   table_font_color <- opt_val(data = data, option = "table_font_color")
+  table_border_right_style <- opt_val(data, "table_border_right_style")
+  table_border_right_color <- opt_val(data, "table_border_right_color")
+  table_border_left_style <- opt_val(data, "table_border_left_style")
+  table_border_left_color <- opt_val(data, "table_border_left_color")
+  table_border_top_color <- opt_val(data, "table_border_top_color")
+
+  heading_border_bottom_color <- opt_val(data, "heading_border_bottom_color")
 
   column_labels_border_top_style <- opt_val(data = data, option = "column_labels_border_top_style")
   column_labels_border_top_width <- opt_val(data = data, option = "column_labels_border_top_width")
   column_labels_border_top_color <- opt_val(data = data, option = "column_labels_border_top_color")
   column_labels_border_bottom_style <- opt_val(data = data, option = "column_labels_border_bottom_style")
   column_labels_border_bottom_width <- opt_val(data = data, option = "column_labels_border_bottom_width")
   column_labels_border_bottom_color <- opt_val(data = data, option = "column_labels_border_bottom_color")
+
   # Don't allow NA
   column_labels_background_color <- opt_val(data = data, option = "column_labels_background_color")
-  # Apply stub font weight to
-  stub_font_weight <- opt_val(data = data, option = "stub_font_weight")
-
   if (is.na(column_labels_background_color)) {
     # apply all column labels formatting to both heading + groupCol styling (nothing specific for spanners styling in gt?)
     column_labels_background_color <- "transparent"
   }
-  # Part of #1307
-  borderless_borders <- opt_val(data = data, option = "table_body_hlines_style") == "none"
 
   column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight")
+  # Apply stub font weight to
+  stub_font_weight <- opt_val(data = data, option = "stub_font_weight")
   # Apply font weight to groupname_col title
-  row_group_font_weight <- opt_val(data = data, "row_group_font_weight")
-  table_body_font_weight <- opt_val(data = data, "table_font_weight")
+  row_group_font_weight <-  opt_val(data = data, "row_group_font_weight")
+  row_group_background_color <- opt_val(data = data, "row_group_background_color")
+
+  table_body_font_weight  <- opt_val(data = data, "table_font_weight")
+  table_body_hlines_style <- opt_val(data = data, "table_body_hlines_style")
+  table_body_hlines_color <- opt_val(data = data, "table_body_hlines_color")
+  table_body_hlines_width <- opt_val(data = data, "table_body_hlines_width")
+  table_body_vlines_style <- opt_val(data = data, "table_body_vlines_style")
+  table_body_vlines_color <- opt_val(data = data, "table_body_vlines_color")
+  table_body_vlines_width <- opt_val(data = data, "table_body_vlines_width")
+
+  horizontal_borders <- opt_val(data = data, option = "table_body_hlines_style")
+  veritcal_borders <- opt_val(data = data, option = "table_body_vlines_style")
+  borderless_borders <- horizontal_borders == "none" && veritcal_borders == "none"
+  all_borders <- horizontal_borders != "none" && veritcal_borders != "none"
+
   # for row names + summary label
-  stub_font_weight <- opt_val(data = data, "stub_font_weight")
-  # #1693 table font size
-  table_font_size <- opt_val(data = data, "table_font_size")
+  stub_border_color <- opt_val(data, "stub_border_color")
+  stub_border_style <- opt_val(data, "stub_border_style")
+  # Apply stub font weight to
+  stub_font_weight <- opt_val(data = data, option = "stub_font_weight")
+  stub_background_color <-  opt_val(data = data, option = "stub_background_color")
 
   emoji_symbol_fonts <-
     c(
@@ -222,7 +244,13 @@ render_as_ihtml <- function(data, id) {
     row_name_col_def <- list(reactable::colDef(
       name = rowname_label,
       style = list(
-        fontWeight = stub_font_weight
+        fontWeight = stub_font_weight,
+        color = if (!is.na(stub_background_color)) unname(ideal_fgnd_color(stub_background_color)) else NULL,
+        borderRight = stub_border_color,
+        borderRightStyle = stub_border_style,
+        backgroundColor = stub_background_color#,
+
+        # borderLeft, borderRight are possible
       )
       # TODO pass on other attributes of row names column if necessary.
     ))
@@ -347,7 +375,13 @@ render_as_ihtml <- function(data, id) {
         reactable::colDef(
           name = group_label,
           style = list(
-            `font-weight` = row_group_font_weight
+            `font-weight` = row_group_font_weight,
+            color =  if (is.na(row_group_background_color)) NULL else unname(ideal_fgnd_color(row_group_background_colorfgggee )),
+            backgroundColor = row_group_background_color,
+            borderStyle = "none",
+            borderColor = "transparent",
+            borderTopColor = "transparent",
+            borderBottomColor = "gray38"
           ),
           # The total number of rows is wrong in colGroup, possibly due to the JS fn
           grouped = grp_fn,
@@ -382,7 +416,7 @@ render_as_ihtml <- function(data, id) {
   styles_tbl <- dt_styles_get(data = data)
   body_styles_tbl <- dplyr::filter(styles_tbl, locname %in% c("data", "stub"))
   body_styles_tbl <- dplyr::arrange(body_styles_tbl, colnum, rownum)
-  body_styles_tbl <- dplyr::select(body_styles_tbl, colname, rownum, html_style)
+  body_styles_tbl <- dplyr::select(body_styles_tbl, "colname", "rownum", "html_style")
 
   # Generate styling rule per combination of `colname` and
   # `rownum` in `body_styles_tbl`
@@ -431,28 +465,40 @@ render_as_ihtml <- function(data, id) {
 
   # Generate the table header if there are any heading components
   if (has_header_section) {
+    # These don't work in non-interactive context.
+    heading_title_font_weight <- opt_val(data, "heading_title_font_weight")
+    heading_subtitle_font_weight <- opt_val(data, "heading_subtitle_font_weight")
+    heading_background_color <- opt_val(data, "heading_background_color")
 
     tbl_heading <- dt_heading_get(data = data)
-
     heading_component <-
       htmltools::div(
         style = htmltools::css(
           `font-family` = font_family_str,
+          `background-color` = heading_background_color,
           `border-top-style` = "solid",
           `border-top-width` = "2px",
           `border-top-color` = "#D3D3D3",
+          `border-bottom-color` = "#D3D3D3",
           `padding-bottom` = if (use_search) "8px" else NULL
         ),
         htmltools::div(
           class = "gt_heading gt_title gt_font_normal",
-          style = htmltools::css(`text-size` = "bigger"),
+          style = htmltools::css(
+            `text-size` = "bigger",
+            `font-weight` = heading_title_font_weight
+          ),
           htmltools::HTML(tbl_heading$title)
         ),
         htmltools::div(
           class = paste(
             "gt_heading", "gt_subtitle",
             if (use_search) "gt_bottom_border" else NULL
           ),
+          style = htmltools::css(
+            `font-weight` = heading_subtitle_font_weight,
+            `border-bottom-color` = "#D3D3D3"
+          ),
           htmltools::HTML(tbl_heading$subtitle)
         )
       )
@@ -476,14 +522,16 @@ render_as_ihtml <- function(data, id) {
       footnotes_component <- NULL
     }
 
+    table_border_bottom_style <- opt_val(data, "table_border_bottom_style")
+
     footer_component <-
       htmltools::div(
         style = htmltools::css(
           `font-family` = font_family_str,
           `border-top-style` = "solid",
           `border-top-width` = "2px",
           `border-top-color` = "#D3D3D3",
-          `border-bottom-style` = "solid",
+          `border-bottom-style` = table_border_bottom_style,
           `border-bottom-width` = "2px",
           `border-bottom-color` = "#D3D3D3",
           `padding-top` = "6px",
@@ -542,6 +590,7 @@ render_as_ihtml <- function(data, id) {
             headerClass = NULL,
             headerStyle = list(
               fontWeight = "normal",
+              color = if (is.na(column_labels_background_color)) NULL else unname(ideal_fgnd_color(column_labels_background_color)),
               backgroundColor = column_labels_background_color,
               borderBottomStyle = column_labels_border_bottom_style,
               borderBottomWidth = column_labels_border_bottom_width,
@@ -573,18 +622,25 @@ render_as_ihtml <- function(data, id) {
         #1693
         fontSize = table_font_size
       ),
-      tableStyle = list(
-        borderTopStyle = column_labels_border_top_style,
-        borderTopWidth = column_labels_border_top_width,
-        borderTopColor = column_labels_border_top_color
+      # borders in the body
+      rowStyle = list(
+        fontWeight = table_body_font_weight,
+        borderTopStyle = table_body_hlines_style,
+        borderTopColor = table_body_hlines_color,
+        borderTopWidth = table_body_hlines_width,
+        BorderRightStyle = table_body_vlines_style,
+        BorderRightColor = table_body_vlines_color,
+        BorderRightWidth = table_body_vlines_width
       ),
       # cells_column_labels()
       headerStyle = list(
         fontWeight = column_labels_font_weight,
         backgroundColor = column_labels_background_color,
         borderBottomStyle = column_labels_border_bottom_style,
         borderBottomWidth = column_labels_border_bottom_width,
-        borderBottomColor = column_labels_border_bottom_color
+        borderBottomColor = column_labels_border_bottom_color,
+        borderTopColor = "transparent",
+        borderTopStyle = "none"
       ),
       # individually defined for the margins left+right
       # cells_spanner_labels() styling
@@ -595,19 +651,30 @@ render_as_ihtml <- function(data, id) {
         borderBottomWidth = column_labels_border_bottom_width,
         borderBottomColor = column_labels_border_bottom_color
       ),
-      tableBodyStyle = NULL,
+      # body = table
+      tableStyle = list(
+        borderRightStyle = table_border_right_style,
+        borderRightColor = table_border_right_color,
+        borderLeftStyle = table_border_left_style,
+        borderLeftColor = table_border_right_style,
+        borderBttomColor = heading_border_bottom_color
+      ),
       # stub styling?
       # rowGroupStyle = list(
+      #   backgroundColor = row_group_background_color,
       #   fontWeight = row_group_font_weight
       # ),
-      rowStyle = NULL,
+      # exclude pagination and search
+      tableBodyStyle = NULL,
       rowStripedStyle = NULL,
       rowHighlightStyle = NULL,
       rowSelectedStyle = NULL,
       # cells_body styling
-      cellStyle = list(
-        fontWeight = table_body_font_weight
-      ),
+      # cellStyle = list(
+      #   fontWeight = table_body_font_weight,
+      #   backgroundColor = table_background_color
+      # ),
+      # grand_summary style
       footerStyle = NULL,
       inputStyle = NULL,
       filterInputStyle = NULL,
@@ -645,7 +712,7 @@ render_as_ihtml <- function(data, id) {
       showPagination = use_pagination,
       showPageInfo = use_pagination_info,
       minRows = 1,
-      paginateSubRows = FALSE,
+      paginateSubRows = TRUE,
       details = NULL,
       defaultExpanded = expand_groupname_col,
       selection = NULL,
@@ -654,7 +721,8 @@ render_as_ihtml <- function(data, id) {
       onClick = NULL,
       highlight = use_highlight,
       outlined = FALSE,
-      bordered = FALSE,
+      # equivalent to opt_table_lines(extent = "all")
+      bordered = all_borders,
       # equivalent to opt_table_lines(extent = "none")
       borderless = borderless_borders,
       striped = use_row_striping,

diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd
@@ -1,6 +1,7 @@
 ---
 title: "gt interactive tables"
 format: html
+html-table-processing: none
 description: >
   An overview of interactive tables with gt
 ---
@@ -10,6 +11,8 @@ knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>"
 )
+# generate the same table ID
+set.seed(112)
 ```
 
 gt provides an option to make interactive html tables via the [reactable](https://glin.github.io/reactable/index.html) package.
@@ -19,27 +22,84 @@ It also provides an interactive to creating gt tables as plots.
 Let's use the following base for our gt table.
 
 ```{r}
-library(gt)
+ devtools::load_all("~/rrr-forks/gt")
+#library(gt)
 gt_tbl <- exibble |>
-  gt()
+  gt(groupname_col = "group", rowname_col = "row") |>
+  tab_header(
+    "Title",
+    "Subtitle"
+  ) |>
+  tab_footnote(
+    "A footnote"
+  ) |>
+  tab_spanner(
+    "Spanner",
+    columns = c(date, time)
+  )
 ```
 
 To create an interactive table, you have simply have to pipe `opt_interactive()` to your existing gt pipeline.
 
+::: {.panel-tabset}
+
+## Html
+
 ```{r}
 gt_tbl
 ```
 
+## Interactive
+
 ```{r}
 gt_tbl |>
   opt_interactive()
 ```
 
-# Current limitations
+:::
+
+## Examples
+
+Some styling is respected in `opt_interactive()`
+
+```{r}
+styled <- gt_tbl |>
+  tab_options(
+    heading.title.font.weight = "bold",
+    stub.background.color = "lightblue", 
+    table.border.bottom.style = "dotted",
+    column_labels.background.color = "pink",
+    table.font.weight = "italic",
+    stub.font.weight = "bolder",
+    table_body.vlines.color = "brown",
+    table_body.vlines.style = "dashed"
+  )
+```
+
+::: {.panel-tabset}
+## Html
+
+```{r}
+#| echo: false
+styled
+```
+
+## Interactive
+
+```{r}
+#| echo: false
+styled %>% opt_interactive()
+```
 
-* Some features like `tab_style()` may not be fully supported. 
+:::
+
+
+
+
+# Current limitations
 
-* `summary_rows()` and `grand_summary_rows()` have yet to be implemented.
+-   Some features like `tab_style()` may not be fully supported.
 
-* Your interactive table may be visually different from your non-interactive table.
+-   `summary_rows()` and `grand_summary_rows()` have yet to be implemented.
 
+-   Your interactive table may be visually different from your non-interactive table.