add include_thead to column_spec
diff --git a/R/column_spec.R b/R/column_spec.R
index f6b3593..1a07910 100644
--- a/R/column_spec.R
+++ b/R/column_spec.R
@@ -35,6 +35,8 @@
#' of table columns.
#' @param extra_css Extra css text to be passed into the cells of the row. Note
#' that it's not for the whole column but to each individual cells
+#' @param include_thead T/F. A HTML only feature to contoll whether the
+#' header row will be manipulated. Default is `FALSE`.
#'
#' @examples x <- knitr::kable(head(mtcars), "html")
#' column_spec(x, 1:2, width = "20em", bold = TRUE, italic = TRUE)
@@ -46,7 +48,7 @@
color = NULL, background = NULL,
border_left = FALSE, border_right = FALSE,
width_min = NULL, width_max = NULL,
- extra_css = NULL) {
+ extra_css = NULL, include_thead = FALSE) {
if (!is.numeric(column)) {
stop("column must be numeric. ")
}
@@ -64,7 +66,7 @@
color, background,
border_left, border_right,
width_min, width_max,
- extra_css))
+ extra_css, include_thead))
}
if (kable_format == "latex") {
return(column_spec_latex(kable_input, column, width,
@@ -81,7 +83,7 @@
color, background,
border_left, border_right,
width_min, width_max,
- extra_css) {
+ extra_css, include_thead) {
kable_attrs <- attributes(kable_input)
kable_xml <- read_kable_as_xml(kable_input)
kable_tbody <- xml_tpart(kable_xml, "tbody")
@@ -109,62 +111,30 @@
for (i in all_contents_rows) {
for (j in column) {
target_cell <- xml_child(xml_child(kable_tbody, i), j)
- if (!is.null(width)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "width: ", width, "; ")
- }
- if (!is.null(width_min)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "min-width: ", width_min, "; ")
- }
- if (!is.null(width_max)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "max-width: ", width_max, "; ")
- }
- if (bold) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "font-weight: bold;")
- }
- if (italic) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "font-style: italic;")
- }
- if (monospace) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "font-family: monospace;")
- }
- if (underline) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "text-decoration: underline;")
- }
- if (strikeout) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "text-decoration: line-through;")
- }
- if (!is.null(color)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "color: ", color, ";")
- }
- if (!is.null(background)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "background-color: ",
- background, ";")
- }
- if (border_left) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "border-left:", border_l_css, ";")
- }
- if (border_right) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "border-right:", border_r_css, ";")
- }
- if (!is.null(extra_css)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- extra_css)
- }
+ column_spec_html_cell(
+ target_cell, width, width_min, width_max,
+ bold, italic, monospace, underline, strikeout,
+ color, background, border_left, border_right,
+ border_l_css, border_r_css,
+ extra_css
+ )
}
}
+ if (include_thead) {
+ kable_thead <- xml_tpart(kable_xml, "thead")
+ nrow_thead <- length(xml_children(kable_thead))
+ for (j in column) {
+ target_cell <- xml_child(xml_child(kable_thead, nrow_thead), j)
+ column_spec_html_cell(
+ target_cell, width, width_min, width_max,
+ bold, italic, monospace, underline, strikeout,
+ color, background, border_left, border_right,
+ border_l_css, border_r_css,
+ extra_css
+ )
+ }
+ }
out <- as_kable_xml(kable_xml)
attributes(out) <- kable_attrs
@@ -172,6 +142,67 @@
return(out)
}
+column_spec_html_cell <- function(target_cell, width, width_min, width_max,
+ bold, italic, monospace, underline, strikeout,
+ color, background,
+ border_left, border_right,
+ border_l_css, border_r_css,
+ extra_css) {
+ if (!is.null(width)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "width: ", width, "; ")
+ }
+ if (!is.null(width_min)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "min-width: ", width_min, "; ")
+ }
+ if (!is.null(width_max)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "max-width: ", width_max, "; ")
+ }
+ if (bold) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "font-weight: bold;")
+ }
+ if (italic) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "font-style: italic;")
+ }
+ if (monospace) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "font-family: monospace;")
+ }
+ if (underline) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "text-decoration: underline;")
+ }
+ if (strikeout) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "text-decoration: line-through;")
+ }
+ if (!is.null(color)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "color: ", color, ";")
+ }
+ if (!is.null(background)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "background-color: ",
+ background, ";")
+ }
+ if (border_left) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "border-left:", border_l_css, ";")
+ }
+ if (border_right) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ "border-right:", border_r_css, ";")
+ }
+ if (!is.null(extra_css)) {
+ xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
+ extra_css)
+ }
+}
+
column_spec_latex <- function(kable_input, column, width,
bold, italic, monospace,
underline, strikeout,
diff --git a/inst/NEWS.md b/inst/NEWS.md
index 5e179ad..9fe54eb 100644
--- a/inst/NEWS.md
+++ b/inst/NEWS.md
@@ -4,6 +4,8 @@
* Added documentation about 100% width in scroll_box (Thank you @isteves!)
+* Added `include_thead` to `column_spec`. (#177)
+
kableExtra 0.8.0
--------------------------------------------------------------------------------
* Now kableExtra imports & exports knitr::kable so users don't need to load knitr entirely to NAMESPACE when it's not necessary, for example, in shiny.
diff --git a/man/column_spec.Rd b/man/column_spec.Rd
index f0a4717..e2832c5 100644
--- a/man/column_spec.Rd
+++ b/man/column_spec.Rd
@@ -8,7 +8,7 @@
italic = FALSE, monospace = FALSE, underline = FALSE,
strikeout = FALSE, color = NULL, background = NULL,
border_left = FALSE, border_right = FALSE, width_min = NULL,
- width_max = NULL, extra_css = NULL)
+ width_max = NULL, extra_css = NULL, include_thead = FALSE)
}
\arguments{
\item{kable_input}{Output of \code{knitr::kable()} with \code{format} specified}
@@ -50,6 +50,9 @@
\item{extra_css}{Extra css text to be passed into the cells of the row. Note
that it's not for the whole column but to each individual cells}
+\item{include_thead}{T/F. A HTML only feature to contoll whether the
+header row will be manipulated. Default is \code{FALSE}.}
+
\item{min_width}{Only for HTML table. Normal column width will automatically
collapse when the window cannot hold enough contents. With this \code{min_width},
you can set up a column with a width that won't collapse even when the
diff --git a/tests/visual_tests/column_row_spec_html.Rmd b/tests/visual_tests/column_row_spec_html.Rmd
index 6525e42..8587b41 100644
--- a/tests/visual_tests/column_row_spec_html.Rmd
+++ b/tests/visual_tests/column_row_spec_html.Rmd
@@ -21,7 +21,7 @@
y <- knitr::kable(head(mtcars), "html")
y %>%
kable_styling(full_width = F) %>%
- column_spec(1:3, width = "5cm")
+ column_spec(1:3, width_min = "5cm", color = "red", include_thead = F)
```
```{r}