fix: consistent use of term id across layout_properties(), ph_locat…

…ion_type(), plot_layout_properties()

DESCRIPTION

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

NEWS.md

@@ -18,6 +18,10 @@ top to bottom and left to right.
 - `ph_location_type()` now throws an error if the `id` for a `type` is out of range (#602) and a more 
 informative error message if the type is not present in layout (#601).
 - `plot_layout_properties()` assignment order fixed for `labels= FALSE` (#604)
+- `layout_properties()` gains a `type_idx` column to index phs of the same type on a layout. Indexing is performed based on ph position, following a top-to-bottom, left-to-right order. (#606).
+- `plot_layout_properties()` plots more information by default now: layout name, ph label, ph id, ph type + index by default (#606).
+- `ph_location_type()`: new `type_idx` arg replaces the deprecated `id` arg (#606).
+
 
 ## Features
 

R/ph_location.R

@@ -1,4 +1,7 @@
-get_ph_loc <- function(x, layout, master, type, position_right, position_top, id = NULL) {
+
+# id is deprecated and replaced by type_idx. Will be removed soon
+get_ph_loc <- function(x, layout, master, type, type_idx = NULL, position_right, position_top,
+                       id = NULL, ph_id = NULL) {
   props <- layout_properties(x, layout = layout, master = master)
   types_on_layout <- unique(props$type)
   props <- props[props$type %in% type, , drop = FALSE]
@@ -10,7 +13,7 @@ get_ph_loc <- function(x, layout, master, type, position_right, position_top, id
       "i" = cli::col_grey("see {.code layout_properties(x, '{layout}', '{master}')}")
     ), call = NULL)
   }
-
+  # id and type_idx are both used for now. 'id' is deprecated. The following code block can be removed in the future.
   if (!is.null(id)) {
     if (!id %in% 1L:nr) {
       cli::cli_abort(
@@ -22,7 +25,23 @@ get_ph_loc <- function(x, layout, master, type, position_right, position_top, id
         call = NULL
       )
     }
-    props <- props[id, , drop = FALSE]
+    # the ordering of 'type_idx' (top->bottom, left-righ) is different than for the 'id' arg (index
+    # along the id colomn). Here, we restore the old ordering, to avoid a breaking change.
+    props <- props[order(props$type, as.integer(props$id)), ] # set order for type idx. Removing the line would result in the default layout properties order, i.e., top->bottom left->right.
+    props$.id <- stats::ave(props$type, props$master_name, props$name, props$type, FUN = seq_along)
+    props <- props[props$.id == id, , drop = FALSE]
+  } else if (!is.null(type_idx)) {
+    if (!type_idx %in% props$type_idx) {
+      cli::cli_abort(
+        c(
+          "{.arg type_idx} is out of range.",
+          "x" = "Must be between {.val {1L}} and {.val {max(props$type_idx)}} for ph type {.val {type}}.",
+          "i" = cli::col_grey("see {.code layout_properties(..., layout = '{layout}', master = '{master}')} for indexes of type '{type}'")
+        ),
+        call = NULL
+      )
+    }
+    props <- props[props$type_idx == type_idx, , drop = FALSE]
   } else {
     if (position_right) {
       props <- props[props$offx + 0.0001 > max(props$offx), ]
@@ -45,20 +64,24 @@ get_ph_loc <- function(x, layout, master, type, position_right, position_top, id
 }
 
 
-as_ph_location <- function(x, ...){
-  if( !is.data.frame(x) ){
-    stop("x should be a data.frame")
+as_ph_location <- function(x, ...) {
+  if (!is.data.frame(x)) {
+    cli::cli_abort(
+      c("{.arg x} must be a data frame.",
+        "x" =  "You provided {.cls {class(x)[1]}} instead.")
+      )
   }
-  ref_names <- c( "width", "height", "left", "top",
-                  "ph_label", "ph", "type", "rotation", "fld_id", "fld_type")
-  if (!all(is.element(ref_names, names(x) ))) {
+  ref_names <- c(
+    "width", "height", "left", "top", "ph_label", "ph", "type", "rotation", "fld_id", "fld_type"
+  )
+  if (!all(is.element(ref_names, names(x)))) {
     stop("missing column values:", paste0(setdiff(ref_names, names(x)), collapse = ","))
   }
-
   out <- x[ref_names]
   as.list(out)
 }
 
+
 #' @export
 #' @title Eval a location on the current slide
 #' @description Eval a shape location against the current slide.
@@ -197,6 +220,7 @@ fortify_location.location_template <- function( x, doc, ...){
   fortify_location.location_manual(x)
 }
 
+
 #' @export
 #' @title Location of a placeholder based on a type
 #' @description The function will use the type name of the placeholder (e.g. body, title),
@@ -206,14 +230,20 @@ fortify_location.location_template <- function( x, doc, ...){
 #' @param position_right the parameter is used when a selection with above
 #' parameters does not provide a unique position (for example
 #' layout 'Two Content' contains two element of type 'body').
-#' If \code{TRUE}, the element the most on the right side will be selected,
+#' If `TRUE`, the element the most on the right side will be selected,
 #' otherwise the element the most on the left side will be selected.
-#' @param position_top same than \code{position_right} but applied
+#' @param position_top same than `position_right` but applied
 #' to top versus bottom.
-#' @param id index of the placeholder. If two body placeholder, there can be
-#' two different index: 1 and 2 for the first and second body placeholders defined
-#' in the layout. If this argument is used, \code{position_right} and \code{position_top}
-#' will be ignored.
+#' @param type_idx Type index of the placeholder. If there is more than one
+#' placeholder of a type (e.g., `body`), the type index can be supplied to uniquely
+#' identify a ph. The index is a running number starting at 1. It is assigned by
+#' placeholder position  (top -> bottom, left -> right). See [plot_layout_properties()]
+#' for details. If `idx` argument is used, `position_right` and `position_top`
+#' are ignored.
+#' @param id (**DEPRECATED, use `type_idx` instead**) Index of the placeholder.
+#' If two body placeholder, there can be two different index: 1 and 2 for the
+#' first and second body placeholders defined in the layout. If this argument
+#' is used, `position_right` and `position_top` will be ignored.
 #' @param newlabel a label to associate with the placeholder.
 #' @param ... unused arguments
 #' @family functions for placeholder location
@@ -244,7 +274,23 @@ fortify_location.location_template <- function( x, doc, ...){
 #'
 #' fileout <- tempfile(fileext = ".pptx")
 #' print(doc, target = fileout)
-ph_location_type <- function(type = "body", position_right = TRUE, position_top = TRUE, newlabel = NULL, id = NULL, ...) {
+#'
+ph_location_type <- function(type = "body", type_idx = NULL, position_right = TRUE, position_top = TRUE,
+                             newlabel = NULL, id = NULL, ...) {
+  # the following two warnings can be deleted after the deprecated id arg is removed.
+  if (!is.null(id) && !is.null(type_idx)) {
+    cli::cli_warn("{.arg id} is ignored if {.arg type_idx} is provided ")
+  }
+  if (!is.null(id) && is.null(type_idx)) {
+    cli::cli_warn(
+      c(
+        "!" = "The {.arg id} argument in {.fn ph_location_type} is deprecated as of {.pkg officer} 0.6.7.",
+        "i" = "Please use the {.arg type_idx} argument instead.",
+        "x" = cli::col_red("Caution: new index logic in {.arg type_idx} (see docs).")
+      )
+    )
+  }
+
   ph_types <- c(
     "ctrTitle", "subTitle", "dt", "ftr", "sldNum", "title", "body",
     "pic", "chart", "tbl", "dgm", "media", "clipArt"
@@ -257,30 +303,39 @@ ph_location_type <- function(type = "body", position_right = TRUE, position_top
       call = NULL
     )
   }
-  x <- list(type = type, position_right = position_right, position_top = position_top, id = id, label = newlabel)
+  x <- list(
+    type = type, type_idx = type_idx, position_right = position_right,
+    position_top = position_top, id = id, label = newlabel
+  )
   class(x) <- c("location_type", "location_str")
   x
 }
 
 
 #' @export
-fortify_location.location_type <- function( x, doc, ...){
-
+fortify_location.location_type <- function(x, doc, ...) {
   slide <- doc$slide$get_slide(doc$cursor)
   xfrm <- slide$get_xfrm()
   args <- list(...)
 
-  layout <- ifelse(is.null(args$layout), unique( xfrm$name ), args$layout)
-  master <- ifelse(is.null(args$master), unique( xfrm$master_name ), args$master)
-  out <- get_ph_loc(doc, layout = layout, master = master,
-             type = x$type, position_right = x$position_right,
-             position_top = x$position_top, id = x$id)
-  if( !is.null(x$label) )
+  layout <- ifelse(is.null(args$layout), unique(xfrm$name), args$layout)
+  master <- ifelse(is.null(args$master), unique(xfrm$master_name), args$master)
+
+  # to avoid a breaking change, the deprecated id is passed along.
+  # As type_idx uses a different index order than id, this is necessary until the id arg is removed.
+  out <- get_ph_loc(doc,
+    layout = layout, master = master,
+    type = x$type, position_right = x$position_right,
+    position_top = x$position_top, type_idx = x$type_idx,
+    id = x$id, ph_id = NULL # id is deprecated and will be removed soon
+  )
+  if (!is.null(x$label)) {
     out$ph_label <- x$label
+  }
   out
-
 }
 
+
 #' @export
 #' @title Location of a named placeholder
 #' @description The function will use the label of a placeholder
@@ -314,6 +369,7 @@ ph_location_label <- function( ph_label, newlabel = NULL, ...){
   x
 }
 
+
 #' @export
 fortify_location.location_label <- function( x, doc, ...){
 
@@ -345,6 +401,7 @@ fortify_location.location_label <- function( x, doc, ...){
 
 }
 
+
 #' @export
 #' @title Location of a full size element
 #' @description The function will return the location corresponding

R/ppt_class_dir_collection.R

@@ -7,7 +7,7 @@ dir_collection <- R6Class(
       dir_ <- file.path(package_dir, container$dir_name())
       private$package_dir <- package_dir
       filenames <- list.files(path = dir_, pattern = "\\.xml$", full.names = TRUE)
-      filenames <- sort_vec_by_index(filenames)  # see issue 596
+      filenames <- sort_vec_by_index(filenames)  # see issue #596
       private$collection <- lapply( filenames, function(x, container){
         container$clone()$feed(x)
       }, container = container)