1### * <HEADER>
2###
3attach(NULL, name = "CheckExEnv")
4assign("nameEx",
5       local({
6	   s <- "__{must remake R-ex/*.R}__"
7           function(new) {
8               if(!missing(new)) s <<- new else s
9           }
10       }),
11       pos = "CheckExEnv")
12## Add some hooks to label plot pages for base and grid graphics
13assign("base_plot_hook",
14       function() {
15           pp <- graphics::par(c("mfg","mfcol","oma","mar"))
16           if(all(pp$mfg[1:2] == c(1, pp$mfcol[2]))) {
17               outer <- (oma4 <- pp$oma[4]) > 0; mar4 <- pp$mar[4]
18               graphics::mtext(sprintf("help(\"%s\")", nameEx()), side = 4,
19                     line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1),
20               outer = outer, adj = 1, cex = 0.8, col = "orchid", las = 3)
21           }
22       },
23       pos = "CheckExEnv")
24assign("grid_plot_hook",
25       function() {
26           grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") -
27                              grid::unit(1, "lines"), x=0, just="left"))
28           grid::grid.text(sprintf("help(\"%s\")", nameEx()),
29                           x=grid::unit(1, "npc") + grid::unit(0.5, "lines"),
30                           y=grid::unit(0.8, "npc"), rot=90,
31                           gp=grid::gpar(col="orchid"))
32       },
33       pos = "CheckExEnv")
34setHook("plot.new",     get("base_plot_hook", pos = "CheckExEnv"))
35setHook("persp",        get("base_plot_hook", pos = "CheckExEnv"))
36setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv"))
37assign("cleanEx",
38       function(env = .GlobalEnv) {
39	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
40           RNGkind("default", "default", "default")
41	   set.seed(1)
42   	   options(warn = 1)
43	   .CheckExEnv <- as.environment("CheckExEnv")
44	   delayedAssign("T", stop("T used instead of TRUE", domain = NA),
45		  assign.env = .CheckExEnv)
46	   delayedAssign("F", stop("F used instead of FALSE", domain = NA),
47		  assign.env = .CheckExEnv)
48	   sch <- search()
49	   newitems <- sch[! sch %in% .oldSearch]
50           if(length(newitems)) tools:::detachPackages(newitems)
51	   missitems <- .oldSearch[! .oldSearch %in% sch]
52	   if(length(missitems))
53	       warning(sprintf("items %s were removed from the search path",
54                               paste(sQuote(missitems), collapse=", ")),
55                       call. = FALSE, immediate. = TRUE, domain = NA)
56           ## Old massaged files will not have set .old_wd.
57           if(exists(".old_wd") && (wd <- getwd()) != .old_wd) {
58               warning(sprintf("working directory was changed to %s, resetting",
59                               sQuote(wd)),
60                       call. = FALSE, immediate. = TRUE, domain = NA)
61               setwd(.old_wd)
62           }
63           ## stop in case users left connections open,
64           ## also indicating that parallel cluster are still running
65           if(Sys.getenv("_R_CHECK_CONNECTIONS_LEFT_OPEN_", FALSE)){
66               sC <- showConnections()
67               if(nrow(sC)){
68                   stop("connections left open:\n",
69                       paste(apply(sC[,1:2, drop = FALSE], 1L, function(x)
70                           paste0("\t", x[1L], " (", x[2L], ")")), collapse="\n"),
71				       call. = FALSE, domain = NA)
72               }
73           }
74       },
75       pos = "CheckExEnv")
76assign("ptime", proc.time(), pos = "CheckExEnv")
77## Do this before loading the package,
78## since packages have been known to change settings.
79## Force a size that is close to on-screen devices, fix paper.
80## don't rename par.postscript for back-compatibility of reference output.
81grDevices::pdf.options(width = 7, height = 7, paper = "special", reset = TRUE)
82grDevices::pdf(paste(pkgname, "-Ex.pdf", sep=""), encoding = "ISOLatin1")
83
84assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv")
85options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
86