add vector support to column_spec_html as well
diff --git a/R/column_spec.R b/R/column_spec.R
index 76df91b..27c76b6 100644
--- a/R/column_spec.R
+++ b/R/column_spec.R
@@ -5,9 +5,7 @@
#' bold text and italic text.
#'
#' @param kable_input Output of `knitr::kable()` with `format` specified
-#' @param column A numeric value indicating which column to be selected. When
-#' you do the counting, ignore the extra header columns you added through
-#' add_header_left.
+#' @param columns A numeric value or vector indicating which column(s) to be selected.
#' @param width A character string telling HTML & LaTeX how wide the column
#' needs to be, e.g. "10cm", "3in" or "30em".
#' @param bold A T/F value to control whether the text of the selected column
@@ -26,17 +24,22 @@
#' @param border_right A logical variable indicating whether there should be a
#' border line on the right of the selected column. In HTML, you can also pass
#' in a character string for the CSS of the border line
+#' @param column Deprecating. Same with columns
#'
#' @examples x <- knitr::kable(head(mtcars), "html")
#' column_spec(x, 1, width = "20em", bold = TRUE, italic = TRUE)
#'
#' @export
-column_spec <- function(kable_input, column,
+column_spec <- function(kable_input, columns = NULL,
width = NULL, bold = FALSE, italic = FALSE,
monospace = FALSE, color = NULL, background = NULL,
- border_left = FALSE, border_right = FALSE) {
- if (!is.numeric(column)) {
- stop("column must be a numeric value")
+ border_left = FALSE, border_right = FALSE,
+ column, ...) {
+ if (is.null(columns)) {
+ columns <- column
+ }
+ if (!is.numeric(columns)) {
+ stop("columns/column must be numeric. Note that column is deprecating.")
}
kable_format <- attr(kable_input, "format")
if (!kable_format %in% c("html", "latex")) {
@@ -44,20 +47,20 @@
return(kable_input)
}
if (kable_format == "html") {
- return(column_spec_html(kable_input, column, width,
+ return(column_spec_html(kable_input, columns, width,
bold, italic, monospace,
color, background,
border_left, border_right))
}
if (kable_format == "latex") {
- return(column_spec_latex(kable_input, column, width,
+ return(column_spec_latex(kable_input, columns, width,
bold, italic, monospace,
color, background,
- border_left, border_right))
+ border_left, border_right, ...))
}
}
-column_spec_html <- function(kable_input, column, width,
+column_spec_html <- function(kable_input, columns, width,
bold, italic, monospace,
color, background,
border_left, border_right) {
@@ -66,15 +69,7 @@
kable_tbody <- xml_tpart(kable_xml, "tbody")
group_header_rows <- attr(kable_input, "group_header_rows")
- if (is.null(kable_attrs$column_adjust)) {
- all_contents_rows <- seq(1, length(xml_children(kable_tbody)))
- all_contents_array <- rep(column, length(all_contents_rows))
- } else {
- column <- column + kable_attrs$column_adjust$count
- all_contents_array <- colSums(kable_attrs$column_adjust$matrix[1:column, ])
- all_contents_rows <- which(all_contents_array != 0 &
- kable_attrs$column_adjust$matrix[column, ])
- }
+ all_contents_rows <- seq(1, length(xml_children(kable_tbody)))
if (!is.null(group_header_rows)) {
all_contents_rows <- all_contents_rows[!all_contents_rows %in%
@@ -94,39 +89,41 @@
}
for (i in all_contents_rows) {
- target_cell <- xml_child(xml_child(kable_tbody, i), all_contents_array[i])
- if (!is.null(width)) {
- xml_attr(target_cell, "style") <- paste0(xml_attr(target_cell, "style"),
- "width: ", width, "; ")
- }
- 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 (!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, ";")
+ for (j in columns) {
+ 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 (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 (!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, ";")
+ }
}
}
out <- as_kable_xml(kable_xml)
@@ -134,10 +131,11 @@
return(out)
}
-column_spec_latex <- function(kable_input, column, width,
+column_spec_latex <- function(kable_input, columns, width,
bold, italic, monospace,
color, background,
- border_left, border_right) {
+ border_left, border_right,
+ decimal_align = F) {
table_info <- magic_mirror(kable_input)
if (!is.null(table_info$collapse_rows)) {
message("Usually it is recommended to use column_spec before collapse_rows,",
@@ -146,8 +144,8 @@
align_collapse <- ifelse(table_info$booktabs, "", "\\|")
kable_align_old <- paste(table_info$align_vector, collapse = align_collapse)
- table_info$align_vector[column] <- unlist(lapply(
- table_info$align_vector_origin[column],
+ table_info$align_vector[columns] <- unlist(lapply(
+ table_info$align_vector_origin[columns],
function(x) {
latex_column_align_builder(
x, width, bold, italic, monospace,
@@ -165,7 +163,9 @@
if (is.null(table_info$column_width)) {
table_info$column_width <- list()
}
- table_info$column_width[[paste0("column_", column)]] <- width
+ for (i in columns) {
+ table_info$column_width[[paste0("column_", i)]] <- width
+ }
}
attr(out, "kable_meta") <- table_info
return(out)