use tab.lp instead of hardcoded "tab:"

related to davidgohel/officedown#71
davidgohel · Jul 15, 2021 · 25eedf9 · 25eedf9
1 parent d737c44
commit 25eedf9
Show file tree

Hide file tree

Showing 8 changed files with 38 additions and 22 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: flextable
 Type: Package
 Title: Functions for Tabular Reporting
-Version: 0.6.7.002
+Version: 0.6.7.003
 Authors@R: c(
     person("David", "Gohel", role = c("aut", "cre"),
     email = "[email protected]"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+# flextable 0.6.7
+
+## new features
+
+* tab.lp is now a knitr supported chunk option and can be use to change the 
+label prefix for the table sequence id when a caption is used. See 
+https://github.com/davidgohel/officedown/issues/71.
+
 # flextable 0.6.6
 
 ## new features

diff --git a/R/docx_str.R b/R/docx_str.R
@@ -135,7 +135,7 @@ caption_docx_bookdown <- function(x){
     caption <- paste(
       "",
       style_start,
-      paste0("<caption>(\\#tab:", tab_props$id, ")", zz, "</caption>"),
+      paste0("<caption>(\\#", tab_props$tab.lp, tab_props$id, ")", zz, "</caption>"),
       style_end,
       "", sep = "\n")
   }

diff --git a/R/html_str.R b/R/html_str.R
@@ -1,8 +1,7 @@
 caption_html_str <- function(x, bookdown = FALSE){
   tab_props <- opts_current_table()
-
   # caption "bookmark"
-  bookdown_ref_label <- ref_label()
+  bookdown_ref_label <- ref_label(tab_props$tab.lp)
   if(bookdown && !is.null(x$caption$autonum$bookmark)){
     bookdown_ref_label <- paste0("(\\#", x$caption$autonum$seq_id, ":",
                                  x$caption$autonum$bookmark, ")")
@@ -29,7 +28,7 @@ caption_html_str <- function(x, bookdown = FALSE){
   }
   caption
 }
-html_str <- function(x, ft.align = NULL, class = "tabwid", caption = "", shadow = TRUE){
+html_str <- function(x, ft.align = NULL, class = "tabwid", caption = "", shadow = TRUE, topcaption = TRUE){
 
   fixed_layout <- x$properties$layout %in% "fixed"
   if(!fixed_layout){
@@ -45,8 +44,10 @@ html_str <- function(x, ft.align = NULL, class = "tabwid", caption = "", shadow
   classname <- gsub("(^[[:alnum:]]+)(.*)$", "cl-\\1", classname)
   tabcss <- paste0(".", classname, "{", tabcss, "}")
 
-  codes <- sprintf("<style>%s%s%s</style><table class='%s'>%s%s</table>",
-          tabcss, codes$css, flextable_global$defaults$extra_css, classname, caption, codes$html)
+  if(topcaption) str <- paste0(caption, codes$html)
+  else str <- paste0(codes$html, caption)
+  codes <- sprintf("<style>%s%s%s</style><table class='%s'>%s</table>",
+          tabcss, codes$css, flextable_global$defaults$extra_css, classname, str)
 
   if( is.null(ft.align) ) ft.align <- "center"
 

diff --git a/R/latex_str.R b/R/latex_str.R
@@ -487,10 +487,10 @@ latex_caption <- function(x, bookdown) {
   std_ref_label <- NULL
   if(bookdown && !is.null(x$caption$autonum$bookmark)){
     std_ref_label <- x$caption$autonum$bookmark
-    bookdown_ref_label <- paste0("(\\#tab:", x$caption$autonum$bookmark, ")")
+    bookdown_ref_label <- paste0("(\\#", tab_props$tab.lp, x$caption$autonum$bookmark, ")")
   } else if(bookdown && !is.null(tab_props$id)){
     std_ref_label <- tab_props$id
-    bookdown_ref_label <- paste0("(\\#tab:", tab_props$id, ")")
+    bookdown_ref_label <- paste0("(\\#", tab_props$tab.lp, tab_props$id, ")")
   }
 
 
@@ -506,7 +506,7 @@ latex_caption <- function(x, bookdown) {
       if (bookdown) {
         bookdown_ref_label
       } else if (!is.null(std_ref_label)) {
-        sprintf("\\label{tab:%s}", std_ref_label)
+        sprintf("\\label{", tab_props$tab.lp, "%s}", std_ref_label)
       },
       "\\\\"
     )

diff --git a/R/utils.R b/R/utils.R
@@ -60,14 +60,10 @@ absolute_path <- function(x){
 }
 
 #' @importFrom knitr opts_current
-ref_label <- function() {
+ref_label <- function(base = "tab:") {
   label <- opts_current$get('label')
   if (is.null(label)) return('')
-  paste0("(\\#tab:", label, ")")
-}
-
-has_label <- function(x) {
-  grepl("^\\(\\\\#tab:[-[:alnum:]]+\\)", x)
+  paste0("(\\#", base, label, ")")
 }
 
 

diff --git a/tests/testthat/test-rmarkdown.R b/tests/testthat/test-rmarkdown.R
@@ -6,7 +6,7 @@ cat("
 title: test
 ---
 
-```{r}
+```{r tab.lp='table:', tab.cap='caption', tab.id='tab1'}
 library(flextable)
 knitr::opts_chunk$set(echo = TRUE)
 rt <- flextable(head(mtcars))
@@ -39,3 +39,19 @@ test_that("docx output", {
   }
 })
 
+test_that("tab.lp is updated in HTML", {
+
+  skip_if_not(Sys.which('pandoc') != "")
+  skip_if_not(Sys.which('pandoc-citeproc') != "")
+  skip_if_not(rmarkdown::pandoc_available("1.12.3"))
+  skip_if_not(rmarkdown::pandoc_version() >= 2)
+
+  html <- rmarkdown::render(rmd_file, output_format = "bookdown::html_document2", output_file = html_file, quiet = TRUE)
+
+  doc <- read_html(html)
+  elt <- xml_find_first(doc, "body/div/template/div/table/caption")
+  expect_true(grepl("(#table:tab1)caption", xml_text(elt), fixed = TRUE))
+  # docx <- rmarkdown::render(rmd_file, output_format = "bookdown::word_document2", output_file = docx_file, quiet = TRUE)
+  # officer::docx_summary(officer::read_docx(docx))
+})
+
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -4,8 +4,3 @@ test_that("Adds label for cross referencing with bookdown", {
   expect_identical(ref_label(), "(\\#tab:foo)")
 })
 
-test_that("Check if a reference label is explicitly specified", {
-  expect_false(has_label('foo'))
-  expect_true(has_label('(\\#tab:foo)'))
-  expect_true(has_label('(\\#tab:fo-o)'))
-})