Fix #30 by adding option escape to add_header_abover & group_rows
diff --git a/R/add_header_above.R b/R/add_header_above.R
index 5716d84..95e587d 100644
--- a/R/add_header_above.R
+++ b/R/add_header_above.R
@@ -13,6 +13,10 @@
#' As a result, `c(" ", "title" = 2)` is the same as `c(" " = 1, "title" = 2)`.
#' @param bold A T/F value to control whether the text should be bolded.
#' @param italic A T/F value to control whether the text should to be emphasized.
+#' @param monospace A T/F value to control whether the text of the selected column
+#' need to be monospaced (verbatim)
+#' @param escape A T/F value showing whether special characters should be
+#' escaped.
#'
#' @examples x <- knitr::kable(head(mtcars), "html")
#' # Add a row of header with 3 columns on the top of the table. The column
@@ -20,22 +24,27 @@
#' add_header_above(x, c(" ", "Group 1" = 5, "Group 2" = 6))
#'
#' @export
-add_header_above <- function(kable_input, header = NULL, bold = F, italic = F) {
+add_header_above <- function(kable_input, header = NULL,
+ bold = FALSE, italic = FALSE,
+ monospace = FALSE, escape = TRUE) {
kable_format <- attr(kable_input, "format")
if (!kable_format %in% c("html", "latex")) {
stop("Please specify output format in your kable function. Currently ",
"generic markdown table using pandoc is not supported.")
}
if (kable_format == "html") {
- return(htmlTable_add_header_above(kable_input, header, bold, italic))
+ return(htmlTable_add_header_above(kable_input, header,
+ bold, italic, monospace, escape))
}
if (kable_format == "latex") {
- return(pdfTable_add_header_above(kable_input, header, bold, italic))
+ return(pdfTable_add_header_above(kable_input, header,
+ bold, italic, monospace, escape))
}
}
# HTML
-htmlTable_add_header_above <- function(kable_input, header, bold, italic) {
+htmlTable_add_header_above <- function(kable_input, header,
+ bold, italic, monospace, escape) {
if (is.null(header)) return(kable_input)
kable_attrs <- attributes(kable_input)
kable_xml <- read_kable_as_xml(kable_input)
@@ -43,6 +52,10 @@
header <- standardize_header_input(header)
+ if (escape) {
+ header$header <- escape_html(header$header)
+ }
+
header_rows <- xml_children(kable_xml_thead)
bottom_header_row <- header_rows[[length(header_rows)]]
kable_ncol <- length(xml_children(bottom_header_row))
@@ -51,7 +64,8 @@
"columns with the original kable output.")
}
- new_header_row <- htmlTable_new_header_generator(header, bold, italic)
+ new_header_row <- htmlTable_new_header_generator(header,
+ bold, italic, monospace)
xml_add_child(kable_xml_thead, new_header_row, .where = 0)
out <- as_kable_xml(kable_xml)
attributes(out) <- kable_attrs
@@ -73,10 +87,11 @@
return(data.frame(header = names(header), colspan = header, row.names = NULL))
}
-htmlTable_new_header_generator <- function(header_df, bold, italic) {
+htmlTable_new_header_generator <- function(header_df, bold, italic, monospace) {
row_style <- paste0(
ifelse(bold, "font-weight: bold; ", ""),
- ifelse(italic, "font-style: italic; ", "")
+ ifelse(italic, "font-style: italic; ", ""),
+ ifelse(monospace, "font-family: monospace; ", "")
)
header_items <- apply(header_df, 1, function(x) {
if (trimws(x[1]) == "") {
@@ -96,14 +111,17 @@
}
# Add an extra header row above the current header in a LaTeX table ------
-pdfTable_add_header_above <- function(kable_input, header, bold, italic) {
+pdfTable_add_header_above <- function(kable_input, header,
+ bold, italic, monospace, escape) {
table_info <- magic_mirror(kable_input)
header <- standardize_header_input(header)
- header$header <- escape_latex(header$header)
- header$header <- gsub("\\\\", "\\\\\\\\", header$header)
+ if (escape) {
+ header$header <- escape_latex(header$header)
+ header$header <- gsub("\\\\", "\\\\\\\\", header$header)
+ }
hline_type <- switch(table_info$booktabs + 1, "\\\\hline", "\\\\toprule")
new_header_split <- pdfTable_new_header_generator(header, table_info$booktabs,
- bold, italic)
+ bold, italic, monospace)
new_header <- paste0(new_header_split[1], "\n", new_header_split[2])
out <- sub(hline_type,
paste0(hline_type, "\n", new_header),
@@ -122,7 +140,7 @@
}
pdfTable_new_header_generator <- function(header_df, booktabs = FALSE,
- bold, italic) {
+ bold, italic, monospace) {
if (booktabs) {
header_df$align <- "c"
} else {
@@ -135,7 +153,9 @@
paste0('\\\\multicolumn{', x[2], '}{', x[3], '}{',
ifelse(bold, "\\\\bfseries ", ""),
ifelse(italic, "\\\\em ", ""),
- x[1], "}")
+ ifelse(monospace, "\\\\ttfamily ", ""),
+ x[1],
+ "}")
})
header_text <- paste(paste(header_items, collapse = " & "), "\\\\\\\\")
cline <- cline_gen(header_df, booktabs)
diff --git a/R/group_rows.R b/R/group_rows.R
index 79f3d6f..47a02f0 100644
--- a/R/group_rows.R
+++ b/R/group_rows.R
@@ -15,6 +15,8 @@
#' @param latex_gap_space A character value telling LaTeX how large the gap
#' between the previous row and the group labeling row. Only useful for LaTeX
#' documents.
+#' @param escape A T/F value showing whether special characters should be
+#' escaped.
#'
#' @examples x <- knitr::kable(head(mtcars), "html")
#' # Put Row 2 to Row 5 into a Group and label it as "Group A"
@@ -23,7 +25,8 @@
#' @export
group_rows <- function(kable_input, group_label, start_row, end_row,
label_row_css = "border-bottom: 1px solid;",
- latex_gap_space = "0.5em") {
+ latex_gap_space = "0.5em",
+ escape = TRUE) {
if (!is.numeric(c(start_row, end_row))) {
stop("Start_row and end_row must be numeric position of rows (excluding",
"header rows and other group-title rows). ")
@@ -35,20 +38,24 @@
}
if (kable_format == "html") {
return(group_rows_html(kable_input, group_label, start_row, end_row,
- label_row_css))
+ label_row_css, escape))
}
if (kable_format == "latex") {
return(group_rows_latex(kable_input, group_label, start_row, end_row,
- latex_gap_space))
+ latex_gap_space, escape))
}
}
group_rows_html <- function(kable_input, group_label, start_row, end_row,
- label_row_css) {
+ label_row_css, escape) {
kable_attrs <- attributes(kable_input)
kable_xml <- read_kable_as_xml(kable_input)
kable_tbody <- xml_tpart(kable_xml, "tbody")
+ if (escape) {
+ group_label <- escape_html(group_label)
+ }
+
group_header_rows <- attr(kable_input, "group_header_rows")
group_seq <- seq(start_row, end_row)
if (!is.null(group_header_rows)) {
@@ -76,10 +83,15 @@
}
group_rows_latex <- function(kable_input, group_label, start_row, end_row,
- gap_space) {
+ gap_space, escape) {
table_info <- magic_mirror(kable_input)
out <- kable_input
+ if (escape) {
+ group_label <- escape_latex(group_label)
+ group_label <- gsub("\\\\", "\\\\\\\\", group_label)
+ }
+
# Add group label
rowtext <- table_info$contents[start_row + 1]
if (table_info$booktabs) {
diff --git a/inst/NEWS b/inst/NEWS
index 66f09fb..f2de624 100644
--- a/inst/NEWS
+++ b/inst/NEWS
@@ -25,6 +25,8 @@
* Improve striped line look on tables with multiple layers of header rows. (#31)
+* Adding escape to `add_header_above` and `group_rows`
+
kableExtra 0.3.0
--------------------------------------------------------------------------------
* Improved the look of HTML grouped header row (again) by adding spaces between
diff --git a/man/add_header_above.Rd b/man/add_header_above.Rd
index d879bc7..6e3f214 100644
--- a/man/add_header_above.Rd
+++ b/man/add_header_above.Rd
@@ -4,7 +4,8 @@
\alias{add_header_above}
\title{Add a header row on top of current header}
\usage{
-add_header_above(kable_input, header = NULL, bold = F, italic = F)
+add_header_above(kable_input, header = NULL, bold = FALSE, italic = FALSE,
+ monospace = FALSE, escape = TRUE)
}
\arguments{
\item{kable_input}{Output of \code{knitr::kable()} with \code{format} specified}
@@ -18,6 +19,12 @@
\item{bold}{A T/F value to control whether the text should be bolded.}
\item{italic}{A T/F value to control whether the text should to be emphasized.}
+
+\item{monospace}{A T/F value to control whether the text of the selected column
+need to be monospaced (verbatim)}
+
+\item{escape}{A T/F value showing whether special characters should be
+escaped.}
}
\description{
Tables with multiple rows of header rows are extremely useful
diff --git a/man/group_rows.Rd b/man/group_rows.Rd
index 8275309..b89ad91 100644
--- a/man/group_rows.Rd
+++ b/man/group_rows.Rd
@@ -5,7 +5,8 @@
\title{Put a few rows of a table into one category}
\usage{
group_rows(kable_input, group_label, start_row, end_row,
- label_row_css = "border-bottom: 1px solid;", latex_gap_space = "0.5em")
+ label_row_css = "border-bottom: 1px solid;", latex_gap_space = "0.5em",
+ escape = TRUE)
}
\arguments{
\item{kable_input}{Output of \code{knitr::kable()} with \code{format} specified}
@@ -26,6 +27,9 @@
\item{latex_gap_space}{A character value telling LaTeX how large the gap
between the previous row and the group labeling row. Only useful for LaTeX
documents.}
+
+\item{escape}{A T/F value showing whether special characters should be
+escaped.}
}
\description{
Group a few rows in a table together under a label.