622 hide slides (#622)

.github/workflows/R-CMD-check.yaml

@@ -5,6 +5,7 @@ on:
   pull_request:
     branches:
       - master
+  workflow_dispatch:
 
 name: R-CMD-check
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: officer
 Title: Manipulation of Microsoft Word and PowerPoint Documents
-Version: 0.6.8.003
+Version: 0.6.8.004
 Authors@R: c(
     person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")),
     person("Stefan", "Moog", , "moogs@gmx.de", role = "aut"),
@@ -65,3 +65,49 @@ Suggests:
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Collate: 
+    'core_properties.R'
+    'custom_properties.R'
+    'defunct.R'
+    'dev-utils.R'
+    'docx_add.R'
+    'docx_comments.R'
+    'docx_cursor.R'
+    'docx_part.R'
+    'docx_replace.R'
+    'docx_section.R'
+    'docx_settings.R'
+    'empty_content.R'
+    'formatting_properties.R'
+    'fortify_docx.R'
+    'fortify_pptx.R'
+    'knitr_utils.R'
+    'officer.R'
+    'ooxml.R'
+    'ooxml_block_objects.R'
+    'ooxml_run_objects.R'
+    'openxml_content_type.R'
+    'openxml_document.R'
+    'pack_folder.R'
+    'ph_location.R'
+    'post-proc.R'
+    'ppt_class_dir_collection.R'
+    'ppt_classes.R'
+    'ppt_notes.R'
+    'ppt_ph_dedupe_layout.R'
+    'ppt_ph_manipulate.R'
+    'ppt_ph_rename_layout.R'
+    'ppt_ph_with_methods.R'
+    'pptx_informations.R'
+    'pptx_layout_helper.R'
+    'pptx_matrix.R'
+    'utils.R'
+    'pptx_slide_manip.R'
+    'read_docx.R'
+    'read_docx_styles.R'
+    'read_pptx.R'
+    'read_xlsx.R'
+    'relationship.R'
+    'rtf.R'
+    'shape_properties.R'
+    'shorcuts.R'

NAMESPACE

@@ -162,6 +162,7 @@ S3method(update,fpar)
 S3method(update,sp_line)
 S3method(update,sp_lineend)
 export("layout_rename_ph_labels<-")
+export("slide_visible<-")
 export(add_sheet)
 export(add_slide)
 export(annotate_base)
@@ -301,6 +302,7 @@ export(sheet_select)
 export(shortcuts)
 export(slide_size)
 export(slide_summary)
+export(slide_visible)
 export(slip_in_column_break)
 export(slip_in_footnote)
 export(slip_in_seqfield)

NEWS.md

@@ -2,6 +2,7 @@
 
 ## Issues
 
+- Add `slide_visible()` to get and set the visibility of slides (#622).
 - debug selector for `ph_remove()` (see #625) that was not working 
 for rvg outputs.
 

R/pptx_slide_manip.R

@@ -1,3 +1,4 @@
+
 #' @export
 #' @title Add a slide
 #' @description Add a slide into a pptx presentation.
@@ -255,3 +256,84 @@ ensure_slide_index_exists <- function(x, slide_idx) {
     )
   }
 }
+
+
+# internal workhorse get/set slide visibility
+# x : rpptx object
+# slide_idx: id of slide
+# value: Use TRUE / FALSE to set visibility.
+.slide_visible <- function(x, slide_idx, value = NULL) {
+  stop_if_not_rpptx(x)
+  slide <- x$slide$get_slide(slide_idx)
+  slide_xml <- slide$get()
+  node <- xml2::xml_find_first(slide_xml, "/p:sld")
+  if (is.null(value)) {
+    value <- xml2::xml_attr(node, "show")
+    value <- as.logical(as.numeric(value))
+    ifelse(is.na(value), TRUE, value) # if show is not set, the slide is shown
+  } else {
+    stop_if_not_class(value, "logical", arg = "value")
+    xml2::xml_set_attr(node, "show", value = as.numeric(value))
+    slide$save()
+    invisible(x)
+  }
+}
+
+
+#' Get or set slide visibility
+#'
+#' PPTX slides can be visible or hidden. This function gets or sets the visibility of slides.
+#' @param x An `rpptx` object.
+#' @param value Boolean vector with slide visibilities.
+#' @rdname slide-visible
+#' @export
+#' @example inst/examples/example_slide_visible.R
+#' @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")
+  n_vals <- length(value)
+  n_slides <- length(x)
+  if (n_vals > n_slides) {
+    cli::cli_abort("More values ({.val {n_vals}}) than slides ({.val {n_slides}})")
+  }
+  if (n_vals != 1 && n_vals != n_slides) {
+    cli::cli_warn("Value is not length 1 or same length as number of slides ({.val {n_slides}}). Recycling values.")
+  }
+  value <- rep(value, length.out = n_slides)
+  for (i in seq_along(value)) {
+    .slide_visible(x, i, value[i])
+  }
+  invisible(x)
+}
+
+
+#' @param hide,show Indexes of slides to hide or show.
+#' @rdname slide-visible
+#' @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 {
+    x
+  }
+}

R/utils.R

@@ -334,6 +334,49 @@ stop_if_not_rpptx <- function(x, arg = NULL) {
   stop_if_not_class(x, "rpptx", arg)
 }
 
+
+stop_if_not_integerish <- function(x, arg = NULL) {
+  check <- is_integerish(x)
+  if (!check) {
+    msg_arg <- ifelse(is.null(arg), "Incorrect input.", "Incorrect input for {.arg {arg}}")
+    cli::cli_abort(c(
+      msg_arg,
+      "x" = "Expected integerish values but got {.cls {class(x)[1]}}"
+    ), call = NULL)
+  }
+}
+
+
+#' Ensure valid 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(
@@ -429,3 +472,13 @@ is_named <- function(x) {
 detect_void_name <- function(x) {
   x == "" | is.na(x)
 }
+
+
+# is_integerish(1)
+# is_integerish(1.0)
+# is_integerish(c(1.0, 2.0))
+is_integerish <- function(x) {
+  ii <- all(is.numeric(x) | is.integer(x))
+  jj <- all(x == as.integer(x))
+  ii && jj
+}

inst/examples/example_slide_visible.R

@@ -0,0 +1,17 @@
+path <- system.file("doc_examples/example.pptx", package = "officer")
+x <- read_pptx(path)
+
+slide_visible(x) # get slide visibilities
+
+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
+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
+

officer.Rproj

@@ -1,8 +1,9 @@
 Version: 1.0
+ProjectId: cf684f77-79cc-4641-8f83-6d6abc3f30bd
 
 RestoreWorkspace: No
 SaveWorkspace: No
-AlwaysSaveHistory: Default
+AlwaysSaveHistory: No
 
 EnableCodeIndexing: Yes
 UseSpacesForTab: Yes