Skip to content

Commit

Permalink
internals: remove native R pipe usage from code
Browse files Browse the repository at this point in the history
  • Loading branch information
markheckmann authored Oct 1, 2024
1 parent 856d3b0 commit 92c7a32
Show file tree
Hide file tree
Showing 5 changed files with 18 additions and 27 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: officer
Title: Manipulation of Microsoft Word and PowerPoint Documents
Version: 0.6.7.014
Version: 0.6.7.015
Authors@R: c(
person("David", "Gohel", , "[email protected]", role = c("aut", "cre")),
person("Stefan", "Moog", , "[email protected]", role = "aut"),
Expand Down
5 changes: 3 additions & 2 deletions R/ppt_ph_dedupe_layout.R
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,8 @@ layout_dedupe_ph_labels <- function(x, action = "detect", print_info = FALSE) {
if (xfrm$delete_flag[i]) {
xml2::xml_remove(shape)
} else {
xml2::xml_find_first(shape, ".//p:cNvPr") |> xml2::xml_set_attr("name", xfrm$ph_label_new[i])
nodes <- xml2::xml_find_first(shape, ".//p:cNvPr")
xml2::xml_set_attr(nodes, "name", xfrm$ph_label_new[i])
}
}
layout$save() # persist changes in slideout xml file
Expand Down Expand Up @@ -118,7 +119,7 @@ has_ph_dupes <- function(x) {
return(invisible(NULL))
}
.df_2 <- x$slideLayouts$get_xfrm_data()
.df_2 <- .df_2[, c("master_file", "master_name"), drop = FALSE] |> unique()
.df_2 <- unique(.df_2[, c("master_file", "master_name"), drop = FALSE])
df <- merge(.df_1, .df_2, sort = FALSE)
rownames(df) <- NULL
df <- df[, c("master_name", "name", "ph_label", "ph_label_new", "delete_flag"), drop = FALSE]
Expand Down
11 changes: 0 additions & 11 deletions R/pptx_layout_helper.R
Original file line number Diff line number Diff line change
Expand Up @@ -50,17 +50,6 @@ get_layout <- function(x, layout, master = NULL) {
}



# else {
# # multiple layouts
# layout_exists(x, layout, must_exist = TRUE)
# layout_is_unique(x, layout, require_unique = TRUE)
# index <- which(df$layout_name == layout)
# }
# index <- which(df$layout_name == layout)
# l <- df[index, ] |> as.list()
# # l <- c(index = index, l, slide_layout = slide_layout)

#' @export
print.layout_info <- function(x, ...) {
cli::cli_h3("{.cls layout_info} object")
Expand Down
3 changes: 2 additions & 1 deletion R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -263,7 +263,8 @@ is_doc_open <- function(file) {
# get_file_index(files)
#
get_file_index <- function(file) {
sub(pattern = ".+?(\\d+).xml$", replacement = "\\1", x = basename(file), ignore.case = TRUE) |> as.numeric()
x <- sub(pattern = ".+?(\\d+).xml$", replacement = "\\1", x = basename(file), ignore.case = TRUE)
as.numeric(x)
}


Expand Down
24 changes: 12 additions & 12 deletions tests/testthat/test-pptx-add.R
Original file line number Diff line number Diff line change
Expand Up @@ -349,40 +349,40 @@ test_that("pptx ph_location_type", {
on.exit(options(opts))

x <- read_pptx()
x <- x |> add_slide("Two Content")
x <- add_slide(x, "Two Content")

expect_no_error({
x |> ph_with("correct ph type id", ph_location_type("body", type_idx = 1))
ph_with(x, "correct ph type id", ph_location_type("body", type_idx = 1))
})

expect_warning({
x |> ph_with("cannot supply id AND type_idx", ph_location_type("body", type_idx = 1, id = 1))
ph_with(x, "cannot supply id AND type_idx", ph_location_type("body", type_idx = 1, id = 1))
}, regexp = "`id` is ignored if `type_idx` is provided", fixed = TRUE)

expect_warning({
x |> ph_with("id still working with warning to avoid breaking change", ph_location_type("body", id = 1))
ph_with(x, "id still working with warning to avoid breaking change", ph_location_type("body", id = 1))
}, regexp = "The `id` argument in `ph_location_type()` is deprecated", fixed = TRUE)

expect_error({
x |> ph_with("out of range type id", ph_location_type("body", type_idx = 3)) # 3 does not exists => no error or warning
ph_with(x, "out of range type id", ph_location_type("body", type_idx = 3)) # 3 does not exists => no error or warning
}, regexp = "`type_idx` is out of range.", fixed = TRUE)

expect_error({
expect_warning({
x |> ph_with("out of range type id", ph_location_type("body", id = 3)) # 3 does not exists => no error or warning
ph_with(x, "out of range type id", ph_location_type("body", id = 3)) # 3 does not exists => no error or warning
}, regexp = " The `id` argument in `ph_location_type()` is deprecated", fixed = TRUE)
}, regexp = "`id` is out of range.", fixed = TRUE)

expect_error({
x |> ph_with("type okay but not available in layout", ph_location_type("tbl")) # tbl not on layout
ph_with(x, "type okay but not available in layout", ph_location_type("tbl")) # tbl not on layout
}, regexp = "Found no placeholder of type", fixed = TRUE)

expect_error({
x |> ph_with("xxx is unknown type", ph_location_type("xxx"))
ph_with(x, "xxx is unknown type", ph_location_type("xxx"))
}, regexp = 'type "xxx" is unknown', fixed = TRUE)

expect_no_error({ # for complete coverage
x |> ph_with(" ph type position_right", ph_location_type("body", position_right = TRUE))
ph_with(x, " ph type position_right", ph_location_type("body", position_right = TRUE))
})
})

Expand Down Expand Up @@ -416,11 +416,11 @@ test_that("pptx ph_location_id", {

# downstream errors
x <- read_pptx()
x <- x |> add_slide("Comparison")
x <- add_slide(x, "Comparison")

expect_error(
{
x |> ph_with("id does not exist", ph_location_id(id = 1000))
ph_with(x, "id does not exist", ph_location_id(id = 1000))
},
"`id` 1000 does not exist",
fixed = TRUE
Expand All @@ -430,7 +430,7 @@ test_that("pptx ph_location_id", {
expect_no_error({
ids <- layout_properties(x, "Comparison")$id
for (id in ids) {
x |> ph_with(paste("text:", id), ph_location_id(id, newlabel = paste("newlabel:", id)))
ph_with(x, paste("text:", id), ph_location_id(id, newlabel = paste("newlabel:", id)))
}
})
nodes <- xml_find_all(
Expand Down

0 comments on commit 92c7a32

Please sign in to comment.