better and more checks for slide_visible()

R/pptx_slide_manip.R

@@ -288,7 +288,7 @@ ensure_slide_index_exists <- function(x, slide_idx) {
 #' @rdname slide-visible
 #' @export
 #' @example inst/examples/example_slide_visible.R
-#' @return Boolean vector with slide visibilities.
+#' @return Boolean vector with slide visibilities or `rpptx` object if changes are made to the object.
 `slide_visible<-` <- function(x, value) {
   stop_if_not_rpptx(x)
   stop_if_not_class(value, "logical", arg = "value")
@@ -313,19 +313,27 @@ ensure_slide_index_exists <- function(x, slide_idx) {
 #' @export
 slide_visible <- function(x, hide = NULL, show = NULL) {
   stop_if_not_rpptx(x)
+  idx_in_both <- intersect(as.integer(hide), as.integer(show))
+  if (length(idx_in_both) > 1) {
+    cli::cli_abort(
+      "Overlap between indexes in {.arg hide} and {.arg show}: {.val {idx_in_both}}",
+      "x" = "Indexes must be mutually exclusive.")
+  }
   if (!is.null(hide)) {
     stop_if_not_integerish(hide, "hide")
+    stop_if_not_in_slide_range(x, hide, arg = "hide")
     slide_visible(x)[hide] <- FALSE
   }
   if (!is.null(show)) {
     stop_if_not_integerish(show, "show")
+    stop_if_not_in_slide_range(x, show, arg = "show")
     slide_visible(x)[show] <- TRUE
   }
   n_slides <- length(x)
   res <- vapply(seq_len(n_slides), function(idx) .slide_visible(x, idx), logical(1))
   if (is.null(hide) && is.null(show)) {
     res
   } else {
-    invisible(res)
+    x
   }
 }

R/utils.R

@@ -347,6 +347,36 @@ stop_if_not_integerish <- function(x, arg = NULL) {
 }
 
 
+#' Check slide indexes
+#'
+#' @param x An `rpptx` object.
+#' @param idx Slide indexes.
+#' @param arg Name of argument to use in error message (optional).
+#' @param call Environment to display in error message-. Defaults to caller env.
+#'   Set `NULL` to suppress (see [cli::cli_abort]).
+#' @keywords internal
+stop_if_not_in_slide_range <- function(x, idx, arg = NULL, call = parent.frame()) {
+  stop_if_not_rpptx(x)
+  stop_if_not_integerish(idx)
+
+  n_slides <- length(x)
+  idx_available <- seq_len(n_slides)
+  idx_outside <- setdiff(idx, idx_available)
+  n_outside <- length(idx_outside)
+
+  if (n_outside == 0) {
+    return(invisible(NULL))
+  }
+  argname <- ifelse(is.null(arg), "", " of {.arg {arg}} ")
+  part_1 <- paste0("{n_outside} index{?es}", argname, "outside slide range: {.val {idx_outside}}")
+  part_2 <- ifelse(n_slides == 0,
+    "Presentation has no slides!",
+    "Slide indexes must be in the range [{min(idx_available)}..{max(idx_available)}]"
+  )
+  cli::cli_abort(c(part_1, "x" = part_2), call = call)
+}
+
+
 check_unit <- function(unit, choices, several.ok = FALSE) {
   if (!several.ok && length(unit) != 1) {
     cli::cli_abort(

inst/examples/example_slide_visible.R

@@ -1,11 +1,11 @@
 path <- system.file("doc_examples/example.pptx", package = "officer")
 x <- read_pptx(path)
 
-slide_visible(x) # get slide visibility
+slide_visible(x) # get slide visibilities
 
-slide_visible(x, hide = 1:2) # hide slides 1 and 2
-slide_visible(x, show = 1:2) # make slides 1 and 2 visible
-slide_visible(x, show = 1:2, hide = 3)
+x <- slide_visible(x, hide = 1:2) # hide slides 1 and 2
+x <- slide_visible(x, show = 1:2) # make slides 1 and 2 visible
+x <- slide_visible(x, show = 1:2, hide = 3)
 
 slide_visible(x) <- FALSE # hide all slides
 slide_visible(x) <- c(TRUE, FALSE, TRUE) # set each slide separately
@@ -14,3 +14,4 @@ slide_visible(x) <- c(TRUE, FALSE) # warns that rhs values are recycled
 slide_visible(x)[2] <- TRUE # set 2nd slide to visible
 slide_visible(x)[c(1, 3)] <- FALSE # 1st and 3rd slide
 slide_visible(x)[c(1, 3)] <- c(FALSE, FALSE) # identical
+

tests/testthat/test-pptx-misc.R

@@ -118,10 +118,10 @@ test_that("no master do not generate an error", {
 })
 
 
-
 unlink("*.pptx")
 unlink("*.emf")
 
+
 test_that("slide_visible", {
   opts <- options(cli.num_colors = 1) # suppress colors for error message check
   on.exit(options(opts))
@@ -133,13 +133,29 @@ test_that("slide_visible", {
   x <- read_pptx(path)
 
   expect_equal(slide_visible(x), c(FALSE, TRUE, FALSE))
-  slide_visible(x, hide = 1:2)
+  x <- slide_visible(x, hide = 1:2)
+  expect_s3_class(x, "rpptx")
   expect_equal(slide_visible(x), c(FALSE, FALSE, FALSE))
-  slide_visible(x, show = 1:2)
+  x <- slide_visible(x, show = 1:2)
+  expect_s3_class(x, "rpptx")
   expect_equal(slide_visible(x), c(TRUE, TRUE, FALSE))
-  slide_visible(x, hide = 1:2, show = 3)
+  x <- slide_visible(x, hide = 1:2, show = 3)
+  expect_s3_class(x, "rpptx")
   expect_equal(slide_visible(x), c(FALSE, FALSE, TRUE))
 
+  expect_error(
+    regex = "Overlap between indexes in `hide` and `show`",
+    slide_visible(x, hide = 1:2, show = 1:2)
+  )
+  expect_error(
+    regex = "2 indexes of `hide` outside slide range",
+    slide_visible(x, hide = 1:5)
+  )
+  expect_error(
+    regex = "1 index of `show` outside slide range",
+    slide_visible(x, show = -1)
+  )
+
   slide_visible(x) <- FALSE # hide all slides
   expect_false(any(slide_visible(x)))
   slide_visible(x) <- c(TRUE, FALSE, TRUE)