3
# Copyright (C) 2001--2007 R Development Core Team
4
# Copyright (C) 2003-4, 2006 The R Foundation
6
# This program is free software; you can redistribute it and/or modify
7
# it under the terms of the GNU General Public License as published by
8
# the Free Software Foundation; either version 2, or (at your option)
11
# This program is distributed in the hope that it will be useful, but
12
# WITHOUT ANY WARRANTY; without even the implied warranty of
13
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14
# General Public License for more details.
16
# A copy of the GNU General Public License is available at
17
# http://www.r-project.org/Licenses/
19
# Send any bug reports to r-bugs@r-project.org
21
## Usage: perl massage-Examples.pl pkgname files
23
## Given a list of files of the form .../.../<name>.R, produce one large
24
## file, i.e., write to stdout, concatenating the files together with
25
## 1) Putting a HEADER in front
26
## 2) Wrapping every file in order to be more order independent
27
## 3) appending a FOOTER ...
31
my $PKG = shift @ARGV;
35
opendir(DIR, $dir) or die "cannot opendir $dir: $!";
36
my @files = sort grep { /\.R$/ } readdir(DIR);
38
foreach my $file (@files) {
39
push(@Rfiles, "$dir/$file");
49
attach(NULL, name = "CheckExEnv")
52
s <- "__{must remake R-ex/*.R}__"
54
if(!missing(new)) s <<- new else s
58
## Add some hooks to label plot pages for base and grid graphics
59
assign("base_plot_hook",
61
pp <- par(c("mfg","mfcol","oma","mar"))
62
if(all(pp\$mfg[1:2] == c(1, pp\$mfcol[2]))) {
63
outer <- (oma4 <- pp\$oma[4]) > 0; mar4 <- pp\$mar[4]
64
mtext(sprintf("help(\\"%s\\")", nameEx()), side = 4,
65
line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1),
66
outer = outer, adj = 1, cex = .8, col = "orchid", las=3)
70
assign("grid_plot_hook",
72
grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") -
73
grid::unit(1, "lines"), x=0, just="left"))
74
grid::grid.text(sprintf("help(\\"%s\\")", nameEx()),
75
x=grid::unit(1, "npc") + grid::unit(0.5, "lines"),
76
y=grid::unit(0.8, "npc"), rot=90,
77
gp=grid::gpar(col="orchid"))
80
setHook("plot.new", get("base_plot_hook", pos = "CheckExEnv"))
81
setHook("persp", get("base_plot_hook", pos = "CheckExEnv"))
82
setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv"))
84
function(env = .GlobalEnv) {
85
rm(list = ls(envir = env, all.names = TRUE), envir = env)
86
RNGkind("default", "default")
89
.CheckExEnv <- as.environment("CheckExEnv")
90
delayedAssign("T", stop("T used instead of TRUE"),
91
assign.env = .CheckExEnv)
92
delayedAssign("F", stop("F used instead of FALSE"),
93
assign.env = .CheckExEnv)
95
newitems <- sch[! sch %in% .oldSearch]
96
for(item in rev(newitems))
97
eval(substitute(detach(item), list(item=item)))
98
missitems <- .oldSearch[! .oldSearch %in% sch]
100
warning("items ", paste(missitems, collapse=", "),
101
" have been removed from the search path")
104
assign("ptime", proc.time(), pos = "CheckExEnv")
105
## at least one package changes these via ps.options(), so do this
106
## before loading the package.
107
## Use postscript as incomplete files may be viewable, unlike PDF.
108
## Choose a size that is close to on-screen devices, fix paper
109
ps.options(width = 7, height = 7, paper = "a4", reset = TRUE)
110
grDevices::postscript("$PKG-Ex.ps")
112
assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv")
113
options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
117
if ($PKG eq "tcltk") {
118
print "require('tcltk') || q()\n\n";
119
} elsif ($PKG ne "base") {
120
print "library('$PKG')\n\n";
122
print "assign(\".oldSearch\", search(), pos = 'CheckExEnv')\n";
123
print "assign(\".oldNS\", loadedNamespaces(), pos = 'CheckExEnv')\n";
125
### * Loop over all R files, and edit a few of them ...
126
foreach my $file (@Rfiles) {
127
my $have_examples = 0;
129
my $have_contrasts = 0;
132
$nm = basename $file, (".R");
133
$nm =~ s/[^- .a-zA-Z0-9]/./g;
135
if ($PKG eq "graphics" && $file =~ /[^m]text\.R$/) { next; }
136
open(FILE, "< $file") or die "file $file cannot be opened";
139
if ((/_ Examples _/o) || (/### \*+ Examples/));
140
next if /^#/; # need to skip comment lines
141
$have_par = 1 if (/[^a-zA-Z0-9.]par\(/o || /^par\(/o);
142
$have_contrasts = 1 if /options\(contrasts/o;
145
if ($have_examples) {
146
print "cleanEx(); nameEx(\"$nm\")\n";
149
print "### * $nm\n\n";
150
print "flush(stderr()); flush(stdout())\n\n";
151
open(FILE, "< $file") or die "file $file cannot be opened";
155
$dont_test = 1 if /^## No test:/;
156
print $_ unless $dont_test;
157
$dont_test = 0 if /^## End\(No test\)/;
162
## if there were 'par()' calls, now reset them:
163
print "graphics::par(get(\"par.postscript\", pos = 'CheckExEnv'))\n";
165
if($have_contrasts) {
166
## if contrasts were set, now reset them:
167
print "options(contrasts = c(unordered = \"contr.treatment\"," .
168
"ordered = \"contr.poly\"))\n";
177
cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\\n")
180
### Local variables: ***
181
### mode: outline-minor ***
182
### outline-regexp: "\\\\(> \\\\)?### [*]+" ***
added
removed
share/perl/massage-Examples.pl
