From dee4f4f4c92654a7d080ec3e7f5f88d932c1462d Mon Sep 17 00:00:00 2001 From: Marco Colombo Date: Wed, 18 Sep 2024 15:47:22 +0200 Subject: [PATCH] Use add = TRUE with on.exit(). This is the recommended usage, as if there are more than one on.exit() in a function, they don't overwrite each other. --- R/analyse_Al2O3C_CrossTalk.R | 2 +- R/analyse_Al2O3C_Measurement.R | 2 +- R/analyse_FadingMeasurement.R | 2 +- R/analyse_IRSAR.RF.R | 4 ++-- R/analyse_SAR.CWOSL.R | 4 ++-- R/analyse_SAR.TL.R | 2 +- R/analyse_baSAR.R | 2 +- R/analyse_portableOSL.R | 8 ++++---- R/calc_AverageDose.R | 2 +- R/calc_Huntley2006.R | 2 +- R/calc_gSGC_feldspar.R | 2 +- R/combine_De_Dr.R | 6 +++--- R/fit_EmissionSpectra.R | 2 +- R/fit_LMCurve.R | 2 +- R/fit_OSLLifeTimes.R | 2 +- R/plot_AbanicoPlot.R | 2 +- R/plot_DRTResults.R | 2 +- R/plot_FilterCombinations.R | 2 +- R/plot_GrowthCurve.R | 2 +- R/plot_RLum.Analysis.R | 3 +-- R/plot_RLum.Data.Image.R | 4 ++-- R/plot_RLum.Data.Spectrum.R | 2 +- R/plot_RLum.Results.R | 4 ++-- R/plot_RadialPlot.R | 2 +- R/read_BIN2R.R | 2 +- R/read_Daybreak2R.R | 2 +- R/scale_GammaDose.R | 2 +- R/use_DRAC.R | 2 +- 28 files changed, 37 insertions(+), 38 deletions(-) diff --git a/R/analyse_Al2O3C_CrossTalk.R b/R/analyse_Al2O3C_CrossTalk.R index a3665ba65..bc88fe5ff 100644 --- a/R/analyse_Al2O3C_CrossTalk.R +++ b/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( diff --git a/R/analyse_Al2O3C_Measurement.R b/R/analyse_Al2O3C_Measurement.R index f40c2a234..c026f27df 100644 --- a/R/analyse_Al2O3C_Measurement.R +++ b/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( diff --git a/R/analyse_FadingMeasurement.R b/R/analyse_FadingMeasurement.R index ed2c26f95..ec24facab 100644 --- a/R/analyse_FadingMeasurement.R +++ b/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)) } diff --git a/R/analyse_IRSAR.RF.R b/R/analyse_IRSAR.RF.R index 48160d25e..e75b8cfb6 100644 --- a/R/analyse_IRSAR.RF.R +++ b/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"]]) diff --git a/R/analyse_SAR.CWOSL.R b/R/analyse_SAR.CWOSL.R index 5ea3b5742..0d73f23e7 100644 --- a/R/analyse_SAR.CWOSL.R +++ b/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, diff --git a/R/analyse_SAR.TL.R b/R/analyse_SAR.TL.R index bd05996ff..663e261dc 100644 --- a/R/analyse_SAR.TL.R +++ b/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) diff --git a/R/analyse_baSAR.R b/R/analyse_baSAR.R index 2834250c8..f7742ec85 100644 --- a/R/analyse_baSAR.R +++ b/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 diff --git a/R/analyse_portableOSL.R b/R/analyse_portableOSL.R index 52c4ed7ef..03e0f4b5c 100644 --- a/R/analyse_portableOSL.R +++ b/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)) diff --git a/R/calc_AverageDose.R b/R/calc_AverageDose.R index 389880f9a..8b1883701 100644 --- a/R/calc_AverageDose.R +++ b/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)) } diff --git a/R/calc_Huntley2006.R b/R/calc_Huntley2006.R index 6247083ea..de2c869e0 100644 --- a/R/calc_Huntley2006.R +++ b/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) } diff --git a/R/calc_gSGC_feldspar.R b/R/calc_gSGC_feldspar.R index f8686ee59..8526a1308 100644 --- a/R/calc_gSGC_feldspar.R +++ b/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)) { diff --git a/R/combine_De_Dr.R b/R/combine_De_Dr.R index 01500a709..f25723d0f 100644 --- a/R/combine_De_Dr.R +++ b/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) } diff --git a/R/fit_EmissionSpectra.R b/R/fit_EmissionSpectra.R index a1cb9bd0d..0f3b72ab6 100644 --- a/R/fit_EmissionSpectra.R +++ b/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( diff --git a/R/fit_LMCurve.R b/R/fit_LMCurve.R index 77e01b0f4..b4bc7d670 100644 --- a/R/fit_LMCurve.R +++ b/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 diff --git a/R/fit_OSLLifeTimes.R b/R/fit_OSLLifeTimes.R index b90463a3c..08462acce 100644 --- a/R/fit_OSLLifeTimes.R +++ b/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), diff --git a/R/plot_AbanicoPlot.R b/R/plot_AbanicoPlot.R index 084a4b443..22e2e15f1 100644 --- a/R/plot_AbanicoPlot.R +++ b/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 diff --git a/R/plot_DRTResults.R b/R/plot_DRTResults.R index b59bdd923..5e86da6e4 100644 --- a/R/plot_DRTResults.R +++ b/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 diff --git a/R/plot_FilterCombinations.R b/R/plot_FilterCombinations.R index 7fa9fc7e0..dfcce9deb 100644 --- a/R/plot_FilterCombinations.R +++ b/R/plot_FilterCombinations.R @@ -325,7 +325,7 @@ plot_FilterCombinations <- function( ) print(p) - on.exit(return(p)) + on.exit(return(p), add = TRUE) }else{ diff --git a/R/plot_GrowthCurve.R b/R/plot_GrowthCurve.R index ec681c6ff..634528b74 100644 --- a/R/plot_GrowthCurve.R +++ b/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) diff --git a/R/plot_RLum.Analysis.R b/R/plot_RLum.Analysis.R index b96e85c71..c49656c83 100644 --- a/R/plot_RLum.Analysis.R +++ b/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) { diff --git a/R/plot_RLum.Data.Image.R b/R/plot_RLum.Data.Image.R index d802cfaac..b77c02c32 100644 --- a/R/plot_RLum.Data.Image.R +++ b/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)){ diff --git a/R/plot_RLum.Data.Spectrum.R b/R/plot_RLum.Data.Spectrum.R index cfefe01b6..1c52d1af0 100644 --- a/R/plot_RLum.Data.Spectrum.R +++ b/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) { diff --git a/R/plot_RLum.Results.R b/R/plot_RLum.Results.R index b79764895..bf00c0f7c 100644 --- a/R/plot_RLum.Results.R +++ b/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() diff --git a/R/plot_RadialPlot.R b/R/plot_RadialPlot.R index 113e9cc74..64fc21f51 100644 --- a/R/plot_RadialPlot.R +++ b/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, diff --git a/R/read_BIN2R.R b/R/read_BIN2R.R index c4aa9ae77..823727f0a 100644 --- a/R/read_BIN2R.R +++ b/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) diff --git a/R/read_Daybreak2R.R b/R/read_Daybreak2R.R index c288aa002..899a902c5 100644 --- a/R/read_Daybreak2R.R +++ b/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") diff --git a/R/scale_GammaDose.R b/R/scale_GammaDose.R index b5c67692b..f0286f72e 100644 --- a/R/scale_GammaDose.R +++ b/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, diff --git a/R/use_DRAC.R b/R/use_DRAC.R index dc1d8cd6b..28eae39dc 100644 --- a/R/use_DRAC.R +++ b/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",