context("check cells text")
library(xml2)
library(officer)
ft1 <- flextable(data.frame(a = "1 < 3", stringsAsFactors = FALSE))
get_xml_doc <- function(tab, main_folder = "docx_folder") {
docx_file <- tempfile(fileext = ".docx")
doc <- read_docx()
doc <- body_add_flextable(doc, value = tab)
print(doc, target = docx_file)
main_folder <- file.path(getwd(), main_folder)
unlink(main_folder, recursive = TRUE, force = TRUE)
unpack_folder(file = docx_file, folder = main_folder)
doc_file <- file.path(main_folder, "/word/document.xml")
read_xml(doc_file)
}
get_xml_ppt <- function(tab, main_folder = "pptx_folder") {
pptx_file <- tempfile(fileext = ".pptx")
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, tab, location = ph_location_type(type = "body"))
print(doc, target = pptx_file)
main_folder <- file.path(getwd(), main_folder)
unlink(main_folder, recursive = TRUE, force = TRUE)
unpack_folder(file = pptx_file, folder = main_folder)
doc_file <- file.path(main_folder, "/ppt/slides/slide1.xml")
read_xml(doc_file)
}
test_that("docx - string are html encoded", {
main_folder <- "docx_folder"
doc <- get_xml_doc(tab = ft1, main_folder = main_folder)
text_ <- xml_text(xml_find_first(doc, "w:body/w:tbl[1]/w:tr[2]/w:tc/w:p/w:r/w:t"))
expect_equal(text_, c("1 < 3"))
unlink(main_folder, recursive = TRUE, force = TRUE)
})
test_that("pptx - string are html encoded", {
main_folder <- "pptx_folder"
doc <- get_xml_ppt(tab = ft1, main_folder = main_folder)
text_ <- xml_text(xml_find_first(doc, "//a:tbl/a:tr[2]/a:tc/a:txBody/a:p/a:r/a:t"))
expect_equal(text_, c("1 < 3"))
unlink(main_folder, recursive = TRUE, force = TRUE)
})
test_that("html - string are html encoded", {
str_ <- flextable:::gen_raw_html(ft1)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("(.*)", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", str_, "")
doc <- read_xml(str_)
text_ <- xml_text(xml_find_all(doc, "//table/tbody/tr/td/p"))
expect_equal(text_, c("a", ""))
})
test_that("newlines and tabulations expand correctly", {
z <- flextable(data.frame(a = c("")))
z <- compose(
x = z, i = 1, j = 1,
value = as_paragraph(
"this\nis\nit",
"\n\t", "This", "\n",
"is", "\n", "it", "\n",
"this\tis\tit\nthatsit\n"
)
)
z <- delete_part(z, part = "header")
chunks_txt <- flextable:::fortify_run(z)$txt
expect_equal(
chunks_txt,
c(
"this", "
", "is", "
", "it",
"
", "", "This", "
",
"is", "
", "it", "
", "this",
"", "is", "", "it", "
",
"thatsit", "
"
)
)
})
test_that("word superscript and subscript", {
ft <- flextable(data.frame(a = ""), col_keys = c("dummy"))
ft <- delete_part(ft, part = "header")
ft <- compose(ft,
i = 1, j = "dummy", part = "body",
value = as_paragraph(
as_sub("Sepal.Length")
)
)
runs <- flextable:::fortify_run(ft)
expect_equal(runs$vertical.align[1], "subscript")
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml, "", fixed = TRUE)
ft <- compose(ft,
i = 1, j = "dummy", part = "body",
value = as_paragraph(
as_sup("Sepal.Length")
)
)
runs <- flextable:::fortify_run(ft)
expect_equal(runs$vertical.align[1], "superscript")
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml, "", fixed = TRUE)
})