Merge pull request #255 from R-Lum/on.exit

Use add = TRUE with on.exit()
[skip ci]

R/analyse_Al2O3C_CrossTalk.R

@@ -255,7 +255,7 @@ analyse_Al2O3C_CrossTalk <- function(
 
     ##get plot settings
     par.default <- par(no.readonly = TRUE)
-    on.exit(par(par.default))
+    on.exit(par(par.default), add = TRUE)
 
     ##settings
     plot_settings <- list(

R/analyse_Al2O3C_Measurement.R

@@ -617,7 +617,7 @@ analyse_Al2O3C_Measurement <- function(
     if (plot) {
       ##get plot settings
       par.default <- par()$mfrow
-      on.exit(par(mfrow = par.default))
+      on.exit(par(mfrow = par.default), add = TRUE)
 
       ##settings
       plot_settings <- list(

R/analyse_FadingMeasurement.R

@@ -610,7 +610,7 @@ analyse_FadingMeasurement <- function(
   if(plot) {
     if (!plot.single[1]) {
       par.default <- par()$mfrow
-      on.exit(par(mfrow = par.default))
+      on.exit(par(mfrow = par.default), add = TRUE)
       par(mfrow = c(2, 2))
 
     }

R/analyse_IRSAR.RF.R

@@ -1560,7 +1560,7 @@ analyse_IRSAR.RF<- function(
 
       ##grep par default and define reset
       def.par <- par(no.readonly = TRUE)
-      on.exit(par(def.par))
+      on.exit(par(def.par), add = TRUE)
 
       ##set plot frame, if a method was chosen
       if (any(method %in% c("SLIDE", "FIT", "VSLIDE"))) {
@@ -1575,7 +1575,7 @@ analyse_IRSAR.RF<- function(
     }else{
       if(plot.settings[["cex"]] != 1){
         def.par <- par()[["cex"]]
-        on.exit(par(def.par))
+        on.exit(par(def.par), add = TRUE)
 
         par(cex = plot.settings[["cex"]])
 

R/analyse_SAR.CWOSL.R

@@ -867,7 +867,7 @@ error.list <- list()
       # plot everyting on one page ... doing it here is much cleaner than
       # Plotting - one Page config -------------------------------------------------------
       if(plot_onePage){
-      on.exit(on_exit())
+      on.exit(on_exit(), add = TRUE)
 
       plot.single <- TRUE
       layout(matrix(
@@ -890,7 +890,7 @@ error.list <- list()
       }
 
       if (plot.single[1] == FALSE) {
-        on.exit(on_exit())
+        on.exit(on_exit(), add = TRUE)
         layout(matrix(
           c(1, 1, 3, 3,
             1, 1, 3, 3,

R/analyse_SAR.TL.R

@@ -358,7 +358,7 @@ analyse_SAR.TL <- function(
   # Plotting - Config -------------------------------------------------------
   ##grep plot parameter
   par.default <- par(no.readonly = TRUE)
-  on.exit(par(par.default))
+  on.exit(par(par.default), add = TRUE)
 
   ##grep colours
   col <- get("col", pos = .LuminescenceEnv)

R/analyse_baSAR.R

@@ -2250,7 +2250,7 @@ analyse_baSAR <- function(
 
     if(!plot.single){
       par(mfrow = c(1,2))
-      on.exit(par(mfrow = c(1,1), bg = "white", xpd = FALSE))
+      on.exit(par(mfrow = c(1,1), bg = "white", xpd = FALSE), add = TRUE)
     }
     ##////////////////////////////////////////////////////////////////////////////////////////////
     ##DOSE RESPONSE CURVES AND Lx/Tx VALUES

R/analyse_portableOSL.R

@@ -305,7 +305,7 @@ analyse_portableOSL <- function(
      ## set par -------
      if(length(plot_settings$surface_value) > 1) {
        par.default <- par(mfrow = c(2,2))
-       on.exit(par(par.default))
+       on.exit(par(par.default), add = TRUE)
      }
 
      ## loop over surface values -------
@@ -342,7 +342,7 @@ analyse_portableOSL <- function(
          par.default <- c(
            if(exists("par.default")) par.default else NULL,
            par(mar = c(4.5,4.5,4,2), xpd = FALSE))
-         on.exit(par(par.default))
+         on.exit(par(par.default), add = TRUE)
 
          ## open empty plot
          plot(
@@ -391,7 +391,7 @@ analyse_portableOSL <- function(
          ## add legend
          if(plot_settings$legend) {
            par.default <- c(par.default, par(xpd = TRUE))
-           on.exit(par(par.default))
+           on.exit(par(par.default), add = TRUE)
 
            col_grad <- plot_settings$col_ramp[
              seq(1, length(plot_settings$col_ramp), length.out = 14)]
@@ -449,7 +449,7 @@ analyse_portableOSL <- function(
    ## mode == "profile" ---------
    if (!is.null(mode[1]) && mode == "profile") {
     par.old.full <- par(no.readonly = TRUE)
-    on.exit(par(par.old.full))
+    on.exit(par(par.old.full), add = TRUE)
 
     # default: par(mar = c(5, 4, 4, 2) + 0.1) // bottom, left, top, right
     par(mfrow = c(1, 7))

R/calc_AverageDose.R

@@ -463,7 +463,7 @@ calc_AverageDose <- function(
   ##get change par setting and reset on exit
   if(plot) {
     par.default <- par()$mfrow
-    on.exit(par(mfrow = par.default))
+    on.exit(par(mfrow = par.default), add = TRUE)
     par(mfrow = c(1,3))
   }
 

R/calc_Huntley2006.R

@@ -965,7 +965,7 @@ calc_Huntley2006 <-
     }
 
     # recover plot parameters
-    on.exit(par(par.old.full))
+    on.exit(par(par.old.full), add = TRUE)
 
   }
 

R/calc_gSGC_feldspar.R

@@ -249,7 +249,7 @@ calc_gSGC_feldspar <- function (
 # Plotting ----------------------------------------------------------------
   if(plot){
     old.par <- par(no.readonly = TRUE)
-    on.exit(par(old.par))
+    on.exit(par(old.par), add = TRUE)
 
     par(mfrow = c(mfrow = c(3,3)))
     for (i in 1:length(l)) {

R/combine_De_Dr.R

@@ -125,7 +125,7 @@
     ),
     val = method_control)
 
-  on.exit(close(model))
+  on.exit(close(model), add = TRUE)
   ## select model
   if(length(theta) == 1) {
     data1$theta <- NULL
@@ -268,7 +268,7 @@
     ),
     val = method_control)
 
-  on.exit(close(model))
+  on.exit(close(model), add = TRUE)
   data <-
     list(
       'theta' = theta,
@@ -712,7 +712,7 @@ if(plot){
   ##make sure we reset plots
   if(par_local) {
     old.par <- par(mfrow = c(1, 2))
-    on.exit(par(old.par))
+    on.exit(par(old.par), add = TRUE)
 
   }
 

R/fit_EmissionSpectra.R

@@ -529,7 +529,7 @@ fit_EmissionSpectra <- function(
 
     if(!is.na(fit[1]) && class(fit)[1] != "try-error"){
     ##make sure that the screen closes if something is wrong
-    on.exit(close.screen(n = c(1,2)))
+    on.exit(close.screen(n = c(1,2)), add = TRUE)
 
     ##set split screen settings
     split.screen(rbind(

R/fit_LMCurve.R

@@ -339,7 +339,7 @@ fit_LMCurve<- function(
 
   # layout safety settings
   par.default <- par()[c("mfrow", "cex", "mar", "omi", "oma")]
-  on.exit(par(par.default))
+  on.exit(par(par.default), add = TRUE)
 
   ##============================================================================##
   ##  BACKGROUND SUBTRACTION

R/fit_OSLLifeTimes.R

@@ -686,7 +686,7 @@ if(plot) {
 
     if(!plot_simple){
       ##make sure that the screen closes if something is wrong
-      on.exit(close.screen(all.screens = TRUE))
+      on.exit(close.screen(all.screens = TRUE), add = TRUE)
 
       split.screen(rbind(
         c(0.1,1,0.32, 0.98),

R/plot_AbanicoPlot.R

@@ -558,7 +558,7 @@ plot_AbanicoPlot <- function(
 
   ## this ensures par() is respected for several plots on one page
   if(sum(par()$mfrow) == 2 & sum(par()$mfcol) == 2){
-    on.exit(par(par.old.full))
+    on.exit(par(par.old.full), add = TRUE)
   }
 
   ## check/set layout definitions

R/plot_DRTResults.R

@@ -470,7 +470,7 @@ plot_DRTResults <- function(
     if (shift.lines <= 0)
     shift.lines <- 1
     par.default <- par(mfrow = c(1, 1), cex = cex, oma = c(0, 1, shift.lines - 1, 1))
-    on.exit(par(par.default))
+    on.exit(par(par.default), add = TRUE)
   }
 
   ## optionally plot values and error bars

R/plot_FilterCombinations.R

@@ -325,7 +325,7 @@ plot_FilterCombinations <- function(
       )
 
       print(p)
-      on.exit(return(p))
+      on.exit(return(p), add = TRUE)
 
 
     }else{

R/plot_GrowthCurve.R

@@ -1915,7 +1915,7 @@ plot_GrowthCurve <- function(
 
       ## safe par settings
       par.old.full <- par(no.readonly = TRUE)
-      on.exit(par(par.old.full))
+      on.exit(par(par.old.full), add = TRUE)
 
       ##set new parameter
       layout(matrix(c(1, 1, 1, 1, 2, 3), 3, 2, byrow = TRUE), respect = TRUE)

R/plot_RLum.Analysis.R

@@ -261,12 +261,11 @@ plot_RLum.Analysis <- function(
 
     ##set par
     par.default <- par("mfrow")
-    if(!plot.single){on.exit(par(mfrow = par.default))}
     if(!plot.single) {
       par(mfrow = c(nrows, ncols))
+      on.exit(par(mfrow = par.default), add = TRUE)
     }
 
-
     ##expand plot settings list
     plot.settings <- lapply(setNames(1:length(plot.settings), names(plot.settings)),
                             function(x) {

R/plot_RLum.Data.Image.R

@@ -148,7 +148,7 @@ plot_settings <- modifyList(x = list(
 # plot.raster -------------------------------------------------------------
     for(i in 1:dim(object)[3]) {
       par.default <- par(mar = c(4.5,4.5,4,3))
-      on.exit(par(par.default))
+      on.exit(par(par.default), add = TRUE)
       x <- object[, , i, drop = FALSE]
       image <-.stretch(x, type = plot_settings$stretch)
 
@@ -180,7 +180,7 @@ plot_settings <- modifyList(x = list(
       ## add legend
       if(plot_settings$legend) {
         par.default <- c(par.default, par(xpd = TRUE))
-        on.exit(par(par.default))
+        on.exit(par(par.default), add = TRUE)
         col_grad <- plot_settings$col[seq(1, length(plot_settings$col), length.out = 14)]
         slices <- seq(0,1,length.out = 15)
         for(s in 1:(length(slices) - 1)){

R/plot_RLum.Data.Spectrum.R

@@ -866,7 +866,7 @@ if(plot){
        )
 
        print(p)
-       on.exit(return(p))
+       on.exit(return(p), add = TRUE)
 
 
   }else if(plot.type == "contour" && ncol(temp.xyz) > 1) {

R/plot_RLum.Results.R

@@ -72,7 +72,7 @@ plot_RLum.Results<- function(
   ## SAFE AND RESTORE PLOT PARAMETERS ON EXIT
   ##============================================================================##
   par.old <- par(no.readonly = TRUE)
-  on.exit(suppressWarnings(par(par.old)))
+  on.exit(suppressWarnings(par(par.old)), add = TRUE)
 
   ##============================================================================##
   ## ... ARGUMENTS
@@ -1022,7 +1022,7 @@ plot_RLum.Results<- function(
       par(bty="n")
       boxplot(MC.n, horizontal = TRUE, add = TRUE, bty="n")
     } else {
-      on.exit(NULL)
+      on.exit(NULL, add = TRUE) # FIXME(mcol): seems unnecessary
     }
   }#EndOf::Case 5 - calc_AliqoutSize()
 

R/plot_RadialPlot.R

@@ -1341,7 +1341,7 @@ label.text[[1]] <- NULL
         cex = cex)
 
     ## reset on exit
-    on.exit(par(default))
+    on.exit(par(default), add = TRUE)
 
     ## create empty plot
     plot(NA,

R/read_BIN2R.R

@@ -265,7 +265,7 @@ read_BIN2R <- function(
       close(con)
     }
   }
-  on.exit(expr = on_exit())
+  on.exit(expr = on_exit(), add = TRUE)
 
   ## check for URL and attempt download
   if(verbose)

R/read_Daybreak2R.R

@@ -114,7 +114,7 @@ read_Daybreak2R <- function(
   if(substr(file, start = nchar(file) - 3, stop = nchar(file)) == ".DAT"){
 
      # Read DAT-file ------------------------------------------------------------------------------
-      on.exit(close(con))
+      on.exit(close(con), add = TRUE)
 
       ##screen file to get information on the number of stored records
       con<-file(file,"rb")

R/scale_GammaDose.R

@@ -538,7 +538,7 @@ scale_GammaDose <- function(
 
     # save and recover plot parameters
     par.old <- par(no.readonly = TRUE)
-    on.exit(par(par.old))
+    on.exit(par(par.old), add = TRUE)
 
     if (plot_single)
       layout(matrix(c(1,1, 2, 3, 4, 5,

R/use_DRAC.R

@@ -271,7 +271,7 @@ use_DRAC <- function(
       reply <- readline("Do you want to see the DRAC error message (Y/N)?")
       if (reply == "Y" || reply == "y" || reply == 1)
         cat(error_msg)
-    })
+    }, add = TRUE)
     # nocov end
 
     .throw_error("\n\t We got a response from the server, but it\n",