fix: change get_shape_id() return

- in addition, force uuid in new shape so that it is used by `get_shape_id()`

fix #535

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: officer
 Type: Package
 Title: Manipulation of Microsoft Word and PowerPoint Documents
-Version: 0.6.4.005
+Version: 0.6.4.006
 Authors@R: c(
     person("David", "Gohel", role = c("aut", "cre"), email = "david.gohel@ardata.fr"),
     person("Stefan", "Moog", role = "aut", email = 'moogs@gmx.de'),

NEWS.md

@@ -19,6 +19,8 @@ The docs gain a description of the columns of the returned dataframe.
 multiple paragraphs, multiple comments in the same paragraph and replies. Closes #541.
 - Check and stop if `fp_text_lite()` is using a *shading.color* but no *color*.
 - Check used style in `body_add_caption()`.
+- fix `ph_remove()`, `ph_slidelink()` and `ph_hyperlink()` that were not working since
+the latest refactoring.
 - Use fake attribute `stlname` if available in `docx_summary()`.
 
 # officer 0.6.3

R/ooxml_block_objects.R

@@ -779,10 +779,10 @@ to_pml.block_table <- function(x, add_ns = FALSE,
                         tcf = x$properties$tcf,
                         header = x$header )
 
-
+  id <- uuid_generate()
   str <- paste0("<p:graphicFrame xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">",
                 "<p:nvGraphicFramePr>",
-                sprintf("<p:cNvPr id=\"0\" name=\"%s\"/>", label),
+                sprintf("<p:cNvPr id=\"%s\" name=\"%s\"/>", id, label),
                 "<p:cNvGraphicFramePr><a:graphicFrameLocks noGrp=\"1\"/></p:cNvGraphicFramePr>",
                 sprintf("<p:nvPr>%s</p:nvPr>", ph),
                 "</p:nvGraphicFramePr>",

R/ooxml_run_objects.R

@@ -1065,18 +1065,19 @@ to_pml.external_img <- function(x, add_ns = FALSE,
     ph = "<p:ph/>"
   }
   blipfill <- temp_blipfill(x, ns = "p")
+  id <- uuid_generate()
   str <- "
 <p:pic xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">
   <p:nvPicPr>
-    <p:cNvPr id=\"0\" name=\"%s\" descr=\"%s\"/>
+    <p:cNvPr id=\"%s\" name=\"%s\" descr=\"%s\"/>
     <p:cNvPicPr><a:picLocks noGrp=\"1\"/></p:cNvPicPr>
     <p:nvPr>%s</p:nvPr>
   </p:nvPicPr>
   %s
   <p:spPr>%s<a:prstGeom prst=\"rect\"><a:avLst/></a:prstGeom>%s%s</p:spPr>
 </p:pic>
 "
-  sprintf(str, label, attr(x, "alt"), ph, blipfill, xfrm_str, bg_str, ln_str)
+  sprintf(str, id, label, attr(x, "alt"), ph, blipfill, xfrm_str, bg_str, ln_str)
 
 }
 

R/ppt_notes.R

@@ -143,8 +143,10 @@ ph_from_location.location_label <- function(loc, doc, ...) {
   xfrm <- doc$notesMaster$xfrm()
   location <- xfrm[xfrm$ph_label == loc$ph_label, ]
   if (nrow(location) < 1) stop("No placeholder with label ", loc$ph_label, " found!")
-  str <- "<p:nvSpPr><p:cNvPr id=\"0\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr/>"
-  new_ph <- sprintf(str, location$ph_label, location$ph)
+
+  id <- uuid_generate()
+  str <- "<p:nvSpPr><p:cNvPr id=\"%s\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr/>"
+  new_ph <- sprintf(str, id, location$ph_label, location$ph)
   return(list(ph = new_ph, label = location$ph_label))
 }
 
@@ -153,8 +155,10 @@ ph_from_location.location_type <- function(loc, doc, ...) {
   xfrm <- doc$notesMaster$xfrm()
   location <- xfrm[xfrm$type == loc$type, ]
   if (nrow(location) < 1) stop("No placeholder of type ", loc$type, " found!")
-  str <- "<p:nvSpPr><p:cNvPr id=\"0\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr/>"
-  new_ph <- sprintf(str, location$ph_label[1], location$ph[1])
+
+  id <- uuid_generate()
+  str <- "<p:nvSpPr><p:cNvPr id=\"%s\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr/>"
+  new_ph <- sprintf(str, id, location$ph_label[1], location$ph[1])
   return(list(ph = new_ph, label = location$ph_label[1]))
 }
 

R/ppt_ph_manipulate.R

@@ -1,18 +1,18 @@
-get_shape_id <- function(x, type = NULL, id = NULL, ph_label = NULL ){
+get_shape_id <- function(x, type = NULL, id = NULL, ph_label = NULL) {
   slsmry <- slide_summary(x)
 
-  if( is.null(ph_label) ){
-    sel <- which( slsmry$type %in% type )
-    if( length(sel) < 1 ) stop("no shape of type ", shQuote(type), " has been found")
+  if (is.null(ph_label)) {
+    sel <- which(slsmry$type %in% type)
+    if (length(sel) < 1) stop("no shape of type ", shQuote(type), " has been found")
     sel <- sel[id]
-    if( sum(is.finite(sel)) != 1 ) stop("no shape of type ", shQuote(type), " and with id ", id, " has been found")
+    if (sum(is.finite(sel)) != 1) stop("no shape of type ", shQuote(type), " and with id ", id, " has been found")
   } else {
-    sel <- which( slsmry$ph_label %in% ph_label )
-    if( length(sel) < 1 ) stop("no shape with label ", shQuote(ph_label), " has been found")
+    sel <- which(slsmry$ph_label %in% ph_label)
+    if (length(sel) < 1) stop("no shape with label ", shQuote(ph_label), " has been found")
     sel <- sel[id]
-    if( sum(is.finite(sel)) != 1 ) stop("no shape with label ", shQuote(ph_label), "and with id ", id, " has been found")
+    if (sum(is.finite(sel)) != 1) stop("no shape with label ", shQuote(ph_label), "and with id ", id, " has been found")
   }
-  sel
+  slsmry$id[sel]
 }
 
 
@@ -32,20 +32,29 @@ get_shape_id <- function(x, type = NULL, id = NULL, ph_label = NULL ){
 #' @param id_chr deprecated.
 #' @examples
 #' fileout <- tempfile(fileext = ".pptx")
-#' dummy_fun <- function(doc){
-#'   doc <- add_slide(doc, layout = "Two Content",
-#'     master = "Office Theme")
-#'   doc <- ph_with(x = doc, value = "Un titre",
-#'     location = ph_location_type(type = "title"))
-#'   doc <- ph_with(x = doc, value = "Un corps 1",
-#'     location = ph_location_type(type = "body", id = 1))
-#'   doc <- ph_with(x = doc, value = "Un corps 2",
-#'     location = ph_location_type(type = "body", id = 2))
+#' dummy_fun <- function(doc) {
+#'   doc <- add_slide(doc,
+#'     layout = "Two Content",
+#'     master = "Office Theme"
+#'   )
+#'   doc <- ph_with(
+#'     x = doc, value = "Un titre",
+#'     location = ph_location_type(type = "title")
+#'   )
+#'   doc <- ph_with(
+#'     x = doc, value = "Un corps 1",
+#'     location = ph_location_type(type = "body", id = 1)
+#'   )
+#'   doc <- ph_with(
+#'     x = doc, value = "Un corps 2",
+#'     location = ph_location_type(type = "body", id = 2)
+#'   )
 #'   doc
 #' }
 #' doc <- read_pptx()
-#' for(i in 1:3)
+#' for (i in 1:3) {
 #'   doc <- dummy_fun(doc)
+#' }
 #'
 #' doc <- on_slide(doc, index = 1)
 #' doc <- ph_remove(x = doc, type = "title")
@@ -56,15 +65,13 @@ get_shape_id <- function(x, type = NULL, id = NULL, ph_label = NULL ){
 #' doc <- on_slide(doc, index = 3)
 #' doc <- ph_remove(x = doc, type = "body", id = 1)
 #'
-#' print(doc, target = fileout )
+#' print(doc, target = fileout)
 #' @family functions for placeholders manipulation
 #' @seealso \code{\link{ph_with}}
-ph_remove <- function( x, type = "body", id = 1, ph_label = NULL, id_chr = NULL ){
-
+ph_remove <- function(x, type = "body", id = 1, ph_label = NULL, id_chr = NULL) {
   slide <- x$slide$get_slide(x$cursor)
-  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label )
-  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr][%.0f]", office_id) )
-
+  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label)
+  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr[@id='%s']]", office_id))
   xml_remove(current_elt)
 
   x
@@ -89,26 +96,25 @@ ph_remove <- function( x, type = "body", id = 1, ph_label = NULL, id_chr = NULL
 #' slide_summary(doc) # read column ph_label here
 #' doc <- ph_slidelink(x = doc, ph_label = "Title 1", slide_index = 2)
 #'
-#' print(doc, target = fileout )
+#' print(doc, target = fileout)
 #' @family functions for placeholders manipulation
 #' @seealso \code{\link{ph_with}}
-ph_slidelink <- function( x, type = "body", id = 1, id_chr = NULL, ph_label = NULL, slide_index){
-
+ph_slidelink <- function(x, type = "body", id = 1, id_chr = NULL, ph_label = NULL, slide_index) {
   slide <- x$slide$get_slide(x$cursor)
-  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label )
-  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr][%.0f]", office_id) )
+  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label)
+  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr[@id='%s']]", office_id))
 
   # declare slide ref in relationships
   slide_name <- x$slide$names()[slide_index]
   slide$reference_slide(slide_name)
   rel_df <- slide$rel_df()
-  id <- rel_df[rel_df$target == slide_name, "id" ]
+  id <- rel_df[rel_df$target == slide_name, "id"]
 
   # add hlinkClick
   cnvpr <- xml_child(current_elt, "p:nvSpPr/p:cNvPr")
   str_ <- "<a:hlinkClick xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"%s\" action=\"ppaction://hlinksldjump\"/>"
   str_ <- sprintf(str_, id)
-  xml_add_child(cnvpr, as_xml_document(str_) )
+  xml_add_child(cnvpr, as_xml_document(str_))
 
   x
 }
@@ -121,28 +127,28 @@ ph_slidelink <- function( x, type = "body", id = 1, id_chr = NULL, ph_label = NU
 #' @param href hyperlink (do not forget http or https prefix)
 #' @examples
 #' fileout <- tempfile(fileext = ".pptx")
-#' loc_manual <- ph_location(bg = "red", newlabel= "mytitle")
+#' loc_manual <- ph_location(bg = "red", newlabel = "mytitle")
 #' doc <- read_pptx()
 #' doc <- add_slide(doc)
 #' doc <- ph_with(x = doc, "Un titre 1", location = loc_manual)
 #' slide_summary(doc) # read column ph_label here
-#' doc <- ph_hyperlink(x = doc, ph_label = "mytitle",
-#'   href = "https://cran.r-project.org")
+#' doc <- ph_hyperlink(
+#'   x = doc, ph_label = "mytitle",
+#'   href = "https://cran.r-project.org"
+#' )
 #'
-#' print(doc, target = fileout )
+#' print(doc, target = fileout)
 #' @family functions for placeholders manipulation
 #' @seealso \code{\link{ph_with}}
-ph_hyperlink <- function( x, type = "body", id = 1, id_chr = NULL, ph_label = NULL, href ){
-
+ph_hyperlink <- function(x, type = "body", id = 1, id_chr = NULL, ph_label = NULL, href) {
   slide <- x$slide$get_slide(x$cursor)
-  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label )
-  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr][%.0f]", office_id) )
+  office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label)
+  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr[@id='%s']]", office_id))
 
   # add hlinkClick
   cnvpr <- xml_child(current_elt, "p:nvSpPr/p:cNvPr")
   str_ <- "<a:hlinkClick xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"%s\"/>"
   str_ <- sprintf(str_, href)
