diff --git a/R/ph_location.R b/R/ph_location.R index 0ab1f72c..8e7ca423 100644 --- a/R/ph_location.R +++ b/R/ph_location.R @@ -15,13 +15,18 @@ get_ph_loc <- function(x, layout, master, type, type_idx = NULL, position_right, props <- layout_properties(x, layout = layout, master = master) if (!is.null(ph_id)) { - ids <- sort(props$id) + ids <- sort(na.omit(as.numeric(props$id))) + if (length(ids) <= 20) { + .all_ids_switch <- c("x" = "Available ids: {.val {ids}}.") # only if few ids + } else { + .all_ids_switch <- NULL + } if (!ph_id %in% ids) { cli::cli_abort( c( - "{.arg id} does not exist.", - "x" = "Must be one of {.val {ids}}.", - "i" = cli::col_grey("see column {.val id} in {.code layout_properties(x, '{layout}', '{master}')}") + "{.arg id} {.val {ph_id}} does not exist.", + .all_ids_switch, + "i" = cli::col_grey("see column {.val id} in {.code layout_properties(..., '{layout}', '{master}')}") ), call = NULL ) @@ -576,6 +581,13 @@ fortify_location.location_right <- function( x, doc, ...){ ph_location_id <- function(id, newlabel = NULL, ...) { ph_id <- id # for disambiguation, store initial value + if (length(ph_id) > 1) { + cli::cli_abort( + c("{.arg id} must be {cli::style_underline('one')} number", + "x" = "Found more than one entry: {.val {ph_id}}" + ) + ) + } if (is.null(ph_id) || is.na(ph_id) || length(ph_id) == 0) { cli::cli_abort("{.arg id} must be a positive number") } @@ -589,13 +601,6 @@ ph_location_id <- function(id, newlabel = NULL, ...) { ) } } - if (length(ph_id) > 1) { - cli::cli_abort( - c("{.arg id} must be {cli::style_underline('one')} number", - "x" = "Found {.val {length(ph_id)}} numbers instead: {.val {ph_id}}" - ) - ) - } if (ph_id < 1) { cli::cli_abort( c("{.arg id} must be a {cli::style_underline('positive')} number", diff --git a/tests/testthat/test-pptx-add.R b/tests/testthat/test-pptx-add.R index a99a6b8a..79bbc63b 100644 --- a/tests/testthat/test-pptx-add.R +++ b/tests/testthat/test-pptx-add.R @@ -387,6 +387,64 @@ test_that("pptx ph_location_type", { }) +test_that("pptx ph_location_id", { + opts <- options(cli.num_colors = 1) # no colors for easier error message check + on.exit(options(opts)) + + # direct errors + error_exp <- "`id` must be one number" + expect_error(ph_location_id(id = 1:2), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = -1:1), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = c("A", "B")), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = c(NA, NA)), regex = error_exp, fixed = TRUE) + + error_exp <- "`id` must be a positive number" + expect_error(ph_location_id(id = NULL), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = NA), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = NaN), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = character(0)), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = integer(0)), regex = error_exp, fixed = TRUE) + + expect_error(ph_location_id(id = "A"), regex = 'Cannot convert "A" to integer', fixed = TRUE) + expect_error(ph_location_id(id = ""), regex = 'Cannot convert "" to integer', fixed = TRUE) + expect_error(ph_location_id(id = Inf), regex = "Cannot convert Inf to integer", fixed = TRUE) + expect_error(ph_location_id(id = -Inf), regex = "Cannot convert -Inf to integer", fixed = TRUE) + + error_exp <- "`id` must be a positive number" + expect_error(ph_location_id(id = 0), regex = error_exp, fixed = TRUE) + expect_error(ph_location_id(id = -1), regex = error_exp, fixed = TRUE) + + # downstream errors + x <- read_pptx() + x <- x |> add_slide("Comparison") + + expect_error( + { + x |> ph_with("id does not exist", ph_location_id(id = 1000)) + }, + "`id` 1000 does not exist", + fixed = TRUE + ) + + # test for correct results + 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))) + } + }) + nodes <- xml_find_all( + x = x$slide$get_slide(1)$get(), + xpath = "/p:sld/p:cSld/p:spTree/p:sp" + ) + # text inside phs + expect_true(all(xml_text(nodes) == paste("text:", ids))) + # assigned shape names + all_nvpr <- xml_find_all(nodes, "./p:nvSpPr/p:cNvPr") + expect_true(all(xml_attr(all_nvpr, "name") == paste("newlabel:", ids))) +}) + + test_that("pptx ph labels", { doc <- read_pptx() doc <- add_slide(doc, "Title and Content", "Office Theme") @@ -429,6 +487,7 @@ test_that("pptx ph labels", { }) + test_that("as_ph_location", { ref_names <- c("width", "height", "left", "top", "ph_label", "ph", "type", "rotation", "fld_id", "fld_type") l <- replicate(length(ref_names), "dummy", simplify = FALSE)