Config branch...

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/axis.R

@@ -67,7 +67,8 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
 
   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,36 @@ 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) {
+
+  gsconfig$original.par <- par(no.readonly = TRUE)
+
+  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 +65,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 +82,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"])]
 

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

@@ -57,7 +57,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)

R/gsplot-class.R

@@ -4,6 +4,8 @@
 #'
 #' @param x list
 #' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
+#' @param config.file path to config yaml for individual gsplot object
+#' @param theme path to theme
 #' @return gsplot 
 #' @export
 #' @rdname gsplot
@@ -13,12 +15,24 @@ gsplot <- function(x = NULL, ...) UseMethod("gsplot")
 
 #' @rdname gsplot
 #' @export
-gsplot.default <- function(...) {
-  object <- gsplot(list(global=list('config'=list(frame.plot=TRUE))))
+gsplot.default <- function(...,config.file=NA, theme=NA) {
+  object <- gsplot(list(global=list('config'=list(frame.plot=TRUE, 
+                                                  config.file=!is.na(config.file)))))
+
+  if (!is.na(config.file)){
+    load_temp_config(config.file)
+  }
+
+  # if(length(all.equal(gsconfig$original.par, par(no.readonly = TRUE))) > 1){
+  #   par(gsconfig$original.par)
+  # }
+
   object <- add_new_par(object, 'global')
-  if (length(list(...)) > 0){
+
+  if(length(list(...)) > 0){
     object <- par(object, ...)
   }
+
   return(object)
 }
 

R/legend.R

@@ -85,10 +85,10 @@ draw_legend <- function(gsplot) {
 
     for (legend.name in names(gsplot[['legend']])) {
 
-      par(xpd=TRUE)
-
       legend <- gsplot[['legend']][[legend.name]]
       if (legend$draw) {
+        par(xpd=TRUE)
+
         legend <- appendLegendColumnInfo(legend)
         legend <- appendLegendPositionConfiguration(legend)
         # set required legend argument to NA if not exists
@@ -99,8 +99,11 @@ draw_legend <- function(gsplot) {
         #set bg so that fill/border/etc args are correct, then evaluate any quoted list items
         if (any(names(legend) %in% c("bg"))) {
           par(bg=legend$bg)
+        } else {
+          par(bg = ifelse(par('bg') == "transparent", "#FFFFFF", par('bg')))
         }
         legend <- lapply(legend, function(x) {unname(sapply(x, function(x) {eval(x)}))})
+
         # clean out arguments not allowed by legend 
         legend <- legend[na.omit(match(names(default.args), names(legend)))]
         legend(legend)

R/par.R

@@ -23,6 +23,7 @@
 #' gs2
 par <- function(object, ...) {
   override("graphics", "par", object, ...)
+  gsconfig$original.par <- par(no.readonly = TRUE)
 }
 
 
@@ -36,4 +37,5 @@ par.gsplot <- function(object, ...){
 
   object <- modify_global_par(object, arguments)
   return(object)
-}
+}
+

R/print.R

@@ -75,7 +75,9 @@ print.gsplot <- function(x, ...){
     }
 
     if(par('ann')){
-      mtext(text=label(views, side), side=side, line = 2, las=config("mtext")$las)
+      mtext(text=label(views, side), 
+            side=side, line = 2, 
+            las=config("mtext", custom.config = x[["global"]][["config"]][["config.file"]])$las)
     }
     par(old.par)
   }

R/set_args.R

@@ -4,13 +4,14 @@
 #' into a function-ready list.
 #' 
 #' @param fun.name the name of the function to generate an arg list for
+#' @param custom.config logical
 #' @param \dots user arguments to be used for the list
 #' @param package the package to use to get the function from (defaults to 'graphics')
 #' 
 #' @keywords internal
-set_args <- function(fun.name, ..., package='graphics'){
+set_args <- function(fun.name, ..., custom.config = FALSE, package='graphics'){
 
-  config_args <- config(fun.name)
+  config_args <- config(fun.name, custom.config = custom.config)
   user_args <- function_args(name=fun.name, package=package, ...)
 
   indicesToAdd <- !(names(config_args) %in% names(user_args))

R/title.R

@@ -33,7 +33,7 @@ title <- function(object, ...) {
 
 
 title.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  to.gsplot <- set_args("title", ..., package = "graphics")
+  to.gsplot <- set_args("title", ..., custom.config = object[["global"]][["config"]][["config.file"]], package = "graphics")
 
   object$global$title <- append_replace(object$global$title, to.gsplot)
   return(object)

R/utils-side.R

@@ -227,7 +227,9 @@ add_new_side <- function(object, side.name){
   if (side.name %in% side_names(object))
     stop(side.name, ' already exists, cannot add it.', call. = FALSE)
   side.template <- list(list(
-    axis = set_args('axis', side=as.side(side.name), package='graphics'), 
+    axis = set_args('axis', side=as.side(side.name), 
+                    custom.config = object[["global"]][["config"]][["config.file"]], 
+                    package='graphics'), 
     lim = c(NA, NA), log=FALSE, label="", axes = TRUE, reverse = FALSE, usr.lim=c(FALSE, FALSE), usr.axes=FALSE))
 
   names(side.template) <- side.name

README.Rmd

@@ -9,6 +9,7 @@ output:
 
 ```{r global_options, include=FALSE}
 knitr::opts_chunk$set(fig.width=6, fig.height=6,
+                      echo=TRUE,
                       warning=FALSE, message=FALSE)
 ```
 

README.md

@@ -98,6 +98,8 @@ myplot <- myplot %>% points(4,3,col="blue")
 myplot
 ```
 
+![](README_files/figure-markdown_github/unnamed-chunk-3-1.png)
+
 <a name="legend"></a>
 
 #### Automatic legend

inst/extdata/lineScatter.yaml

@@ -16,7 +16,6 @@ lines:
   col: "black"
   lty: 1
   lwd: 1
-  labels: FALSE
 abline:
   col: "grey"
   lty: 1