diff --git a/DESCRIPTION b/DESCRIPTION index e690f9f2..46c1dd02 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: officer Title: Manipulation of Microsoft Word and PowerPoint Documents -Version: 0.6.7.007 +Version: 0.6.7.008 Authors@R: c( person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")), person("Stefan", "Moog", , "moogs@gmx.de", role = "aut"), diff --git a/NEWS.md b/NEWS.md index f5440dfa..bee2adf9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,12 @@ - remove_fields in `docx_summary()` now also removes "w:fldData" nodes. - complete the manual of `body_add_docx()` with a note about the file basename that can not contain ' ' and trigger an error if it contains a ' '. -- `plot_layout_properties()` gains a 'title' parameter, which will add the layout name as the plot title. Defaults to `FALSE`, to not alter the old behavior. Also, the slide width and height are now correctly displayed in the plot. Before, a box was drawn around the plot area. However, the plot area var with device size, not slide size. +- `plot_layout_properties()` gains a 'title' parameter, which will add the layout name as the plot title. Defaults to +`FALSE`, to not alter the old behavior. Also, the slide width and height are now correctly displayed in the plot. +Before, a box was drawn around the plot area. However, the plot area var with device size, not slide size. +- class `dir_collection`: Files are now added to a container in the order of their trailing numeric index (#596). +For example, `slideLayout2.xml` will now preceed `slideLayout10.xml`. Before, alphabetical sorting was used, where +`slideLayout10.xml` comes before `slideLayout2.xml`. ## Features diff --git a/R/ppt_class_dir_collection.R b/R/ppt_class_dir_collection.R index 02859326..5a242830 100644 --- a/R/ppt_class_dir_collection.R +++ b/R/ppt_class_dir_collection.R @@ -6,8 +6,8 @@ dir_collection <- R6Class( initialize = function( package_dir, container ) { dir_ <- file.path(package_dir, container$dir_name()) private$package_dir <- package_dir - filenames <- list.files(path = dir_, pattern = "\\.xml$", full.names = TRUE) + filenames <- sort_vec_by_index(filenames) # see issue 596 private$collection <- lapply( filenames, function(x, container){ container$clone()$feed(x) }, container = container) diff --git a/R/utils.R b/R/utils.R index 54bcff7c..d723f95e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -210,9 +210,6 @@ correct_id <- function(doc, int_id){ } - - - check_bookmark_id <- function(bkm){ if(!is.null(bkm)){ invalid_bkm <- is.character(bkm) && @@ -237,7 +234,70 @@ is_doc_open <- function(file) { } +# Extract trailing numeric index in .xml filename +# +# Useful to for slideMaster and slideLayout .xml files. +# +# Examples: +# files <- c("slideLayout1.xml", "slideLayout2.xml", "slideLayout10.xml") +# get_file_index(files) +# +get_file_index <- function(file) { + sub(pattern = ".+?(\\d+).xml$", replacement = "\\1", x = basename(file), ignore.case = TRUE) |> as.numeric() +} + + +# Sort xml filenames by trailing numeric index +# +# Useful to for slideMaster and slideLayout xml files. +# +# Examples: +# files <- c("slideLayout1.xml", "slideLayout2.xml", "slideLayout12.xml") +# sort_vec_by_index(files) # => order corresponding to trailing index +# sort(files) # => incorrect lexicographical ordering +# +sort_vec_by_index <- function(x) { + indexes <- get_file_index(x) + x[order(indexes)] +} + + +# Sort dataframe column by trailing index +# +# df: A dataframe +# ...: columsn to sort by, comma separated +# +# Examples: +# df <- data.frame( +# a = paste0("file_", rep(3:1, each = 2), ".xml"), +# b = paste0("file_", rep(3:1, 2), ".xml") +# ) +# sort_dataframe_by_index(df, "a", "b") +# sort_dataframe_by_index(df, "b", "a") +# +sort_dataframe_by_index <- function(df, ...) { + sort_columns <- c(...) + l <- lapply(sort_columns, function(.col) { + get_file_index(df[[.col]]) + }) + df[do.call(order, l), , drop =FALSE] +} + + +# rename dataframe columns +# +# Examples: +# df_rename(mtcars, c("mpg", "cyl"), c("A", "B")) +# +df_rename <- function(df, old, new) { + .nms <- names(df) + .nms[match(old, .nms)] <- new + stats::setNames(df, .nms) +} + + # htmlEscapeCopy ---- + htmlEscapeCopy <- local({ .htmlSpecials <- list( diff --git a/man/officer.Rd b/man/officer.Rd index f1557c00..ad4bedb5 100644 --- a/man/officer.Rd +++ b/man/officer.Rd @@ -50,6 +50,8 @@ Other contributors: \item Bill Denney \email{wdenney@humanpredictions.com} (\href{https://orcid.org/0000-0002-5759-428X}{ORCID}) (function as.matrix.rpptx) [contributor] \item Nikolai Beck \email{beck.nikolai@gmail.com} (set speaker notes for .pptx documents) [contributor] \item Greg Leleu \email{gregoire.leleu@gmail.com} (fields functionality in ppt) [contributor] + \item Majid Eismann [contributor] + \item Mark Heckmann \email{heckmann.mark@gmail.com} (\href{https://orcid.org/0000-0002-0736-7417}{ORCID}) [contributor] \item Hongyuan Jia \email{hongyuanjia@cqust.edu.cn} (\href{https://orcid.org/0000-0002-0075-8183}{ORCID}) [contributor] } diff --git a/tests/testthat/docs_dir/test-layouts-ordering-3-masters.pptx b/tests/testthat/docs_dir/test-layouts-ordering-3-masters.pptx new file mode 100644 index 00000000..d82226d1 Binary files /dev/null and b/tests/testthat/docs_dir/test-layouts-ordering-3-masters.pptx differ diff --git a/tests/testthat/docs_dir/test-layouts-ordering.pptx b/tests/testthat/docs_dir/test-layouts-ordering.pptx new file mode 100644 index 00000000..b90cb1c0 Binary files /dev/null and b/tests/testthat/docs_dir/test-layouts-ordering.pptx differ diff --git a/tests/testthat/test-pptx-info.R b/tests/testthat/test-pptx-info.R index de722f92..d81ab1a3 100644 --- a/tests/testthat/test-pptx-info.R +++ b/tests/testthat/test-pptx-info.R @@ -1,12 +1,36 @@ test_that("layout summary", { x <- read_pptx() laysum <- layout_summary(x) - expect_is( laysum, "data.frame" ) - expect_true( all( c("layout", "master") %in% names(laysum)) ) - expect_is( laysum$layout, "character" ) - expect_is( laysum$master, "character" ) + expect_is(laysum, "data.frame") + expect_true(all(c("layout", "master") %in% names(laysum))) + expect_is(laysum$layout, "character") + expect_is(laysum$master, "character") }) + +test_that("layout summary - layout order (#596)", { + file <- test_path("docs_dir", "test-layouts-ordering.pptx") + x <- read_pptx(file) + df <- layout_summary(x) + order_exp <- c( + "Title Slide", "Title and Content", "Section Header", "Two Content", "Comparison", + "Title Only", "Blank", "layout_8", "layout_9", "layout_10", "layout_11" + ) + expect_equal(df$layout, order_exp) + df <- x$slideLayouts$get_metadata() # used inside layout_summary + expect_true(all(get_file_index(df$filename) == 1:11)) + + file <- test_path("docs_dir", "test-layouts-ordering-3-masters.pptx") + x <- read_pptx(file) + df <- layout_summary(x) + la <- c("Title Slide", "Title and Content", "Section Header", "Two Content", "Comparison", "Title Only", "Blank") + order_exp <- rep(la, 3) + expect_equal(df$layout, order_exp) + order_exp <- rep(paste0("Master_", 1:3), each = length(la)) + expect_equal(df$master, order_exp) +}) + + test_that("layout properties", { x <- read_pptx() x <- add_slide(x, "Title and Content", "Office Theme") @@ -15,18 +39,19 @@ test_that("layout properties", { laypr <- layout_properties(x, layout = "Title and Content", master = "Office Theme") - expect_is( laypr, "data.frame" ) - expect_true( all( c("master_name", "name", "type", "offx", "offy", "cx", "cy", "rotation") %in% names(laypr)) ) - expect_is( laypr$master_name, "character" ) - expect_is( laypr$name, "character" ) - expect_is( laypr$type, "character" ) - expect_is( laypr$offx, "numeric" ) - expect_is( laypr$offy, "numeric" ) - expect_is( laypr$cx, "numeric" ) - expect_is( laypr$cy, "numeric" ) - expect_is( laypr$rotation, "numeric" ) + expect_is(laypr, "data.frame") + expect_true(all(c("master_name", "name", "type", "offx", "offy", "cx", "cy", "rotation") %in% names(laypr))) + expect_is(laypr$master_name, "character") + expect_is(laypr$name, "character") + expect_is(laypr$type, "character") + expect_is(laypr$offx, "numeric") + expect_is(laypr$offy, "numeric") + expect_is(laypr$cx, "numeric") + expect_is(laypr$cy, "numeric") + expect_is(laypr$rotation, "numeric") }) + save_png <- function(code, width = 700, height = 700) { path <- tempfile(fileext = ".png") png(path, width = width, height = height, res = 150) @@ -36,6 +61,7 @@ save_png <- function(code, width = 700, height = 700) { path } + test_that("plot layout properties", { skip_if_not_installed("doconv") skip_if_not(doconv::msoffice_available()) @@ -45,20 +71,24 @@ test_that("plot layout properties", { png1 <- tempfile(fileext = ".png") png(png1, width = 7, height = 6, res = 150, units = "in") - plot_layout_properties( x = x, layout = "Title Slide", - master = "Office Theme" ) + plot_layout_properties( + x = x, layout = "Title Slide", + master = "Office Theme" + ) dev.off() png2 <- tempfile(fileext = ".png") png(png2, width = 7, height = 6, res = 150, units = "in") - plot_layout_properties( x = x, layout = "Title Slide", - master = "Office Theme", - labels = FALSE) + plot_layout_properties( + x = x, layout = "Title Slide", + master = "Office Theme", + labels = FALSE + ) dev.off() expect_snapshot_doc(name = "plot-twocontent-layout", x = png1, engine = "testthat") expect_snapshot_doc(name = "plot-twocontent-layout-nolabel", x = png2, engine = "testthat") - }) + test_that("slide summary", { x <- read_pptx() x <- add_slide(x, "Title and Content", "Office Theme") @@ -67,28 +97,27 @@ test_that("slide summary", { sm <- slide_summary(x) - expect_is( sm, "data.frame" ) - expect_equal( nrow(sm), 2 ) - expect_true( all( c("id", "type", "offx", "offy", "cx", "cy") %in% names(sm)) ) - expect_is( sm$id, "character" ) - expect_is( sm$type, "character" ) - expect_true( is.double(sm$offx) ) - expect_true( is.double(sm$offy) ) - expect_true( is.double(sm$cx) ) - expect_true( is.double(sm$cy) ) + expect_is(sm, "data.frame") + expect_equal(nrow(sm), 2) + expect_true(all(c("id", "type", "offx", "offy", "cx", "cy") %in% names(sm))) + expect_is(sm$id, "character") + expect_is(sm$type, "character") + expect_true(is.double(sm$offx)) + expect_true(is.double(sm$offy)) + expect_true(is.double(sm$cx)) + expect_true(is.double(sm$cy)) }) + test_that("color scheme", { x <- read_pptx() cs <- color_scheme(x) - expect_is( cs, "data.frame" ) - expect_equal( ncol(cs), 4 ) - expect_true( all( c("name", "type", "value", "theme") %in% names(cs)) ) - expect_is( cs$name, "character" ) - expect_is( cs$type, "character" ) - expect_is( cs$value, "character" ) - expect_is( cs$theme, "character" ) + expect_is(cs, "data.frame") + expect_equal(ncol(cs), 4) + expect_true(all(c("name", "type", "value", "theme") %in% names(cs))) + expect_is(cs$name, "character") + expect_is(cs$type, "character") + expect_is(cs$value, "character") + expect_is(cs$theme, "character") }) - - diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 00000000..b824f475 --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,19 @@ +test_that("trailing file index extraction / sorting", { + files <- c("slideLayout1.xml", "slideLayout11.xml", "slideLayout2.xml", "slideLayout10.xml") + + expect_equal(get_file_index(files), c(1, 11, 2, 10)) + + expect_equal(sort_vec_by_index(files), c("slideLayout1.xml", "slideLayout2.xml", "slideLayout10.xml", "slideLayout11.xml")) + + df <- data.frame(file1 = files, file2 = rev(files)) + a <- sort_dataframe_by_index(df, "file1") + b <- sort_dataframe_by_index(df, "file2") + expect_true(all(a == rev(b))) +}) + + +test_that("misc", { + df <- df_rename(mtcars, c("mpg", "cyl"), c("A", "B")) + expect_true(all(names(df)[1:2] == c("A", "B"))) +}) +