Merge pull request #416 from ldecicco-USGS/master

Re-trying config branch

Author: Lindsay Carr

R/abline.R

@@ -16,6 +16,7 @@
 #'  
 #'
 #' @export
+#' @seealso \code{\link[graphics]{abline}}
 #' @examples
 #' gs <- gsplot()
 #' gsNew <- points(gs, y=1, x=2, col="blue", pch=18, legend.name="Points")

R/add_new_par.R

@@ -7,7 +7,7 @@
 add_new_par <- function(object, field){
   defaults <- list(c())
   if (field == 'global'){
-    defaults <- config('par')
+    defaults <- config('par', custom.config = object[["global"]][["config"]][["config.file"]])
   }
   if ('par' %in% names(object[[field]]))
     stop('par in ', field, ' already exists, cannot add it.', call. = FALSE)

R/add_to_view.R

@@ -57,6 +57,7 @@ add_to_view <- function(object, call.args, side, where){
 #' @param fun.name the name of the rendering function
 #' @param \dots arguments to \code{fun.name} or an embedded function 
 #' within it. 
+#' @param custom.config logical to use custom or global config file
 #' @return list with arguments. List is named according to function 
 #' names. 
 #' @examples 
@@ -70,14 +71,14 @@ add_to_view <- function(object, call.args, side, where){
 #' gsplot:::filter_arguments('points', x=1:5, y=1:5, xlim=c(0,10), ylim=c(0,10), 
 #'                callouts(labels=c(rep(NA, 4), "oh")))$extracted.args
 #' @keywords internal
-filter_arguments <- function(fun.name, ...){
+filter_arguments <- function(fun.name, ..., custom.config = FALSE){
   dots <- separate_args(...)
 
   standard.eval.args <- standard_eval_arguments(dots$args)
   if (is.null(fun.name)){
     function.args <- NULL
   } else {
-    function.args <- function_call_args(fun.name, standard.eval.args)
+    function.args <- function_call_args(fun.name, standard.eval.args, custom.config = custom.config)
   }
 
   option.args <- standard.eval.args[!names(standard.eval.args) %in% c("", names(function.args[[1]]))]
@@ -101,14 +102,16 @@ standard_eval_arguments <- function(.dots){
 #' get the arguments that go into the function call, stripping out others and adding config defaults
 #' 
 #' @param fun.name the name of the rendering function
+#' @param custom.config logical whether or not to use custom.config or global config defaults
 #' @param .dots lazy_dots arguments
 #' @keywords internal
-function_call_args <- function(fun.name, all.args){
+function_call_args <- function(fun.name, all.args, custom.config=FALSE){
 
   fun.defaults <- function_defaults(fun.name)
 
-  args <- set_args(fun.name, all.args, package=fun.defaults$package)
-  call.args <- list(formal_arguments(args, fun.defaults$def.funs, keep.names = names(config(fun.name))))
+  args <- set_args(fun.name, all.args, custom.config = custom.config, package=fun.defaults$package)
+  call.args <- list(formal_arguments(args, fun.defaults$def.funs, 
+                                     keep.names = names(config(fun.name, custom.config = custom.config))))
   names(call.args) <- fun.name
   return(call.args)
 }

R/arrows.R

@@ -1,6 +1,6 @@
 #' gsplot arrows
 #'
-#' Creates an arrow pointing at a specified plot location.   See \code{\link[graphics]{arrows}} for more details.
+#' Creates an arrow pointing at a specified plot location. See \code{\link[graphics]{arrows}} for more details.
 #' 
 #' @param object gsplot object
 #' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
@@ -14,6 +14,7 @@
 #' }
 #' 
 #' @export
+#' @seealso \code{\link[graphics]{arrows}}
 #' @examples
 #' gs <- gsplot() %>%
 #'    points( y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),

R/axis.R

@@ -12,6 +12,7 @@
 #'  }
 #'    
 #' @rdname axis
+#' @seealso \code{\link[graphics]{axis}}
 #' @export
 #' @examples
 #' gs <- gsplot() %>%
@@ -68,7 +69,8 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL, ap
 
   fun.name <- "axis"
 
-  user_args <- filter_arguments(fun.name = fun.name, ...)$call.args
+  user_args <- filter_arguments(fun.name = fun.name, ..., 
+                                custom.config = object[["global"]][["config"]][["config.file"]])$call.args
 
   sides <- user_args[[fun.name]]$side
   user_args[[fun.name]]$side <- NULL

R/bgCol.R

@@ -36,7 +36,8 @@ bgCol <- function(object, ...) {
 
 bgCol.gsplot <- function(object, ...){
 
-  to.gsplot <- filter_arguments(fun.name = "bgCol", ...)$call.args
+  to.gsplot <- filter_arguments(fun.name = "bgCol", ...,
+                                custom.config = object[["global"]][["config"]][["config.file"]])$call.args
   object$global$bgCol <- append_replace(object$global$bgCol, to.gsplot[[1]])
   return(object)
 

R/config.R

@@ -1,4 +1,7 @@
 gsconfig <- new.env(parent = emptyenv())
+gsconfig$original.par <- par(no.readonly = TRUE)
+
+#Question...how can I update the user's par?
 
 #' @title Load gsplot config
 #'
@@ -22,13 +25,34 @@ loadConfig = function(filename) {
   }
 
   graphTemplate <- yaml.load_file(filename)
-  if(.Device != "null device"){
-    dev.off()
+
+  if(length(all.equal(gsconfig$original.par, par(no.readonly = TRUE))) > 1){
+    par(gsconfig$original.par)
   }
-  
   gsconfig$options <- graphTemplate
 }
 
+#' @title Load gsplot temporary config
+#'
+#' @description Loads the config file into options which are
+#'used elsewhere in the application. This will only change the config paremeters while
+#'building up the gsplot object, not on print.
+#'
+#' @param filename string to custom file 
+#'
+#' @importFrom graphics plot.xy
+#' @importFrom graphics par
+#' @importFrom yaml yaml.load_file
+#' @importFrom grDevices dev.off
+load_temp_config = function(filename) {
+  
+  graphTemplate <- yaml.load_file(filename)
+
+  if(length(all.equal(gsconfig$original.par, par(no.readonly = TRUE))) > 1){
+    par(gsconfig$original.par)
+  }
+  gsconfig$temp.config <- graphTemplate
+}
 
 
 #' @title Get configuration for gsplot
@@ -39,14 +63,15 @@ loadConfig = function(filename) {
 #' @param type string of gsplot config object to retrieve
 #' @param ... additional configuration to override what is pulled from config
 #' @param persist logical of whether to persist overrides to config
+#' @param custom.config logical of whether to use default global (FALSE) or a config set for only one gsplot object 
 #'
 #' @examples
 #' config("par")
 #' 
 #' @importFrom graphics plot.xy
 #' @importFrom graphics par
 #' @export
-config <- function(type, ..., persist=FALSE){
+config <- function(type, ..., persist=FALSE, custom.config = FALSE){
   allowedTypes <- names(pkg.env$fun.details)
 
   type <- match.arg(type, choices = allowedTypes)
@@ -55,7 +80,11 @@ config <- function(type, ..., persist=FALSE){
     loadConfig()
   }
 
-  config_list <- gsconfig$options
+  if(custom.config){
+    config_list <- gsconfig$temp.config
+  } else {
+    config_list <- gsconfig$options
+  }
 
   globalConfig <- config_list[!(names(config_list) %in% allowedTypes[allowedTypes != "par"])]
 
@@ -78,7 +107,7 @@ config <- function(type, ..., persist=FALSE){
 
   if (persist){
     if (type == "par"){
-      gsconfig$options[names(globalConfig)] <- globalConfig 
+      gsconfig$options[names(globalConfig)] <- globalConfig
     } else {
       gsconfig$options[[type]] <- globalConfig
     }

R/curve.R

@@ -23,6 +23,7 @@
 #'  }
 #'    
 #' @rdname curve
+#' @seealso \code{\link[graphics]{curve}}
 #' @export
 #' @importFrom lazyeval lazy lazy_eval
 #' @examples

R/gather_function_info.R

@@ -20,7 +20,7 @@
 #' @return a code{gsplot} object
 #' @keywords internal
 gather_function_info <- function(object, fun.name, ..., legend.name, side, where){
-  arguments <- filter_arguments(fun.name, ..., side=side)
+  arguments <- filter_arguments(fun.name, ..., custom.config = object[["global"]][["config"]][["config.file"]], side=side)
 
   call.args <- arguments$call.args
   option.args <- arguments$option.args

R/grid.R

@@ -6,6 +6,7 @@
 #' @param \dots Further graphical parameters may also be supplied as arguments
 #' 
 #' @export
+#' @seealso \code{\link[graphics]{grid}}
 #' @examples
 #' gs <- gsplot()
 #' gsNew <- points(gs, y=1, x=2, xlim=c(0,NA),ylim=c(0,NA),
@@ -57,7 +58,7 @@ draw_custom_grid <- function(object, view.name){
 
   view.name <- names(object[view.name])
 
-  grid.args <- set_args("grid", object[[view.name]][['grid']], package = "graphics")
+  grid.args <- set_args("grid", object[[view.name]][['grid']],custom.config =  object[["global"]][["config"]][["config.file"]], package = "graphics")
 
   if (is.null(grid.args$nx)){
     x.side <- as.x_side_name(view.name)