-  xml_add_child(cnvpr, as_xml_document(str_) )
+  xml_add_child(cnvpr, as_xml_document(str_))
   x
 }
-

R/pptx_slide_manip.R

@@ -180,8 +180,8 @@ pptx_fortify_slides <- function(x) {
     process_links(slide, type = "pml")
 
     cnvpr <- xml_find_all(slide$get(), "//p:cNvPr")
-    for(i in seq_along(cnvpr)){
-      xml_attr( cnvpr[[i]], "id") <- i
+    for (i in seq_along(cnvpr)) {
+      xml_attr(cnvpr[[i]], "id") <- i
     }
   }
 
@@ -219,7 +219,9 @@ shape_properties_tags <- function(left = 0, top = 0, width = 3, height = 3,
     ph <- "<p:ph/>"
   }
 
-  str <- "<p:nvSpPr><p:cNvPr id=\"0\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr>%s%s%s%s</p:spPr>"
+  randomid <- officer::uuid_generate()
 
-  sprintf(str, label, ph, xfrm_str, geom_str, bg_str, ln_str)
+  str <- "<p:nvSpPr><p:cNvPr id=\"%s\" name=\"%s\"/><p:cNvSpPr><a:spLocks noGrp=\"1\"/></p:cNvSpPr><p:nvPr>%s</p:nvPr></p:nvSpPr><p:spPr>%s%s%s%s</p:spPr>"
+
+  sprintf(str, randomid, label, ph, xfrm_str, geom_str, bg_str, ln_str)
 }

tests/testthat/test-pptx-selections.R

@@ -46,8 +46,8 @@ test_that("get shape id", {
   doc <- ph_with(doc, "hello", location = ph_location_type(type = "body"))
   file <- print(doc, target = tempfile(fileext = ".pptx"))
   doc <- read_pptx(file)
-  expect_equal(officer:::get_shape_id(doc, type = "body", id = 1), 1)
-  expect_equal(officer:::get_shape_id(doc, ph_label = "Content Placeholder 2", id = 1), 1)
+  expect_equal(officer:::get_shape_id(doc, type = "body", id = 1), "2")
+  expect_equal(officer:::get_shape_id(doc, ph_label = "Content Placeholder 2", id = 1), "2")
   expect_error(officer:::get_shape_id(doc, type = "body", id = 4) )
 })