commit 33b865f485c8b394505f202d13c83b60b8a26c5f
author Hao Zhu <haozhu233@gmail.com> Tue Aug 18 02:10:43 2020 -0400
committer Hao Zhu <haozhu233@gmail.com> Tue Aug 18 02:10:43 2020 -0400
tree c4f1614fb08b2cb29c3cd865d9cca9f4a354ef50
parent 2b739ac03621b0631f63e10bb97ac0440af61e45

* Added kable_paper style for a NYT like table
* Let column_spec take conditional formats
* Added html_font option for kable_styling

R/spec_tools.R

diff --git a/R/spec_tools.R b/R/spec_tools.R
index 0ae4032..350925b 100644
--- a/R/spec_tools.R
+++ b/R/spec_tools.R
@@ -35,6 +35,16 @@
 
 latex_color_ <- function(color) {
   if (substr(color, 1, 1) != "#") {
+    return(paste0("\\{", color, "\\}"))
+  } else {
+    color <- sub("#", "", color)
+    if (nchar(color) == 8) color <- substr(color, 1, 6)
+    return(paste0("\\[HTML\\]\\{", color, "\\}"))
+  }
+}
+
+latex_color__ <- function(color) {
+  if (substr(color, 1, 1) != "#") {
     return(paste0("{", color, "}"))
   } else {
     color <- sub("#", "", color)
@@ -42,9 +52,14 @@
     return(paste0("[HTML]{", color, "}"))
   }
 }
-latex_color <- function(colors) {
+latex_color <- function(colors, escape = TRUE) {
   colors <- as.character(colors)
-  sapply(colors, latex_color_)
+  if (escape) {
+    return(sapply(colors, latex_color_))
+  } else {
+    return(sapply(colors, latex_color__))
+  }
+
 }
 
 #' Generate common font size for continuous values
@@ -98,11 +113,18 @@
   position <- match.arg(position, c("right", "bottom", "top", "left", "auto"),
                         several.ok = TRUE)
   tooltip_options <- paste(
-    'data-toggle="tooltip"',
+    'data-toggle="tooltip" data-container="body"',
     paste0('data-placement="', position, '"'),
     # ifelse(as_html, 'data-html="true"', NULL),
     paste0('title="', title, '"'))
+  tooltip_options_list <- list(
+    'data-toggle' = 'tooltip',
+    'data-container' = 'body',
+    'data-placement' = position,
+    'title' = if(is.null(title)) '' else title
+  )
   class(tooltip_options) <- "ke_tooltip"
+  attr(tooltip_options, 'list') <- tooltip_options_list
   return(tooltip_options)
 }
 
@@ -123,11 +145,22 @@
   position <- match.arg(position, c("bottom", "top", "left", "right", "auto"),
                         several.ok = TRUE)
   popover_options <- paste(
-    'data-toggle="popover"',
+    'data-toggle="popover" data-container="body"',
     paste0('data-trigger="', trigger, '"'),
     paste0('data-placement="', position, '"'),
     ifelse(!is.null(title), paste0('title="', title, '"'), ""),
     paste0('data-content="', content, '"'))
+  popover_options_list <- list(
+    'data-toggle' = 'popover',
+    'data-container' = 'body',
+    'data-trigger' = trigger,
+    'data-placement' = position,
+    'data-content' = content
+  )
+  if (!is.null(title)) {
+    popover_options_list['title'] <- title
+  }
   class(popover_options) <- "ke_popover"
+  attr(popover_options, 'list') <- popover_options_list
   return(popover_options)
 }