tests/testthat/test-fpar.R

In officer: Manipulation of Microsoft Word and PowerPoint Documents

source("utils.R")

get_wml_node <- function(x) {
  xml_ <- to_wml(x)
  read_xml(wml_str(xml_))
}
get_pml_node <- function(x) {
  xml_ <- pml_str(to_pml(x))
  read_xml(xml_)
}

test_that("fpar content", {
  fp <- fpar(
    ftext("toto", shortcuts$fp_bold()),
    ftext("titi", shortcuts$fp_italic())
  )
  fp <- fpar(ftext("toto", fp_text(font.size = 9)), "titi")
  fp <- update(fp, fp_t = fp_text(bold = TRUE, font.size = 9))
  df <- as.data.frame(fp)
  expect_equal(df$value, c("toto", "titi"))
  expect_equal(df$size, c(9, 9))
  expect_equal(df$bold, c(FALSE, TRUE))
  expect_equal(df$italic, c(FALSE, FALSE))
})


test_that("fpar wml", {
  fp <- fpar(
    ftext("toto", shortcuts$fp_bold()),
    ftext("titi", shortcuts$fp_italic())
  )
  node <- get_wml_node(fp)

  expect_equal(xml_text(node), "tototiti")
  expect_equal(xml_text(xml_find_all(node, "//w:r/w:t")), c("toto", "titi"))
  val <- xml_attr(xml_find_all(node, "//w:pPr/w:jc"), "val")
  expect_equal(val, "left")

  fp <- update(fp, fp_p = fp_par(text.align = "center"))
  node <- get_wml_node(fp)
  val <- xml_find_all(node, "//w:pPr/w:jc")
  val <- xml_attr(val, "val")
  expect_equal(val, "center")

  fp <- fpar(
    ftext("pi", fp_text()),
    ftext(" = ", fp_text(italic = TRUE)),
    pi
  )
  fp <- update(fp, fp_t = fp_text(bold = TRUE))
  node <- get_wml_node(fp)
  italic <- xml_find_all(node, "//w:r/w:rPr")
  italic <- xml_child(italic, "w:i")
  italic <- xml_attr(italic, "val") %in% "true"

  bold <- xml_find_all(node, "//w:r/w:rPr")
  bold <- xml_child(bold, "w:b")
  bold <- xml_attr(bold, "val") %in% "true"

  expect_equal(italic, c(FALSE, TRUE, FALSE))
  expect_equal(bold, c(FALSE, FALSE, TRUE))
})


test_that("fpar pml", {
  fp <- fpar(
    ftext("toto", shortcuts$fp_bold()),
    ftext("titi", shortcuts$fp_italic())
  )
  node <- get_pml_node(fp)

  expect_equal(xml_text(node), "tototiti")
  expect_equal(xml_text(xml_find_all(node, "//a:r/a:t")), c("toto", "titi"))
  expect_equal(xml_attr(xml_find_all(node, "//a:r/a:rPr"), "b"), c("1", "0"))
  expect_equal(xml_attr(xml_find_all(node, "//a:r/a:rPr"), "i"), c("0", "1"))
  val <- xml_attr(xml_find_all(node, "//a:p/a:pPr"), "algn")
  expect_equal(val, "l")

  fp <- update(fp, fp_p = fp_par(text.align = "center"))
  node <- get_pml_node(fp)
  val <- xml_attr(xml_find_all(node, "//a:p/a:pPr"), "algn")
  expect_equal(val, "ctr")
})


test_that("fpar css", {
  fp <- fpar(
    ftext("toto", shortcuts$fp_bold()),
    ftext("titi", shortcuts$fp_italic())
  )
  node <- read_xml(to_html(fp))

  expect_equal(xml_text(node), "tototiti")
  expect_equal(xml_text(xml_find_all(node, "//span")), c("toto", "titi"))
  bold <- xml_attr(xml_find_all(node, "//span"), "style")
  bold <- has_css_attr(bold, atname = "font-weight", value = "bold")
  expect_equal(bold, c(TRUE, FALSE))

  italic <- xml_attr(xml_find_all(node, "//span"), "style")
  italic <- has_css_attr(italic, atname = "font-style", value = "italic")
  expect_equal(italic, c(FALSE, TRUE))

  val <- xml_attr(xml_find_all(node, "//p"), "style")
  val <- has_css_attr(val, atname = "text-align", value = "left")
  expect_true(val)

  fp <- update(fp, fp_p = fp_par(text.align = "center"))
  node <- read_xml(to_html(fp))
  val <- xml_attr(xml_find_all(node, "//p"), "style")
  val <- has_css_attr(val, atname = "text-align", value = "center")
  expect_true(val)
})