Allow avoiding de-duplication in xml_parent

Author: jimhester

NEWS.md

@@ -1,5 +1,7 @@
 # xml2 (development version)
 
+* `xml_parent()` now supports passing `deduplicate = TRUE` to avoid de-duplication of nodes in the returned nodeset.
+
 * `xml_find_all.xml_nodeset()` gains a `flatten` argument to control whether to return a single nodeset or a list of nodesets (#311, @jakejh)
 
 * `write_xml()` and `write_html()` now return NULL invisibly, as they did prior to version 1.3.0 (#307)

R/classes.R

@@ -81,10 +81,10 @@ xml_nodeset <- function(nodes = list(), deduplicate = TRUE) {
 #' @param nodes A list (possible nested) of external pointers to nodes
 #' @return a nodeset
 #' @noRd
-make_nodeset <- function(nodes, doc) {
+make_nodeset <- function(nodes, doc, ...) {
   nodes <- unlist(nodes, recursive = FALSE)
 
-  xml_nodeset(lapply(nodes, xml_node, doc = doc))
+  xml_nodeset(lapply(nodes, xml_node, doc = doc), ...)
 }
 
 #' @export
@@ -147,7 +147,7 @@ nodeset_apply.xml_missing <- function(x, fun, ...) {
 }
 
 #' @export
-nodeset_apply.xml_nodeset <- function(x, fun, ...) {
+nodeset_apply.xml_nodeset <- function(x, fun, ..., deduplicate = TRUE) {
   if (length(x) == 0)
     return(xml_nodeset())
 
@@ -159,7 +159,7 @@ nodeset_apply.xml_nodeset <- function(x, fun, ...) {
     res[!is_missing] <- lapply(x[!is_missing], function(x) fun(x$node, ...))
   }
 
-  make_nodeset(res, x[[1]]$doc)
+  make_nodeset(res, x[[1]]$doc, deduplicate = deduplicate)
 }
 
 #' @export

R/xml_children.R

@@ -13,6 +13,7 @@
 #' @param search For `xml_child`, either the child number to return (by
 #'   position), or the name of the child node to return. If there are multiple
 #'   child nodes with the same name, the first will be returned
+#' @param ... Additional options passed to internal functions.
 #' @return A node or nodeset (possibly empty). Results are always de-duplicated.
 #' @export
 #' @examples
@@ -24,6 +25,9 @@
 #' # Note the each unique node only appears once in the output
 #' xml_parent(xml_children(x))
 #'
+#' # But you avoid this deduplication if needed
+#' xml_parent(xml_children(x), deduplicate = FALSE)
+#'
 #' # Mixed content
 #' x <- read_xml("<foo> a <b/> c <d>e</d> f</foo>")
 #' # Childen gets the elements, contents gets all node types
@@ -37,8 +41,8 @@
 #' xml_child(x)
 #' xml_child(x, 2)
 #' xml_child(x, "baz")
-xml_children <- function(x) {
-  nodeset_apply(x, function(x) .Call(node_children, x, TRUE))
+xml_children <- function(x, ...) {
+  nodeset_apply(x, function(x) .Call(node_children, x, TRUE), ...)
 }
 
 #' @export
@@ -65,8 +69,8 @@ xml_contents <- function(x) {
 
 #' @export
 #' @rdname xml_children
-xml_parents <- function(x) {
-  nodeset_apply(x, function(x) .Call(node_parents, x))
+xml_parents <- function(x, ...) {
+  nodeset_apply(x, function(x) .Call(node_parents, x), ...)
 }
 
 #' @export
@@ -77,23 +81,23 @@ xml_siblings <- function(x) {
 
 #' @export
 #' @rdname xml_children
-xml_parent <- function(x) {
+xml_parent <- function(x, ...) {
   UseMethod("xml_parent")
 }
 
 #' @export
-xml_parent.xml_missing <- function(x) {
+xml_parent.xml_missing <- function(x, ...) {
   xml_missing()
 }
 
 #' @export
-xml_parent.xml_node <- function(x) {
+xml_parent.xml_node <- function(x, ...) {
   xml_node(.Call(node_parent, x$node), x$doc)
 }
 
 #' @export
-xml_parent.xml_nodeset <- function(x) {
-  nodeset_apply(x, function(x) .Call(node_parent, x))
+xml_parent.xml_nodeset <- function(x, ...) {
+  nodeset_apply(x, function(x) .Call(node_parent, x), ...)
 }