for #237

Author: Jordan S Read

R/embedded-functions.R

@@ -9,19 +9,17 @@ is_in_package <- function(x){
 separate_args <- function(...){
 
   dots <- lazy_dots(...)
-  args = list(args=dots,e.fun=c(),e.args=c())
+  args = list(args=dots)
 
   embeds <- unname(sapply(dots, function(x) is_in_package(x$expr)))
-  if (sum(embeds) > 1)
-    stop('only one embedded function is currently supported')
-  else if (sum(embeds) == 0)
+  
+  if (sum(embeds) == 0)
     return(args)
 
-  embedded.funs <- dots[[which(embeds)]]
-  dots[[which(embeds)]] <- NULL
-  args$args = dots
-  args$e.fun = as.character(embedded.funs$expr[[1]])
-  embedded.funs$expr[[1]] <- NULL
-  args$e.args = embedded.funs$expr
+  embedded.funs <- dots[which(embeds)]
+  args$args = dots[which(!embeds)]
+  fun.names = sapply(embedded.funs, function(x) as.character(x$expr[[1]]))
+  args$e.funs = lapply(embedded.funs, function(x) {x$expr[[1]] <- NULL; return(x$expr)}) %>% 
+    setNames(fun.names)
   return(args)
 }

R/lines.R

@@ -53,8 +53,11 @@ lines.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
 
   object <- gsplot(append(object, to.gsplot)) # append initial call
   if (!is.null(e.fun)){
-    embed.args = set_inherited_args(e.fun, arguments, dots$e.args)
-    object <- do.call(e.fun, append(list(object=object), embed.args))
+    for (i in seq_len(length(e.fun))){
+      fun.name = names(e.fun)[i]
+      embed.args = set_inherited_args(fun.name, arguments, e.fun[[i]])
+      object <- do.call(fun.name, append(list(object=object), embed.args))
+    }
   }
   return(object)
 }

R/points.R

@@ -56,8 +56,11 @@ points.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
 
   object <- gsplot(append(object, to.gsplot)) # append initial call
   if (!is.null(e.fun)){
-    embed.args = set_inherited_args(e.fun, arguments, dots$e.args)
-    object <- do.call(e.fun, append(list(object=object), embed.args))
+    for (i in seq_len(length(e.fun))){
+      fun.name = names(e.fun)[i]
+      embed.args = set_inherited_args(fun.name, arguments, e.fun[[i]])
+      object <- do.call(fun.name, append(list(object=object), embed.args))
+    }
   }
   return(object)
 }

tests/testthat/tests-embed_function.R

@@ -21,4 +21,15 @@ test_that("usr args aren't overidden", {
   gs <- points(gsplot(), c(0,3), c(2,4), callouts(labels=c('dogs','cats'), col='yellow'))
   expect_equal(gs$view$callouts$col, 'yellow')
 
+})
+
+test_that("multiple functions can be embedded", {
+  
+  gs <- lines(gsplot(), c(0,3), c(2,4), callouts(labels=c('dogs','cats'), col='yellow'), error_bar(x.low=c(NA,1), col='red'), error_bar(x.low=c(0.5,NA), col='green'))
+  expect_equal(gs$view$callouts$col, 'yellow')
+  expect_equal(gs$view[[3]]$col, 'red')
+  expect_equal(gs$view[[4]]$col, 'green')
+  gs <- points(gsplot(), c(0,3), c(2,4), callouts(labels=c('dogs','cats'), col='yellow'))
+  expect_equal(gs$view$callouts$col, 'yellow')
+  
 })