source("utils.R") wml_is_italic <- function(doc_){ !inherits(xml_find_first(doc_, "/w:document/w:rPr/w:i"), "xml_missing") } wml_is_bold <- function(doc_){ !inherits(xml_find_first(doc_, "/w:document/w:rPr/w:b"), "xml_missing") } wml_is_underline <- function(doc_){ !inherits(xml_find_first(doc_, "/w:document/w:rPr/w:u"), "xml_missing") } test_that("wml - font size", { fp <- fp_text(font.size = 10) xml_ <- format(fp, type = "wml") doc <- read_xml( wml_str(xml_) ) sz <- xml_find_first(doc, "/w:document/w:rPr/w:sz") szCs <- xml_find_first(doc, "/w:document/w:rPr/w:szCs") expect_false(inherits( szCs, "xml_missing") ) expect_false(inherits( sz, "xml_missing") ) expect_equal(xml_attr(sz, "val"), xml_attr(szCs, "val")) expect_equal(xml_attr(sz, "val"), expected = "20") }) test_that("wml - bold italic underlined", { fp_bold <- fp_text(bold = TRUE) fp_italic <- update(fp_bold, bold = FALSE, italic = TRUE) fp_bold_italic <- update(fp_bold, italic = TRUE) fp_underline <- fp_text(underlined = TRUE ) xml_bold_ <- format(fp_bold, type = "wml") xml_italic_ <- format(fp_italic, type = "wml") xml_bolditalic_ <- format(fp_bold_italic, type = "wml") xml_underline_ <- format(fp_underline, type = "wml") doc_bold_ <- read_xml( wml_str(xml_bold_) ) doc_italic_ <- read_xml( wml_str(xml_italic_) ) doc_bolditalic_ <- read_xml( wml_str(xml_bolditalic_) ) doc_underline_ <- read_xml( wml_str(xml_underline_) ) expect_equal(wml_is_bold(doc_bold_), TRUE) expect_equal( xml_attr(xml_find_first(doc_bold_, "/w:document/w:rPr/w:i"), "val"), "false") expect_equal( xml_attr(xml_find_first(doc_italic_, "/w:document/w:rPr/w:b"), "val"), "false") expect_equal( xml_attr(xml_find_first(doc_italic_, "/w:document/w:rPr/w:i"), "val"), "true") expect_equal( xml_attr(xml_find_first(doc_italic_, "/w:document/w:rPr/w:b"), "val"), "false") expect_equal( xml_attr(xml_find_first(doc_italic_, "/w:document/w:rPr/w:i"), "val"), "true") expect_equal(wml_is_bold(doc_bolditalic_), TRUE) expect_equal(wml_is_italic(doc_bolditalic_), TRUE) expect_equal( xml_attr(xml_find_first(doc_bold_, "/w:document/w:rPr/w:u"), "val"), "none") expect_equal( xml_attr(xml_find_first(doc_underline_, "/w:document/w:rPr/w:u"), "val"), "single") }) test_that("wml - font name", { fontname = "Arial" fp_ <- fp_text(font.family = fontname) xml_ <- format(fp_, type = "wml") doc_ <- read_xml( wml_str(xml_) ) node <- xml_find_first(doc_, "/w:document/w:rPr/w:rFonts") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "ascii"), fontname ) expect_equal( xml_attr(node, "hAnsi"), fontname ) expect_equal( xml_attr(node, "cs"), fontname ) }) test_that("wml - font color", { fp_ <- fp_text(color = grDevices::rgb(.8, .2, .1, .6)) xml_ <- format(fp_, type = "wml") doc_ <- read_xml( wml_str(xml_) ) node <- xml_find_first(doc_, "/w:document/w:rPr/w:color") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "val"), "CC331A" ) node <- xml_find_first(doc_, "/w:document/w:rPr/w14:textFill") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(xml_child(node, "w14:solidFill/w14:srgbClr"), "val"), "CC331A" ) expect_equal( xml_attr(xml_child(node, "w14:solidFill/w14:srgbClr/w14:alpha"), "val"), "60000" ) }) test_that("wml - shading color", { fp_ <- fp_text(shading.color = rgb(1,0,1)) xml_ <- format(fp_, type = "wml") doc_ <- read_xml( wml_str(xml_) ) node <- xml_find_first(doc_, "/w:document/w:rPr/w:shd") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "fill"), "FF00FF" ) }) pml_has_true_attr <- function(doc_, what = "b"){ rpr <- xml_find_first(doc_, "/a:document/a:rPr") val <- xml_attr(rpr, what) !is.na( val ) && val == "1" } pml_attr <- function(doc_, what = "u"){ rpr <- xml_find_first(doc_, "/a:document/a:rPr") xml_attr(rpr, what) } test_that("pml - font size", { fp <- fp_text(font.size = 10) xml_ <- format(fp, type = "pml") doc_ <- read_xml( pml_str(xml_) ) rpr <- xml_find_first(doc_, "/a:document/a:rPr") expect_equal(xml_attr(rpr, "sz"), "1000") }) test_that("pml - bold italic underlined", { fp_bold <- fp_text(bold = TRUE) fp_italic <- update(fp_bold, bold = FALSE, italic = TRUE) fp_bold_italic <- update(fp_bold, italic = TRUE) fp_underline <- fp_text(underlined = TRUE ) xml_bold_ <- format(fp_bold, type = "pml") xml_italic_ <- format(fp_italic, type = "pml") xml_bolditalic_ <- format(fp_bold_italic, type = "pml") xml_underline_ <- format(fp_underline, type = "pml") doc_bold_ <- read_xml( pml_str(xml_bold_) ) doc_italic_ <- read_xml( pml_str(xml_italic_) ) doc_bolditalic_ <- read_xml( pml_str(xml_bolditalic_) ) doc_underline_ <- read_xml( pml_str(xml_underline_) ) expect_equal(pml_has_true_attr(doc_bold_, "b"), TRUE) expect_equal(pml_has_true_attr(doc_bold_, "i"), FALSE) expect_equal(pml_has_true_attr(doc_bold_, "u"), FALSE) expect_equal(pml_has_true_attr(doc_italic_, "b"), FALSE) expect_equal(pml_has_true_attr(doc_italic_, "i"), TRUE) expect_equal(pml_has_true_attr(doc_italic_, "u"), FALSE) expect_equal(pml_has_true_attr(doc_bolditalic_, "b"), TRUE) expect_equal(pml_has_true_attr(doc_bolditalic_, "i"), TRUE) expect_equal(pml_has_true_attr(doc_bolditalic_, "u"), FALSE) expect_equal(pml_has_true_attr(doc_underline_, "b"), FALSE) expect_equal(pml_has_true_attr(doc_underline_, "i"), FALSE) expect_equal(pml_attr(doc_underline_, "u"), "sng") }) test_that("pml - font name", { fontname = "Arial" fp_ <- fp_text(font.family = fontname) xml_ <- format(fp_, type = "pml") doc_ <- read_xml( pml_str(xml_) ) node <- xml_find_first(doc_, "/a:document/a:rPr/a:latin") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "typeface"), fontname ) node <- xml_find_first(doc_, "/a:document/a:rPr/a:cs") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "typeface"), fontname ) }) test_that("pml - font color", { fp_ <- fp_text(color= rgb(1, 0, 0, .5 )) xml_ <- format(fp_, type = "pml") doc_ <- read_xml( pml_str(xml_) ) node <- xml_find_first(doc_, "/a:document/a:rPr/a:solidFill/a:srgbClr") expect_false(inherits(node, "xml_missing")) expect_equal( xml_attr(node, "val"), "FF0000" ) node <- xml_find_first(doc_, "/a:document/a:rPr/a:solidFill/a:srgbClr/a:alpha") expect_equal( xml_attr(node, "val"), "50196" ) }) test_that("css", { fp <- fp_text(font.size = 10, color = "#00FFFF34", shading.color = "#00FFFFCC") expect_true(has_css_color(fp, "color", "rgba\\(0,255,255,0.20\\)")) expect_true(has_css_attr(fp, "font-family", "'Arial'")) expect_true(has_css_attr(fp, "font-size", "10.0pt")) expect_true(has_css_attr(fp, "font-style", "normal")) expect_true(has_css_attr(fp, "font-weight", "normal")) expect_true(has_css_attr(fp, "text-decoration", "none")) expect_true(has_css_color(fp, "background-color", "rgba\\(0,255,255,0.80\\)")) fp <- fp_text(bold = TRUE, italic = TRUE, underlined = TRUE) expect_true(has_css_attr(fp, "font-style", "italic")) expect_true(has_css_attr(fp, "font-weight", "bold")) expect_true(has_css_attr(fp, "text-decoration", "underline")) })