[med-svn] [r-cran-r.methodss3] 07/09: New upstream version 1.7.1
Andreas Tille
tille at debian.org
Fri Oct 20 09:58:27 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-r.methodss3.
commit 357c7755257ae3fc0d035d3b857c6f17e0c3e94b
Author: Andreas Tille <tille at debian.org>
Date: Fri Oct 20 11:56:44 2017 +0200
New upstream version 1.7.1
---
DESCRIPTION | 17 ++
MD5 | 43 +++++
NAMESPACE | 59 +++++++
NEWS | 163 +++++++++++++++++
R/000.R | 114 ++++++++++++
R/001.R.KEYWORDS.R | 40 +++++
R/005.varArgs.R | 41 +++++
R/006.fixVarArgs.R | 9 +
R/010.setGenericS3.R | 262 +++++++++++++++++++++++++++
R/030.setMethodS3.R | 401 ++++++++++++++++++++++++++++++++++++++++++
R/999.NonDocumentedObjects.R | 37 ++++
R/999.package.R | 50 ++++++
R/findDispatchMethodsS3.R | 129 ++++++++++++++
R/getDispatchMethodS3.R | 50 ++++++
R/getGenericS3.R | 55 ++++++
R/getMethodS3.R | 47 +++++
R/isGenericS3.R | 209 ++++++++++++++++++++++
R/pkgStartupMessage.R | 88 +++++++++
R/rccValidators.R | 39 ++++
R/throw.default.R | 63 +++++++
R/zzz.R | 9 +
debian/README.test | 8 -
debian/changelog | 21 ---
debian/compat | 1 -
debian/control | 26 ---
debian/copyright | 22 ---
debian/docs | 3 -
debian/rules | 6 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 15 --
debian/watch | 2 -
inst/CITATION | 30 ++++
man/Non-documented_objects.Rd | 41 +++++
man/R.KEYWORDS.Rd | 30 ++++
man/R.methodsS3-package.Rd | 71 ++++++++
man/findDispatchMethodsS3.Rd | 46 +++++
man/getDispatchMethodS3.Rd | 45 +++++
man/getGenericS3.Rd | 43 +++++
man/getMethodS3.Rd | 42 +++++
man/isGenericS3.Rd | 45 +++++
man/isGenericS4.Rd | 45 +++++
man/pkgStartupMessage.Rd | 44 +++++
man/setGenericS3.Rd | 75 ++++++++
man/setMethodS3.Rd | 130 ++++++++++++++
man/throw.Rd | 57 ++++++
tests/appendVarArgs.R | 17 ++
tests/attributes.R | 27 +++
tests/findDispatchMethodsS3.R | 11 ++
tests/getDispatchMethodS3.R | 15 ++
tests/isGenericS3S4.R | 21 +++
tests/pkgStartupMessage.R | 13 ++
tests/setGenericS3.R | 40 +++++
tests/setMethodS3.R | 82 +++++++++
tests/throw.R | 19 ++
55 files changed, 2914 insertions(+), 108 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..0eda1a2
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,17 @@
+Package: R.methodsS3
+Version: 1.7.1
+Depends: R (>= 2.13.0)
+Imports: utils
+Date: 2016-02-15
+Title: S3 Methods Simplified
+Authors at R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"),
+ email = "henrikb at braju.com"))
+Author: Henrik Bengtsson [aut, cre, cph]
+Maintainer: Henrik Bengtsson <henrikb at braju.com>
+Description: Methods that simplify the setup of S3 generic functions and S3 methods. Major effort has been made in making definition of methods as simple as possible with a minimum of maintenance for package developers. For example, generic functions are created automatically, if missing, and naming conflict are automatically solved, if possible. The method setMethodS3() is a good start for those who in the future may want to migrate to S4. This is a cross-platform package implemente [...]
+License: LGPL (>= 2.1)
+LazyLoad: TRUE
+NeedsCompilation: no
+Packaged: 2016-02-16 03:21:35 UTC; hb
+Repository: CRAN
+Date/Publication: 2016-02-16 13:48:09
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..e755e59
--- /dev/null
+++ b/MD5
@@ -0,0 +1,43 @@
+ce1f0ae4eb9b0ad13759842bfe8b4379 *DESCRIPTION
+bff607e7e05a4b10762bc1a225e11ed8 *NAMESPACE
+fe2405991cbfd120c528b79de79778c3 *NEWS
+2e86e8b470b9e59384be62210c3da00b *R/000.R
+576ff223c1df906b32590e3e78d06d57 *R/001.R.KEYWORDS.R
+1b1f9bd06d558a455d3f9374d2a378a3 *R/005.varArgs.R
+f1d34d487e5092e88713531cf6f10a6c *R/006.fixVarArgs.R
+085e40e0b603eb14de11e0fb86e6187b *R/010.setGenericS3.R
+c2ca3d6adab3aefe4ff7ed3729583f70 *R/030.setMethodS3.R
+a4ab3969cbc2da96a8a2c1c2ed77b206 *R/999.NonDocumentedObjects.R
+18dce216cff64556a53b1cd3916184f8 *R/999.package.R
+6a7f4e7757621f569c529f11eb8a1c1a *R/findDispatchMethodsS3.R
+919beccc0425b2a5bd93bfe4fbf78264 *R/getDispatchMethodS3.R
+0628c16ffde62e06702c6a4570bb9123 *R/getGenericS3.R
+856008a212f94e54384665dae7c49e4e *R/getMethodS3.R
+44f342186a376d7e38555b28de85936e *R/isGenericS3.R
+91b40723acbdd29d4143330b862d61b3 *R/pkgStartupMessage.R
+a1103ffdfd1c7ed50b0366f939d8549f *R/rccValidators.R
+0e0caf77368e0fbee1650a5161a72a42 *R/throw.default.R
+87a07bdb31889de9bbb85b28e96db183 *R/zzz.R
+d8150d1411942582b7175c2bd26bf5eb *inst/CITATION
+e62840f5029923bb7fde68ff03c85ba7 *man/Non-documented_objects.Rd
+1b3a605645f2bf15b72946858f67a3bb *man/R.KEYWORDS.Rd
+af63cbe05b850b79cfa16ebb9b0acd42 *man/R.methodsS3-package.Rd
+3b5bcb3544cfbf6faadca52e1ccc8c9d *man/findDispatchMethodsS3.Rd
+48ee8839fd89e9512fdec95178ebf9bd *man/getDispatchMethodS3.Rd
+47ca671f187d64cd06c73abfef5e20fe *man/getGenericS3.Rd
+9594dc57bec938a16807c4b746ad3e78 *man/getMethodS3.Rd
+0c3197129ab90808ee71e8de415dff11 *man/isGenericS3.Rd
+4390144243165827fa06fd5e9077109b *man/isGenericS4.Rd
+1e7a7b30b80214fe3325a50d61a998b5 *man/pkgStartupMessage.Rd
+d0ad086d52e72c12787dc638dd019a5a *man/setGenericS3.Rd
+519552cddec0a9e862f9401ad0eb1206 *man/setMethodS3.Rd
+08f7aee8b35261e03de5cf4e245a405a *man/throw.Rd
+b24a7cd174fded033c7469ca5fe4f8b9 *tests/appendVarArgs.R
+2afbc200a256afc37d33c7a6b0d75f74 *tests/attributes.R
+0b0e7970b79540a0248a2005ea9f0866 *tests/findDispatchMethodsS3.R
+533869ce20ae7fb3e73bd7f4a60c0dc6 *tests/getDispatchMethodS3.R
+f2a3e7bf4f61342c91f284944d7888a2 *tests/isGenericS3S4.R
+1c3c57bf749393c8dff21b2a3089688b *tests/pkgStartupMessage.R
+292f96279990101660ccb20487c0f851 *tests/setGenericS3.R
+c200d5724ee5e90a244a72643f106394 *tests/setMethodS3.R
+b452094c7796d50a9aa77eac96407479 *tests/throw.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..0dfaf27
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,59 @@
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# IMPORTS
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+importFrom("utils", "capture.output")
+importFrom("utils", "getAnywhere")
+importFrom("utils", "getS3method")
+importFrom("utils", "head")
+
+## When package depends on R (>= 2.6.0)
+## importFrom("codetools", "findGlobals")
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# EXPORTS
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# Export all public methods, that is, those without a preceeding dot
+# in their names.
+##exportPattern("^[^\\.]")
+
+export("appendVarArgs")
+##export("export")
+##export("export<-")
+export("findDispatchMethodsS3")
+export("getDispatchMethodS3")
+export("getGenericS3")
+export("getMethodS3")
+export("hasVarArgs")
+export("isGenericS3")
+export("isGenericS4")
+##export("noexport")
+##export("S3class<-")
+export("setGenericS3")
+export("setMethodS3")
+export("throw")
+export("pkgStartupMessage")
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# DECLARATIONS
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# default
+S3method("getGenericS3", "default")
+S3method("getMethodS3", "default")
+S3method("isGenericS3", "default")
+S3method("isGenericS4", "default")
+S3method("pkgStartupMessage", "default")
+S3method("setGenericS3", "default")
+S3method("setMethodS3", "default")
+S3method("throw", "default")
+
+##export("startupMessage")
+##S3method("startupMessage", "default")
+
+S3method("findDispatchMethodsS3", "default") ## private; drop?
+S3method("getDispatchMethodS3", "default") ## private; drop?
+
+# function
+S3method("appendVarArgs", "function")
+S3method("hasVarArgs", "function")
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..835c857
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,163 @@
+Package: R.methodsS3
+====================
+
+Version: 1.7.1 [2016-02-15]
+o Explicit namespace imports also from 'utils' package.
+o CLEANUP: Package now requires R (>= 2.13.0) (April 2011). If really
+ needed on earlier version of R, it only takes a minor tweak, but
+ I won't do that unless really really needed.
+
+
+Version: 1.7.0 [2015-02-19]
+o ROBUSTNESS: Added several package tests.
+o CONSISTENCY: Now isGenericS4() returns FALSE for non-existing
+ functions, just as isGenericS3() does.
+o BUG FIX: isGenericS3() on a function gave error "object 'Math' of
+ mode 'function' was not found" when the 'methods' package was not
+ loaded, e.g. Rscript -e "R.methodsS3::isGenericS3(function(...) NULL)".
+o BUG FIX/WORKAROUND: findDispatchMethodsS3() could in rare cases return
+ an extra set of false functions in R (< 3.1.2). This was due to a
+ bug in R (< 3.1.2) where the output of getAnywhere() contained
+ garbage results, e.g. getAnywhere(".Options")$objs. For backward
+ compatibility, findDispatchMethodsS3() now detects this case and works
+ around it. This bug was only detected after adding an explicit package
+ test for findDispatchMethodsS3().
+
+
+Version: 1.6.2 [2014-05-04]
+o CLEANUP: Internal directory restructuring.
+
+
+Version: 1.6.1 [2014-01-04]
+o CLEANUP: Dropped obsolete argument 'ellipsesOnly' from setGenericS3().
+ It was not used. Thanks Antonio Piccolboni for reporting on this.
+
+
+Version: 1.6.0 [2013-11-12]
+o BUG FIX: Generic function created by setGenericS3("foo<-") would not
+ have a last argument name 'value', which 'R CMD check' complains about.
+
+
+Version: 1.5.3 [2013-11-05]
+o ROBUSTNESS: Now setMethodS3(name, class, ...) and
+ setGenericS3(name, ...) assert that arguments 'name' and 'class'
+ are non-empty.
+
+
+Version: 1.5.2 [2013-10-06]
+o BETA: Added an in-official option to make setGenericS3() and
+ setMethodsS3() look for existing (generic) functions also in
+ imported namespaces. This will eventually become the default.
+o ROBUSTNESS: Now isGenericS3() also compares to known generic
+ functions in the 'base' package. It also does a better job on
+ checking whether the function calls UseMethod() or not.
+o Added argument 'inherits' to getGenericS3().
+o The above improvement of isGenericS3() means that setGenericS3()
+ does a better job to decided whether a generic function should be
+ created or not, which in turn means 'createGeneric=FALSE' is needed
+ much less in setMethodS3().
+
+
+Version: 1.5.1 [2013-09-15]
+o BUG FIX: Forgot to explicitly import capture.output() from 'utils'
+ which could give an error on function "capture.output" not available
+ when setMethodS3() was used to define a "replacement" function.
+ This was only observed on the R v3.0.1 release version but not with
+ the more recent patched or devel versions.
+ In addition, two other 'utils' functions are now explicitly imported.
+
+
+Version: 1.5.0 [2013-08-29]
+o Added pkgStartupMessage() which acknowledges library(..., quietly=TRUE).
+
+
+Version: 1.4.5 [2013-08-23]
+o CLEANUP: Dropped deprecated inst/HOWTOSITE replaced by inst/CITATION.
+o CLEANUP: No longer utilizing ':::' for "self" (i.e. R.methodsS3) methods.
+
+
+Version: 1.4.4 [2013-05-19]
+o CRAN POLICY: Now all Rd \usage{} lines are at most 90 characters long.
+
+
+Version: 1.4.3 [2013-03-08]
+o Added an Authors at R field to the DESCRIPTION.
+
+
+Version: 1.4.2 [2012-06-22]
+o Now setMethodS3(..., appendVarArgs=TRUE) ignores 'appendVarArgs' if
+ the method name is "==", "+", "-", "*", "/", "^", "%%", or "%/%",
+ (in addition to "$", "$<-", "[[", "[[<-", "[", "[<-"). It will also
+ ignore it if the name matches regular expressions "<-$" or "^%[^%]*%$".
+ The built in RCC validators were updated accordingly.
+
+
+Version: 1.4.1 [2012-06-20]
+o Added argument 'overwrite' to setGenericS3().
+
+
+Version: 1.4.0 [2012-04-20]
+o Now setMethodS3() sets attribute "S3class" to the class.
+o Added argument 'export' to setMethodS3() and setGenericS3(), which
+ sets attribute "export" to the same value.
+
+
+Version: 1.3.0 [2012-04-16]
+o Now only generic funcions are exported, and not all of them.
+o Now all S3 methods are properly declared in NAMESPACE.
+
+
+Version: 1.2.3 [2012-03-08]
+o Now arguments '...' of setMethodS3() are passed to setGenericS3().
+
+
+Version: 1.2.2 [2011-11-17]
+o CLEANUP: Dropped example(getMethodS3), which was for setMethodS3().
+
+
+Version: 1.2.1 [2010-09-18]
+o BUG FIX: isGenericS3(), isGenericS4(), getGenericS3() and getMethodS3()
+ failed to locate functions created in the global environment while
+ there exist a function with the same name in the 'base' package.
+ The problem only affects the above functions and nothing else and it
+ did not exist prior to R.methodsS3 v1.2.0 when the package did not yet
+ have a namespace. Thanks John Oleynick for reporting on this problem.
+o BUG FIX: isGenericS3() and isGenericS4() did not support specifying
+ the function by name as a character string, despite it was documented
+ to do so. Thanks John Oleynick for reporting on this.
+
+
+Version: 1.2.0 [2010-03-13]
+o Added a NAMESPACE.
+
+
+Version: 1.1.0 [2010-01-02]
+o Added getDispatchMethodS3() and findDispatchMethodsS3().
+
+
+Version: 1.0.3 [2008-07-02]
+o Renamed HISTORY file to NEWS.
+
+
+Version: 1.0.2 [2008-05-08]
+o Added getMethodS3() and getGenericS3().
+o BUG FIX: isGenericS3() and isGenericS4() gave an error if
+ a function was passed.
+
+
+Version: 1.0.1 [2008-03-06]
+o Added paper to citation("R.methodsS3").
+o BUG FIX: Regular expression pattern 'a-Z' is illegal on (at least)
+ some locale, e.g. 'C' (where 'A-z' works). The only way to specify
+ the ASCII alphabet is to list all characters explicitly, which we now
+ do in all methods of the package. See the r-devel thread
+ "invalid regular expression '[a-Z]'" on 2008-03-05 for details.
+
+
+Version: 1.0.0 [2007-09-17]
+o Created by extracting setMethodS3() and related methods from the
+ R.oo package. The purpose is to provide setMethodS3() without
+ having to load (the already lightweight) R.oo package. For
+ previous history related to the methods in this package, please
+ see the history of the R.oo package.
+
diff --git a/R/000.R b/R/000.R
new file mode 100644
index 0000000..43d4405
--- /dev/null
+++ b/R/000.R
@@ -0,0 +1,114 @@
+##############################################################################
+# This code has to come first in a library. To do this make sure this file
+# is named "000.R" (zeros).
+##############################################################################
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# NAMESPACE: export()
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# Sets attribute export to TRUE
+export <- function(x) {
+ attr(x, "export") <- TRUE;
+ x;
+}
+export <- export(export)
+
+# Sets attribute export to 'value'.
+"export<-" <- export(function(x, value) {
+ attr(x, "export") <- value;
+ x;
+})
+
+noexport <- export(function(x) {
+ attr(x, "export") <- FALSE;
+ x;
+})
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# NAMESPACE: S3method()
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# Sets attribute 'S3class' to 'value'.
+"S3class<-" <- export(function(x, value) {
+ attr(x, "S3class") <- value;
+ x;
+})
+
+
+
+# Use by setGenericS3() and setMethodS3()
+.findFunction <- function(name, envir, inherits=rep(FALSE, times=length(envir))) {
+ # Argument 'envir':
+ if (!is.list(envir)) {
+ envir <- list(envir);
+ }
+ n <- length(envir);
+
+ # Argument 'inherits':
+ inherits <- as.logical(inherits);
+ stopifnot(length(inherits) == n);
+
+ fcn <- pkg <- NULL;
+ for (kk in seq_along(envir)) {
+ env <- envir[[kk]];
+ inh <- inherits[kk];
+ if (exists(name, mode="function", envir=env, inherits=inh)) {
+ fcn <- get(name, mode="function", envir=env, inherits=inh);
+ pkg <- attr(env, "name");
+ if (is.null(pkg)) {
+ pkg <- "base"
+ if (identical(env, baseenv())) {
+ } else if (identical(env, globalenv())) {
+ pkg <- "<R_GlobalEnv>"
+ }
+ } else {
+ pkg <- gsub("^package:", "", pkg);
+ }
+ break;
+ }
+ } # for (kk ...)
+
+ list(fcn=fcn, pkg=pkg);
+} # .findFunction()
+
+
+############################################################################
+# HISTORY:
+# 2013-10-06
+# o Added .findFunction().
+# 2012-04-17
+# o Added S3class() function.
+# o Added export() and noexport() functions.
+# 2007-09-17
+# o Removed support for R v2.2.0 and before by removing patch for missing
+# baseenv().
+# 2007-04-07
+# o Removed support for R v2.0.0 and before.
+# 2006-02-09
+# o Added baseenv() for R versions (< v2.2.0) where it does not exist.
+# This is used in setGenericS3() and setMethodS3() from R v2.3.0.
+# 2005-02-15
+# o Now require() is only called for R v1.9.1 or eariler.
+# 2005-02-10
+# o Moved R.KEYWORDS into its own source file.
+# 2003-05-06
+# o Added require(methods) to make sure getMethods() etc works.
+# 2002-11-21
+# o Added "..." to R.KEYWORDS.
+# 2002-10-17
+# o Removed obsolete "modifiers<-"().
+# o Added also "Object" to the class attribute to make static methods to
+# work.
+# 2002-10-16
+# o There are times when
+# generic <- function(...) UseMethod()
+# is not working, for example
+# fcn <- get("generic"); fcn(myObj, ...);
+# For this reason, always do method dispatching using the name explicitly;
+# generic <- function(...) UseMethod("generic")
+#
+# 2002-10-15
+# o Created from R.oo Object.R and ideas as described on
+# http://www.maths.lth.se/help/R/
+############################################################################
+
diff --git a/R/001.R.KEYWORDS.R b/R/001.R.KEYWORDS.R
new file mode 100644
index 0000000..169afcd
--- /dev/null
+++ b/R/001.R.KEYWORDS.R
@@ -0,0 +1,40 @@
+###########################################################################/**
+# @eval "Rdoc$package <- 'R.methodsS3';''"
+# @RdocObject "R.KEYWORDS"
+#
+# @title "Reserved words in R not to be used for object names"
+#
+# \description{
+# @get "title". \code{R.KEYWORDS} is a @character @vector of all reserved
+# words in \R according to [1].
+# }
+#
+# @author
+#
+# \references{
+# [1] Section "Reserved words", R Language Definition, version 2.6.0
+# (2007-09-14) DRAFT.
+# }
+#
+# @keyword programming
+# @keyword internal
+#*/###########################################################################
+R.KEYWORDS <- c(
+ "break", "else", "for", "function", "if", "in", "next",
+ "repeat", "while", "TRUE", "FALSE", "Inf", "NULL", "NA", "NaN",
+ paste("NA_", c("integer", "real", "complex", "character", "_", sep="")),
+ "...", paste("..", 1:99, sep="")
+);
+export(R.KEYWORDS) <- FALSE;
+
+
+############################################################################
+# HISTORY:
+# 2007-09-17
+# o Updated. Added 'NA_<data type>_' keywords.
+# 2005-02-10
+# o Moved into its own source code file. Extracted from 000.GLOBALS.R.
+# 2002-11-21
+# o Added "..." to R.KEYWORDS.
+############################################################################
+
diff --git a/R/005.varArgs.R b/R/005.varArgs.R
new file mode 100644
index 0000000..c9a3c84
--- /dev/null
+++ b/R/005.varArgs.R
@@ -0,0 +1,41 @@
+hasVarArgs <- function(...) UseMethod("hasVarArgs");
+export(hasVarArgs) <- TRUE;
+
+hasVarArgs.function <- function(fcn, ...) {
+ if (!is.function(fcn))
+ stop("Argument 'fcn' must be a function: ", mode(fcn));
+
+ # Get the current formals
+ args <- formals(fcn);
+
+ is.element("...", names(args));
+} # hasVarArgs()
+S3class(hasVarArgs.function) <- "function";
+export(hasVarArgs.function) <- FALSE;
+
+
+appendVarArgs <- function(...) UseMethod("appendVarArgs");
+export(appendVarArgs) <- TRUE;
+
+appendVarArgs.function <- function(fcn, ...) {
+ if (hasVarArgs(fcn))
+ return(fcn);
+
+ # Get the current formals
+ args <- formals(fcn);
+ # Add '...'
+ args <- c(args, formals(function(...) {}));
+ # Set new formals
+ formals(fcn) <- args;
+
+ fcn;
+} # appendVarArgs()
+S3class(appendVarArgs.function) <- "function";
+export(appendVarArgs.function) <- FALSE;
+
+
+############################################################################
+# HISTORY:
+# 2005-02-15
+# o Created.
+############################################################################
diff --git a/R/006.fixVarArgs.R b/R/006.fixVarArgs.R
new file mode 100644
index 0000000..8b86aae
--- /dev/null
+++ b/R/006.fixVarArgs.R
@@ -0,0 +1,9 @@
+# Added '...' to some base functions. These will later be
+# turned into default functions by setMethodS3().
+
+
+############################################################################
+# HISTORY:
+# 2005-02-15
+# o Created to please R CMD check.
+############################################################################
diff --git a/R/010.setGenericS3.R b/R/010.setGenericS3.R
new file mode 100644
index 0000000..84580d9
--- /dev/null
+++ b/R/010.setGenericS3.R
@@ -0,0 +1,262 @@
+###########################################################################/**
+# @RdocDefault setGenericS3
+#
+# @title "Creates an S3 generic function"
+#
+# \description{
+# \emph{Note that this method is a internal method called by
+# @see "setMethodS3" and there is no reason for calling it directly!}\cr
+#
+# Creates a generic function in S3 style, i.e. setting a
+# function with name \code{name} that dispatches the method \code{name}
+# via \code{UseMethod}. If there is already a function named \code{name}
+# that function is renamed to \code{name.default}.
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{name}{The name of the generic function.}
+# \item{export}{A @logical setting attribute \code{"export"}.}
+# \item{envir}{The environment for where this method should be stored.}
+# \item{dontWarn}{If a non-generic method with the same name is found it
+# will be "renamed" to a default method. If that method is found in
+# a package with a name that is \emph{not} found in \code{dontWarn}
+# a warning will be produced, otherwise it will be renamed silently.}
+# \item{validators}{An optional @list of @functions that can be used
+# to assert that the generated generic function meets certain
+# criteria.}
+# \item{...}{Not used.}
+# \item{overwrite}{If @TRUE an already existing generic function with
+# the same name will be overwritten, otherwise not.}
+# }
+#
+# @examples "../incl/setGenericS3.Rex"
+#
+# \seealso{
+# To define a method for a class see @see "setMethodS3".
+# For more information about S3, see @see "base::UseMethod".
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+#*/###########################################################################
+setGenericS3.default <- function(name, export=TRUE, envir=parent.frame(), dontWarn=getOption("dontWarnPkgs"), validators=getOption("R.methodsS3:validators:setGenericS3"), overwrite=FALSE, ...) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Validate arguments
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Argument 'name':
+ if (nchar(name) == 0L) {
+ stop("Cannot set S3 generic method. Argument 'name' is empty.");
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Backward compatibility tests
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ args <- list(...);
+ if (is.element("enforceRCC", names(args))) {
+ warning("Argument 'enforceRCC' of setGenericS3() has been replaced by argument 'validators'.");
+ # Turn off validators?
+ if (args$enforceRCC == FALSE) validators <- NULL;
+ }
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 0. Define local constants and local functions
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 'get' is illegal, because if it is redefined in a package, library() will
+ # maybe load and set the new get, which is then a generic function, and the
+ # next thing it will try to get() (it uses get internally) will not be
+ # retrieved, since get.default() might not be loaded at this time, but later.
+ PROTECTED.NAMES <- c("get");
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 1. Test the definition using validators
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (!is.null(validators)) {
+ for (validator in validators) {
+ validator(name=name, envir=envir, dontWarn=dontWarn, type="setGenericS3");
+ }
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 2. Check for forbidden names
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (is.element(name, R.KEYWORDS))
+ stop("Method names must not be same as a reserved keyword in R: ", name);
+
+ if (is.element(name, PROTECTED.NAMES))
+ stop("Trying to use an unsafe generic method name (trust us, it is for a *good* reason): ", name);
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 2. Find the environment where sys.source() loads the package, which is
+ # the local variable (argument) of sys.source() named as "envir".
+ # Unfortunately, the only way we can be sure which of the parent frames
+ # are the sys.source() function frame is to compare its definition with
+ # each of the definitions of the parent frames using sys.function().
+ # Comment: sys.source() is used by library() and require() for loading
+ # packages. Also note that packages that are currently loaded are not in
+ # the search path, cf. search(), and there and standard exists() will not
+ # find it. *Not* checking the currently loading environment would *not*
+ # be harmful, but it would produce too many warnings.
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ sys.source.def <- get("sys.source", mode="function", envir=baseenv());
+ loadenv <- NULL;
+ for (framePos in sys.parents()[-1L]) {
+ if (identical(sys.source.def, sys.function(framePos))) {
+ loadenv <- parent.frame(framePos);
+ break;
+ }
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 3. Check for preexisting functions with the same name
+ # i) in the environment that we are saving to ('envir'),
+ # ii) in the currently loading environment ('loadenv'), or
+ # iii) in the environments in the search path (search()).
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ envirs <- c(envir, loadenv, lapply(search(), FUN=as.environment));
+ inherits <- rep(FALSE, times=length(envirs));
+ checkImports <- getOption("R.methodsS3:checkImports:setGenericS3", FALSE);
+ if (checkImports) inherits[1:2] <- TRUE;
+
+ fcn <- .findFunction(name, envir=envirs, inherits=inherits);
+ fcnDef <- fcn$fcn;
+ fcnPkg <- fcn$pkg;
+
+ if (!overwrite && !is.null(fcnDef)) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 4a. Is it already a generic function?
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ isGeneric <- isGenericS3(fcnDef) || isGenericS4(fcnDef);
+
+ # If it is a generic function, we are done!
+ if (isGeneric) {
+ # TO DO: Update generic functions with '...', if missing.
+ return();
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 4b. ... or, is there already a default function with the same name?
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Search for preexisting default function in the same environments as above.
+ nameDefault <- paste(name, ".default", sep="");
+ fcn <- .findFunction(nameDefault, envir=envirs, inherits=inherits);
+ defaultExists <- !is.null(fcn$fcn);
+ defaultPkg <- fcn$pkg;
+
+ if (defaultExists) {
+ warning("Could not create generic function. There is already a",
+ " non-generic function named ", name, "() in package ", fcnPkg,
+ " with the same name as an existing default function ",
+ nameDefault, "() in ", defaultPkg, ".");
+ return();
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 4c. "Rename" the function to a default function
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ assign(nameDefault, substitute(fcn, list(fcn=fcnDef)), envir=envir);
+ if (!is.element(fcnPkg, dontWarn)) {
+ warning("Renamed the preexisting function ", name, " to ",
+ nameDefault, ", which was defined in environment ", fcnPkg, ".");
+ }
+ } # if (...)
+
+ # By default all generic functions have '...' arguments
+ argsStr <- "...";
+
+ # Should argument 'value' be added?
+ isReplacementFunction <- (regexpr("<-$", name) != -1L);
+ if (isReplacementFunction) {
+ argsStr <- paste(c(argsStr, "value"), collapse=", ");
+ }
+
+ # Create a generic function
+ src <- sprintf("...tmpfcn <- function(%s) UseMethod(\"%s\")", argsStr, name);
+ src <- c(src, sprintf("R.methodsS3:::export(...tmpfcn) <- %s", export));
+ src <- c(src, sprintf("\"%s\" <- ...tmpfcn", name));
+ src <- c(src, "rm(list=\"...tmpfcn\")");
+ src <- paste(src, collapse=";\n");
+ expr <- parse(text=src);
+ eval(expr, envir=envir);
+} # setGenericS3.default()
+S3class(setGenericS3.default) <- "default";
+export(setGenericS3.default) <- FALSE;
+
+setGenericS3.default("setGenericS3"); # Creates itself ;)
+
+
+
+
+############################################################################
+# HISTORY:
+# 2014-01-04
+# o CLEANUP: Dropped obsolete argument 'ellipsesOnly' from setGenericS3().
+# It was not used internally anyway. Thanks Antonio Piccolboni for
+# reporting on this.
+# 2013-11-12
+# o BUG FIX: Generic function created by setGenericS3("foo<-") would not
+# have a last argument name 'value', which 'R CMD check' complains about.
+# 2013-11-05
+# o ROBUSTNESS: Now setGenericS3(name, ...) asserts that argument
+# 'name' is non-empty.
+# 2013-10-06
+# o CLEANUP: setGenericS3() utilizes new .findFunction().
+# 2013-10-05
+# o Now setGenericS3() fully utilizes isGenericS3().
+# o Now setGenericS3() looks for existing generic functions also in
+# imported namespaces.
+# 2012-06-17
+# o Added argument 'overwrite' to setGenericS3().
+# 2012-04-17
+# o Added argument 'export' to setMethodS3() and setGenericS3().
+# 2007-09-17
+# o Replaced 'enforceRCC' argument with more generic 'validators'.
+# 2007-06-09
+# o Removed (incorrect) argument name 'list' from all substitute() calls.
+# 2006-02-09
+# o Removed all usage of NULL environments. get(envir=NULL) is replaced
+# with get(envir=baseenv()).
+# 2005-06-14
+# o Now setGenericS3() allows a few methods that starts with a non-letter
+# as the first character. See code for details.
+# 2005-02-15
+# o Added arguments '...' in order to match any generic functions.
+# 2004-06-27
+# o Added known generic function 'as.vector()'.
+# 2003-07-07
+# o Removed obsolete argument 'force' in Rdoc.
+# 2002-11-29
+# o Updated some error messages.
+# o Now it is possible to create generic methods with one (or several)
+# . (period) as a prefix of the name. Such a method should be considered
+# private in the same manner as fields with a period are private.
+# 2002-11-28
+# o SPELL CHECK: "...name name..." in one of setGenericS3()'s error messages.
+# 2002-11-10
+# o Updated setGenericS3() to assert that the environment variable 'envir'
+# is actually the one in the frame of the sys.source() function call. This
+# is done by comparing function defintions.
+# o Changed setGenericS3() to *always* create generic functions with no
+# arguments except "...".
+# 2002-10-21
+# o Made ellipsesOnly=TRUE by default.
+# 2002-10-17
+# o Removed obsolete "modifiers<-"().
+# o Added also "Object" to the class attribute to make static methods to
+# work.
+# 2002-10-16
+# o There are times when
+# generic <- function(...) UseMethod()
+# is not working, for example
+# fcn <- get("generic"); fcn(myObj, ...);
+# For this reason, always do method dispatching using the name explicitly;
+# generic <- function(...) UseMethod("generic")
+#
+# 2002-10-15
+# o Created from R.oo Object.R and ideas as described on
+# http://www.maths.lth.se/help/R/
+############################################################################
diff --git a/R/030.setMethodS3.R b/R/030.setMethodS3.R
new file mode 100644
index 0000000..4d9fa6c
--- /dev/null
+++ b/R/030.setMethodS3.R
@@ -0,0 +1,401 @@
+###########################################################################/**
+# @RdocDefault setMethodS3
+#
+# @title "Creates an S3 method"
+#
+# \description{
+# Creates an S3 method. A function with name \code{<name>.<class>} will
+# be set to \code{definition}. The method will get the modifiers specified
+# by \code{modifiers}. If there exists no generic function for this method,
+# it will be created automatically.
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{name}{The name of the method.}
+# \item{class}{The class for which the method should be defined. If
+# \code{class == "default"} a function with name \code{<name>.default}
+# will be created.}
+# \item{definition}{The method defintion.}
+# \item{private, protected}{If \code{private=TRUE}, the method is declared
+# private. If \code{protected=TRUE}, the method is declared protected.
+# In all other cases the method is declared public.}
+# \item{export}{A @logical setting attribute \code{"export"}.}
+# \item{static}{If @TRUE this method is defined to be static,
+# otherwise not. Currently this has no effect expect as an indicator.}
+# \item{abstract}{If @TRUE this method is defined to be abstract,
+# otherwise not. Currently this has no effect expect as an indicator.}
+# \item{trial}{If @TRUE this method is defined to be a trial method,
+# otherwise not. A trial method is a method that is introduced to be
+# tried out and it might be modified, replaced or even removed in a
+# future release. Some people prefer to call trial versions, beta
+# version. Currently this has no effect expect as an indicator.}
+# \item{deprecated}{If @TRUE this method is defined to be deprecated,
+# otherwise not. Currently this has no effect expect as an indicator.}
+# \item{envir}{The environment for where this method should be stored.}
+# \item{overwrite}{If @TRUE an already existing method with the same
+# name (and of the same class) will be overwritten, otherwise not.}
+# \item{conflict}{If a method already exists with the same name (and of
+# the same class), different actions can be taken. If \code{"error"},
+# an exception will be thrown and the method will not be created.
+# If \code{"warning"}, a @warning will be given and the method \emph{will}
+# be created, otherwise the conflict will be passed unnotice.}
+# \item{createGeneric, exportGeneric}{If \code{createGeneric=TRUE},
+# a generic S3/UseMethod function is defined for this method,
+# iff missing, and \code{exportGeneric} species attribute
+# \code{"export"} of it.}
+# \item{appendVarArgs}{If @TRUE, argument \code{...} is added with a
+# warning, if missing. For special methods such as \code{$} and
+# \code{[[}, this is never done (argument is ignored).
+# This will increase the chances that the method is consistent with a
+# generic function with many arguments and/or argument \code{...}.}
+# \item{validators}{An optional @list of @functions that can be used
+# to assert that the generated method meets certain criteria.}
+# \item{...}{Passed to @see "setGenericS3", iff called.}
+# }
+#
+# @examples "../incl/setMethodS3.Rex"
+#
+# \seealso{
+# For more information about S3, see @see "base::UseMethod".
+# }
+#
+# @author
+#
+# @keyword "programming"
+# @keyword "methods"
+#*/###########################################################################
+setMethodS3.default <- function(name, class="default", definition, private=FALSE, protected=FALSE, export=FALSE, static=FALSE, abstract=FALSE, trial=FALSE, deprecated=FALSE, envir=parent.frame(), overwrite=TRUE, conflict=c("warning", "error", "quiet"), createGeneric=TRUE, exportGeneric=TRUE, appendVarArgs=TRUE, validators=getOption("R.methodsS3:validators:setMethodS3"), ...) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Validate arguments
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Argument 'name':
+ if (nchar(name) == 0L) {
+ stop("Cannot set S3 method. Argument 'name' is empty.");
+ }
+
+ # Argument 'class':
+ if (nchar(class) == 0L) {
+ stop("Cannot set S3 method. Argument 'class' is empty.");
+ }
+
+ # Argument 'conflict':
+ conflict <- match.arg(conflict);
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Backward compatibility tests
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ args <- list(...);
+ if (is.element("enforceRCC", names(args))) {
+ warning("Argument 'enforceRCC' of setGenericS3() has been replaced by argument 'validators'.");
+ # Turn off validators?
+ if (!args$enforceRCC) validators <- NULL;
+ }
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 1. Test the definition using validators
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (!is.null(validators)) {
+ for (validator in validators) {
+ validator(name=name, class=class, definition=definition, private=private, protected=protected, static=static, abstract=abstract, trial=trial, deprecated=deprecated, envir=envir, overwrite=overwrite, conflict=conflict, createGeneric=createGeneric, appendVarArgs=appendVarArgs, type="setMethodS3");
+ }
+ }
+
+ # Ignore argument 'appendVarArgs' if a "special" method
+ # or a replacement method.
+ if (appendVarArgs) {
+ # (a) Do not append '...' for the following methods
+ ignores <- c("$", "$<-", "[[", "[[<-", "[", "[<-");
+ ignores <- c(ignores, "==");
+ ignores <- c(ignores, "+", "-", "*", "/", "^", "%%", "%/%");
+ appendVarArgs <- !is.element(name, ignores);
+
+ if (appendVarArgs) {
+ # (b) Neither functions with any of these name patterns
+ ignorePatterns <- c("<-$", "^%[^%]*%$");
+ ignores <- (sapply(ignorePatterns, FUN=regexpr, name) != -1L);
+ appendVarArgs <- appendVarArgs && !any(ignores);
+ }
+ }
+
+ # Check for forbidden names.
+ if (is.element(name, R.KEYWORDS))
+ stop("Method names must not be same as a reserved keyword in R: ", name);
+
+ if (class == "ANY") class <- "default";
+
+ # Create the modifiers
+ if (private)
+ protection <- "private"
+ else if (protected)
+ protection <- "protected"
+ else
+ protection <- "public";
+
+ modifiers <- protection;
+ if (static == TRUE) modifiers <- c(modifiers, "static");
+ if (abstract == TRUE) modifiers <- c(modifiers, "abstract");
+ if (deprecated == TRUE) modifiers <- c(modifiers, "deprecated");
+ if (trial == TRUE) modifiers <- c(modifiers, "trial");
+
+ if (missing(definition) && abstract == TRUE) {
+ # Set default 'definition'.
+ src <- paste("...R.oo.definition <- function(...) stop(\"Method \\\"", name, "\\\" is defined abstract in class \\\"", class, "\\\" and has not been overridden by any of the subclasses: \", class(list(...)[[1]])[1])", sep="");
+ expr <- parse(text=src);
+
+ # If just defining a local 'definition' function, to be used below,
+ # one will get warnings "using .GlobalEnv instead of package:<pkg>"
+ # when loading the package *with lazy loading*. I do not understand
+ # the reasons for it, but here follows a trick in order to not get
+ # such warnings. It kinda borrows the 'envir' frame to define a local
+ # function. It works, but don't ask me why. /HB 2005-02-25
+ eval(expr, envir=envir);
+ definition <- get("...R.oo.definition", envir=envir);
+ rm(list="...R.oo.definition", envir=envir);
+ }
+
+
+ # Create the class method 'name':
+ methodName <- paste(name, class, sep=".");
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 2. Find the environment where sys.source() loads the package, which is
+ # the local variable (argument) of sys.source() named as "envir".
+ # Unfortunately, the only way we can be sure which of the parent frames
+ # are the sys.source() function frame is to compare its definition with
+ # each of the definitions of the parent frames using sys.function().
+ # Comment: sys.source() is used by library() and require() for loading
+ # packages. Also note that packages that are currently loaded are not in
+ # the search path, cf. search(), and there and standard exists() will not
+ # find it. *Not* checking the currently loading environment would *not*
+ # be harmful, but it would produce too many warnings.
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ sys.source.def <- get("sys.source", mode="function", envir=baseenv());
+ loadenv <- NULL;
+ for (framePos in sys.parents()[-1L]) {
+ if (identical(sys.source.def, sys.function(framePos))) {
+ loadenv <- parent.frame(framePos);
+ break;
+ }
+ }
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 3. Check for preexisting functions with the same name
+ # i) in the environment that we are saving to ('envir'),
+ # ii) in the currently loading environment ('loadenv'), or
+ # iii) in the environments in the search path (search()).
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ envirs <- c(envir, loadenv, lapply(search(), FUN=as.environment));
+ inherits <- rep(FALSE, times=length(envirs));
+ checkImports <- getOption("R.methodsS3:checkImports:setGenericS3", FALSE);
+ if (checkImports) inherits[1:2] <- TRUE;
+
+ fcn <- .findFunction(methodName, envir=envirs, inherits=inherits);
+ fcnDef <- fcn$fcn; fcnPkg <- fcn$pkg;
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 4. Append '...' if missing.
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (appendVarArgs) {
+ if (!hasVarArgs(definition)) {
+ warning("Added missing argument '...' to make it more compatible with a generic function: ", methodName);
+# definition <- appendVarArgs(definition);
+
+ # As above, to avoid "using .GlobalEnv instead of package:<pkg>"
+ # warnings, we do the below trick. /HB 2005-02-25
+ assign("...R.oo.definition", definition, envir=envir);
+ eval(substitute(fcn <- appendVarArgs(fcn), list(fcn=as.name("...R.oo.definition"))), envir=envir);
+ definition <- get("...R.oo.definition", envir=envir);
+ rm(list="...R.oo.definition", envir=envir);
+ }
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 5. Validate replacement functions (since R CMD check will complain)
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (regexpr("<-$", name) != -1L) {
+ f <- formals(definition);
+
+ fStr <- capture.output(args(definition))[[1]];
+ fStr <- sub("^[\t\n\f\r ]*", "", fStr); # trim() is not available
+ fStr <- sub("[\t\n\f\r ]*$", "", fStr); # when package loads!
+
+ if (names(f)[length(f)] != "value") {
+ ## covr: skip=2
+ stop("Last argument of a ", name,
+ "() method should be named 'value': ", fStr);
+ }
+ }
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 5b. Validate arguments for 'picky' methods.
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ pickyMethods <- list(
+ "$" = c(NA, "name"),
+ "$<-" = c(NA, "name", "value")
+ )
+
+ if (is.element(name, names(pickyMethods))) {
+ f <- formals(definition);
+
+ fStr <- capture.output(args(definition))[[1L]];
+ fStr <- sub("^[\t\n\f\r ]*", "", fStr); # trim() is not available
+ fStr <- sub("[\t\n\f\r ]*$", "", fStr); # when package loads!
+
+ reqArgs <- pickyMethods[[name]];
+ nbrOfReqArgs <- length(reqArgs);
+
+ # Check for correct number of arguments
+ if (length(f) != nbrOfReqArgs) {
+ ## covr: skip=2
+ stop("There should be exactly ", nbrOfReqArgs, " arguments of a ",
+ name, "() method: ", fStr);
+ }
+
+ for (kk in 1:nbrOfReqArgs) {
+ if (!is.na(reqArgs[kk]) && (names(f)[kk] != reqArgs[kk])) {
+ ## covr: skip=2
+ stop("Argument #", kk, " in a ", name,
+ "() method, should be named '", reqArgs[kk], "': ", fStr);
+ }
+ }
+ }
+
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 6. Assign/create the new method
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (is.null(fcnDef) || overwrite) {
+ # Create
+ expr <- substitute({
+ fcn <- definition;
+ `R.methodsS3_export<-` <- get("export<-", mode="function",
+ envir=asNamespace("R.methodsS3"), inherits=FALSE);
+ R.methodsS3_export(fcn) <- doExport;
+ rm(list="R.methodsS3_export<-");
+ attr(fcn, "S3class") <- class;
+ attr(fcn, "modifiers") <- modifiers;
+ }, list(fcn=as.name(methodName), class=class, definition=definition,
+ doExport=export, modifiers=modifiers)
+ );
+ # Assign
+ eval(expr, envir=envir);
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 7. Report that a method was redefined?
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (!is.null(fcnDef)) {
+ msg <- paste("Method already existed and was",
+ if (overwrite != TRUE) " not", " overwritten: ", sep="");
+ if (is.null(conflict))
+ conflict <- "quiet";
+ if (conflict == "quiet") {
+ } else if (conflict == "warning") {
+ warning(msg, methodName)
+ } else
+ stop(msg, methodName)
+ }
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # 8. Create a generic function?
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (createGeneric) {
+ setGenericS3(name, export=exportGeneric, envir=envir, validators=validators, ...);
+ }
+} # setMethodS3.default()
+S3class(setMethodS3.default) <- "default";
+export(setMethodS3.default) <- FALSE;
+
+setGenericS3("setMethodS3");
+
+
+############################################################################
+# HISTORY:
+# 2013-11-05
+# o ROBUSTNESS: Now setMethodS3(name, class, ...) asserts that arguments
+# 'name' and 'class' are non-empty.
+# 2013-10-06
+# o CLEANUP: setGenericS3() utilizes new .findFunction().
+# 2012-08-23
+# o No longer utilizing ':::' for "self" (i.e. R.methods3) methods.
+# 2012-06-22
+# o Now setMethodS3(..., appendVarArgs=TRUE) ignores 'appendVarArgs' if
+# the method name is "==", "+", "-", "*", "/", "^", "%%", or "%/%",
+# (in addition to "$", "$<-", "[[", "[[<-", "[", "[<-"). It will also
+# ignore it if the name matches regular expressions "<-$" or "^%[^%]*%$".
+# 2012-04-17
+# o Added argument 'exportGeneric' to setMethodS3().
+# o Added argument 'export' to setMethodS3() and setGenericS3().
+# o Now setMethodS3() sets attribute "S3class" to the class. This will
+# make S3 methods such as a.b.c() non abigous, because it will be possible
+# to infer whether the generic function is a() or a.b(). The reason for
+# not using an attribute "S3method" = c("a.b", "c") is that the generic
+# function should automaticly change if someone does d.e.c <- a.b.c.
+# 2012-03-08
+# o Now arguments '...' of setMethodS3() are passed to setGenericS3().
+# 2007-09-17
+# o Replaced 'enforceRCC' argument with more generic 'validators'.
+# 2007-06-09
+# o Removed (incorrect) argument name 'list' from all substitute() calls.
+# 2006-02-09
+# o Removed all usage of NULL environments. get(envir=NULL) is replaced
+# with get(envir=baseenv()).
+# 2005-11-23
+# o Added validation of arguments in replacement functions.
+# o Added RCC validation of arguments in 'picky' methods, e.g. $()".
+# 2005-06-14
+# o BUG FIX: Argument 'enforceRCC' was not passed to setGenericS3().
+# 2005-02-28
+# o Now appendVarArgs is ignore if replacement function, i.e. named "nnn<-".
+# 2005-02-25
+# o Tracked down the source of "using .GlobalEnv instead of package:<pkg>"
+# warnings. They occured when defining abstract methods. They also occured
+# when automatically adding missing '...' arguments. Made an ad hoc fix
+# for this, which I do not really understand why it works, or rather why
+# it did not work before.
+# 2005-02-20
+# o Abstract methods are now defined with '...' as the only argument(s).
+# This will please R CMD check for some methods, e.g. open().
+# 2005-02-15
+# o Added argument 'addVarArgs' if missing.
+# o Added arguments '...' in order to match any generic functions.
+# 2003-04-24
+# o From R v1.7.0, 'if (vector == scalar)' gives a warning. Had to do
+# conflict <- match.arg(conflict), which is more correct.
+# 2003-01-18
+# o Replaced all occurences of getClass() with data.class(). Will change
+# the use of getClass() in the future to return a Class object.
+# 2002-12-05
+# o Spell correction in error message.
+# 2002-12-02
+# o Change to argument 'overwrite=TRUE'.
+# 2002-12-01
+# o Added argument 'overwrite=FALSE' and 'conflict=c("error", "warning",
+# "quiet")' to setMethodS3().
+# 2002-11-29
+# o Updated some error messages.
+# o Now it is possible to create methods (also generic) with one (or several)
+# . (period) as a prefix of the name. Such a method should be considered
+# private in the same manner as fields with a period are private.
+# 2002-10-17
+# o Removed obsolete "modifiers<-"().
+# o Added also "Object" to the class attribute to make static methods to
+# work.
+# 2002-10-16
+# o There are times when
+# generic <- function(...) UseMethod()
+# is not working, for example
+# fcn <- get("generic"); fcn(myObj, ...);
+# For this reason, always do method dispatching using the name explicitly;
+# generic <- function(...) UseMethod("generic")
+# 2002-10-15
+# o Created from R.oo Object.R and ideas as described on
+# http://www.maths.lth.se/help/R/
+############################################################################
diff --git a/R/999.NonDocumentedObjects.R b/R/999.NonDocumentedObjects.R
new file mode 100644
index 0000000..b8fd2a9
--- /dev/null
+++ b/R/999.NonDocumentedObjects.R
@@ -0,0 +1,37 @@
+###########################################################################/**
+# @RdocDocumentation "Non-documented objects"
+#
+# % Utility functions
+# @alias appendVarArgs
+# @alias appendVarArgs.function
+# @alias hasVarArgs
+# @alias hasVarArgs.function
+#
+# % Basic validators
+# @alias rccValidateFunctionName
+# @alias rccValidateSetGenericS3
+# @alias rccValidateSetMethodS3
+#
+# \description{
+# This page contains aliases for all "non-documented" objects that
+# \code{R CMD check} detects in this package.
+#
+# Almost all of them are \emph{generic} functions that have specific
+# document for the corresponding method coupled to a specific class.
+# Other functions are re-defined by \code{setMethodS3()} to
+# \emph{default} methods. Neither of these two classes are non-documented
+# in reality.
+# The rest are deprecated methods.
+# }
+#
+# @author
+#
+# @keyword internal
+#*/###########################################################################
+
+############################################################################
+# HISTORY:
+# 2005-02-10
+# o Created to please R CMD check.
+############################################################################
+
diff --git a/R/999.package.R b/R/999.package.R
new file mode 100644
index 0000000..d815d36
--- /dev/null
+++ b/R/999.package.R
@@ -0,0 +1,50 @@
+#########################################################################/**
+# @RdocPackage R.methodsS3
+#
+# \description{
+# @eval "packageDescription('R.methodsS3')$Description"
+# This contents of this package was extracted from the
+# \pkg{R.oo} package [1].
+# }
+#
+# \section{Installation and updates}{
+# To install this package do\cr
+#
+# \code{install.packages("R.methodsS3")}
+#
+# To get the "devel" version, see \url{http://www.braju.com/R/}.
+# }
+#
+# \section{Dependancies and other requirements}{
+# This package only requires a standard \R installation.
+# }
+#
+# \section{To get started}{
+# To get started, see:
+# \enumerate{
+# \item @see "setMethodS3" - Simple and safe creation of S3 methods
+# and, whenever needed, automatic creation of S3 generic function.
+# }
+# }
+#
+# \section{Further readings}{
+# For a detailed introduction to the package, see [1].
+# }
+#
+# \section{How to cite this package}{
+# Whenever using this package, please cite [1] as\cr
+#
+# @howtocite "R.methodsS3"
+# }
+#
+# @author
+#
+# \section{License}{
+# The releases of this package is licensed under
+# LGPL version 2.1 or newer.
+# }
+#
+# \references{
+# [1] @include "../incl/BengtssonH_2003.bib.Rdoc" \cr
+# }
+#*/#########################################################################
diff --git a/R/findDispatchMethodsS3.R b/R/findDispatchMethodsS3.R
new file mode 100644
index 0000000..818e9fb
--- /dev/null
+++ b/R/findDispatchMethodsS3.R
@@ -0,0 +1,129 @@
+###########################################################################/**
+# @RdocDefault findDispatchMethodsS3
+#
+# @title "Finds the S3 methods that a generic function would call"
+#
+# \description{
+# @get "title", ordered according to an S3 @see "base::class" @vector.
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{methodName}{A @character string specifying the name of a
+# generic function.}
+# \item{classNames}{A @character @vector of @see "base::class" names.}
+# \item{firstOnly}{If @TRUE, only the first method is returned.}
+# \item{...}{Not used.}
+# }
+#
+# \value{
+# Returns a names @list structure.
+# }
+#
+# \seealso{
+# @see "getDispatchMethodS3".
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+# @keyword internal
+#*/###########################################################################
+setMethodS3("findDispatchMethodsS3", "default", function(methodName, classNames, firstOnly=FALSE, ...) {
+ # Argument 'methodName':
+ methodName <- as.character(methodName);
+ if (length(methodName) == 0) {
+ throw("Argument 'methodName' is empty.");
+ }
+ if (length(methodName) > 1) {
+ throw("Argument 'methodName' must only contain one element: ", paste(head(methodName), collapse=", "));
+ }
+
+ # Argument 'classNames':
+ classNames <- as.character(classNames);
+ if (length(classNames) == 0) {
+ throw("Argument 'classNames' is empty.");
+ }
+
+ # Argument 'firstOnly':
+ firstOnly <- as.logical(firstOnly);
+
+
+ res <- list();
+ for (kk in seq_along(classNames)) {
+ className <- classNames[kk];
+ fcnName <- paste(methodName, className, sep=".");
+ obj <- do.call(getAnywhere, list(fcnName));
+ if (length(obj$objs) == 0) {
+ # No matching objects
+ next;
+ }
+
+ # WORKAROUND: In R (< 3.1.?) there is a bug in getAnywhere()
+ # causing it to return garbage in parts of the 'objs' list.
+ hasBug <- (length(obj$objs) > length(obj$where))
+ if (hasBug) {
+ ## Rebuild 'objs' manually
+ n <- length(obj$where)
+ obj$objs <- vector("list", length=n)
+ for (ii in seq_len(n)) {
+ where <- obj$where[[ii]]
+ tryCatch({
+ if (grepl("^namespace:", where)) {
+ env <- asNamespace(gsub("^namespace:", "", where))
+ } else {
+ env <- as.environment(where)
+ }
+ if (exists(fcnName, envir=env)) {
+ obj$objs[[ii]] <- get(fcnName, envir=env)
+ }
+ }, error = function(ex) {})
+ } # for (ii ...)
+ }
+
+ # Keep only functions
+ keep <- which(sapply(obj$objs, FUN=is.function));
+ if (length(keep) == 0) {
+ # No functions
+ next;
+ }
+
+ # Keep the first function
+ first <- keep[1];
+ fcn <- obj$objs[[first]];
+ where <- obj$where[first];
+
+ resKK <- list();
+ resKK$class <- className;
+ resKK$name <- methodName;
+ resKK$fullname <- fcnName;
+ resKK$fcn <- fcn;
+ resKK$where <- obj$where;
+
+ res[[className]] <- resKK;
+
+ # Return only the first match?
+ if (firstOnly) {
+ break;
+ }
+ } # for (kk ...)
+
+ res;
+}, private=TRUE) # findDispatchMethodsS3()
+
+
+############################################################################
+# HISTORY:
+# 2015-02-02
+# o WORKAROUND: In R (< 3.1.?) there is a bug in getAnywhere() causing it
+# to return garbage in parts of the 'objs' list. This bug has been
+# there all the time, but was only detected now when a package test
+# for findDispatchMethodsS3() was added.
+# 2010-12-02
+# o Added Rdoc comments.
+# o Made findDispatchMethodsS3() a default method.
+# 2009-11-20
+# o Added findDispatchMethodsS3().
+############################################################################
diff --git a/R/getDispatchMethodS3.R b/R/getDispatchMethodS3.R
new file mode 100644
index 0000000..df361d2
--- /dev/null
+++ b/R/getDispatchMethodS3.R
@@ -0,0 +1,50 @@
+###########################################################################/**
+# @RdocDefault getDispatchMethodS3
+#
+# @title "Gets the S3 method that a generic function would call"
+#
+# \description{
+# @get "title" according to an S3 @see "base::class" @vector.
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{methodName}{A @character string specifying the name of a
+# generic function.}
+# \item{classNames}{A @character @vector of @see "base::class" names.}
+# \item{...}{Not used.}
+# }
+#
+# \value{
+# Returns a @function, or throws an exception if not found.
+# }
+#
+# \seealso{
+# @see "findDispatchMethodsS3".
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+# @keyword internal
+#*/###########################################################################
+setMethodS3("getDispatchMethodS3", "default", function(methodName, classNames, ...) {
+ res <- findDispatchMethodsS3(methodName, classNames, firstOnly=TRUE, ...);
+ if (length(res) == 0) {
+ throw(sprintf("No method %s() for this class structure: %s", methodName, paste(classNames, collapse=", ")));
+ }
+
+ res[[1]]$fcn;
+}, private=TRUE)
+
+
+############################################################################
+# HISTORY:
+# 2010-12-02
+# o Added Rdoc comments.
+# o Made getDispatchMethodS3() a default method.
+# 2009-11-20
+# o Added getDispatchMethodS3().
+############################################################################
diff --git a/R/getGenericS3.R b/R/getGenericS3.R
new file mode 100644
index 0000000..bcf7559
--- /dev/null
+++ b/R/getGenericS3.R
@@ -0,0 +1,55 @@
+###########################################################################/**
+# @RdocDefault getGenericS3
+#
+# @title "Gets an S3 generic function"
+#
+# \description{
+# @get "title".
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{name}{The name of the generic function.}
+# \item{envir}{The @environment from which the search for the
+# generic @function is done.}
+# \item{inherits}{A @logical specifying whether the enclosing frames
+# should be searched or not.}
+# \item{...}{Not used.}
+# }
+#
+# \seealso{
+# @see "setGenericS3".
+# @see "getMethodS3".
+# @see "isGenericS3".
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+#*/###########################################################################
+setMethodS3("getGenericS3", "default", function(name, envir=parent.frame(), inherits=TRUE, ...) {
+ fcn <- .findFunction(name, envir=envir, inherits=inherits)$fcn;
+ if (is.null(fcn)) {
+ throw("No such function found: ", name);
+ } else if (!isGenericS3(fcn)) {
+ throw("The function found is not an S3 generic function: ", name);
+ }
+ fcn;
+})
+
+
+
+############################################################################
+# HISTORY:
+# 2013-10-06
+# o Now getGenericS3() uses .findFunction().
+# 2013-10-05
+# o Added argument 'inherits' to getGenericS3().
+# 2010-09-18
+# o BUG FIX: getGenericS3() failed to locate generic functions created
+# in the global enviroment.
+# 2008-05-08
+# o Added getGenericS3().
+############################################################################
diff --git a/R/getMethodS3.R b/R/getMethodS3.R
new file mode 100644
index 0000000..120d5f4
--- /dev/null
+++ b/R/getMethodS3.R
@@ -0,0 +1,47 @@
+###########################################################################/**
+# @RdocDefault getMethodS3
+#
+# @title "Gets an S3 method"
+#
+# \description{
+# @get "title".
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{name}{The name of the method.}
+# \item{class}{The class of the method.}
+# \item{envir}{The @environment from which the search for the
+# S3 method is done.}
+# \item{...}{Not used.}
+# }
+#
+# \seealso{
+# This is just a conveniency wrapper around @see "utils::getS3method"
+# that have arguments consistent with @see "setMethodS3".
+# @see "getGenericS3".
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+#*/###########################################################################
+setMethodS3("getMethodS3", "default", function(name, class="default", envir=parent.frame(), ...) {
+ args <- list(name, class=class, optional=FALSE);
+ do.call(getS3method, args, envir=envir);
+})
+
+
+
+############################################################################
+# HISTORY:
+# 2011-11-17
+# o CLEANUP: Dropped example(getMethodS3), which was for setMethodS3().
+# 2010-09-18
+# o BUG FIX: getMethodS3() failed to locate S3 methods created in the
+# global enviroment.
+# 2008-05-08
+# o Added getMethodS3().
+############################################################################
diff --git a/R/isGenericS3.R b/R/isGenericS3.R
new file mode 100644
index 0000000..7ebe5bc
--- /dev/null
+++ b/R/isGenericS3.R
@@ -0,0 +1,209 @@
+###########################################################################/**
+# @RdocDefault isGenericS3
+#
+# @title "Checks if a function is a S3 generic function"
+#
+# \description{
+# @get "title".
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{fcn}{A @function or a @character string.}
+# \item{envir}{If argument \code{fcn} is a @character, this is the
+# @environment from which the search for the @function is done.}
+# \item{...}{Not used.}
+# }
+#
+# \details{
+# A function is considered to be a generic S3/UseMethod function if
+# its name matches one of the known S3 generic functions, or if it
+# calls \code{UseMethod()}.
+# }
+#
+# \value{
+# Returns @TRUE if a generic S3/UseMethod function, otherwise @FALSE.
+# }
+#
+# @author
+#
+# @keyword programming
+# @keyword methods
+#*/###########################################################################
+isGenericS3.default <- function(fcn, envir=parent.frame(), ...) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Local functions
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ knownInternalGenericS3 <- function(fcn, which=1:4, ...) {
+ knownGenerics <- NULL;
+
+ # Get the name of all known S3 generic functions
+ if (any(which == 1L)) {
+ knownGenerics <- c(knownGenerics, names(.knownS3Generics));
+ }
+
+ if (any(which == 2L)) {
+ knownGenerics <- c(knownGenerics, .S3PrimitiveGenerics);
+ }
+
+ # tools:::.get_internal_S3_generics() if available
+ if (any(which == 3L)) {
+ ns <- getNamespace("tools")
+ if (exists(".get_internal_S3_generics", envir=ns, inherits=FALSE)) {
+ names <- get(".get_internal_S3_generics", envir=ns, inherits=FALSE)();
+ knownGenerics <- c(knownGenerics, names);
+ }
+ }
+
+ # Manually added, cf. ?cbind
+ if (any(which == 4L)) {
+ names <- c("cbind", "rbind");
+ knownGenerics <- c(knownGenerics, names);
+ }
+
+ # Is it one of the known S3 generic functions?
+ knownGenerics <- unique(knownGenerics);
+
+ knownGenerics;
+ } # knownInternalGenericS3()
+
+ isNameInternalGenericS3 <- function(fcn, ...) {
+ is.element(fcn, knownInternalGenericS3());
+ } # isNameInternalGenericS3()
+
+ isPrimitive <- function(fcn, ...) {
+ switch(typeof(fcn), special=TRUE, builtin=TRUE, FALSE)
+ } # isPrimitive()
+
+
+ if (is.character(fcn)) {
+ if (isNameInternalGenericS3(fcn)) return(TRUE);
+
+ # Get the function
+ fcn <- .findFunction(fcn, envir=envir, inherits=TRUE)$fcn;
+
+ # Does it even exist?
+ if (is.null(fcn)) {
+ return(FALSE);
+ }
+ }
+
+ # Check with codetools::findGlobals(), if available,
+ # otherwise scan the body
+ res <- tryCatch({
+ ns <- getNamespace("codetools");
+ findGlobals <- get("findGlobals", mode="function", envir=ns);
+ fcns <- findGlobals(fcn, merge=FALSE)$functions;
+ is.element("UseMethod", fcns);
+ }, error = function(ex) {
+ # Scan the body of the function
+ body <- body(fcn);
+ if (is.call(body))
+ body <- deparse(body);
+ body <- as.character(body);
+ (length(grep("UseMethod[(]", body)) > 0L);
+ });
+ if (isTRUE(res)) return(TRUE);
+
+ # Check primitive functions
+ if (isPrimitive(fcn)) {
+ # Scan the body of the function
+ body <- deparse(fcn);
+ call <- grep(".Primitive[(]", body, value=TRUE);
+ call <- gsub(".Primitive[(]\"", "", call);
+ call <- gsub("\"[)].*", "", call);
+ if (is.element(call, knownInternalGenericS3(2L))) return(TRUE);
+ }
+
+ # Finally, compare to all known internal generics
+ for (name in knownInternalGenericS3()) {
+ if (exists(name, mode="function", inherits=TRUE)) {
+ generic <- get(name, mode="function", inherits=TRUE);
+ if (identical(fcn, generic)) return(TRUE);
+ }
+ }
+
+ FALSE;
+}
+S3class(isGenericS3.default) <- "default";
+export(isGenericS3.default) <- FALSE;
+
+setGenericS3("isGenericS3");
+
+
+
+###########################################################################/**
+# @RdocDefault isGenericS4
+#
+# @title "Checks if a function is a S4 generic function"
+#
+# \description{
+# @get "title".
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{fcn}{A @function or a @character string.}
+# \item{...}{Not used.}
+# }
+#
+# \details{
+# A function is considered to be a generic S4 function if its
+# body, that is the source code, contains the regular pattern
+# \code{"standardGeneric"}.
+# }
+#
+# \value{
+# Returns @TRUE if a generic S4 function, otherwise @FALSE.
+# }
+#
+# @author
+#
+# @keyword "programming"
+# @keyword "methods"
+# @keyword "internal"
+#*/###########################################################################
+isGenericS4.default <- function(fcn, envir=parent.frame(), ...) {
+ if (is.character(fcn)) {
+ if (!exists(fcn, mode="function", envir=envir, inherits=TRUE)) {
+ return(FALSE);
+ }
+ fcn <- get(fcn, mode="function", envir=envir, inherits=TRUE);
+ }
+ body <- body(fcn);
+ if (is.call(body))
+ body <- deparse(body);
+ body <- as.character(body);
+ return(length(grep("standardGeneric", body)) > 0)
+}
+S3class(isGenericS4.default) <- "default";
+export(isGenericS4.default) <- FALSE;
+
+setGenericS3("isGenericS4");
+
+
+
+############################################################################
+# HISTORY:
+# 2015-01-13
+# o CONSISTENCY: Now isGenericS4() returns FALSE for non-existing
+# functions, just as isGenericS3() does.
+# o BUG FIX: isGenericS3() on a function gave error "object 'Math' of
+# mode 'function' was not found" when the 'methods' package was not
+# loaded, e.g. Rscript -e "R.methodsS3::isGenericS3(function(...) NULL)".
+# 2013-10-05
+# o ROBUSTNESS: Now isGenericS3() also compares to known generic functions
+# in the 'base' package. It also does a better job on checking whether
+# the function calls UseMethod() or not.
+# 2010-09-18
+# o BUG FIX: isGenericS3() and isGenericS4() did not support specifying
+# the function by name as a character string, despite it was documented
+# to do so. Thanks John Oleynick for reporting on this.
+# 2004-10-18
+# o Added Rdoc comments for isGenericS3() and isGenericS4().
+# 2002-10-15
+# o Created from R.oo Object.R and ideas as described on
+# http://www.maths.lth.se/help/R/
+############################################################################
diff --git a/R/pkgStartupMessage.R b/R/pkgStartupMessage.R
new file mode 100644
index 0000000..8399e1c
--- /dev/null
+++ b/R/pkgStartupMessage.R
@@ -0,0 +1,88 @@
+#########################################################################/**
+# @RdocDefault pkgStartupMessage
+#
+# @title "Generates a (package) startup message"
+#
+# \description{
+# @get "title".
+# Contrary to @see "base::packageStartupMessage", this method does
+# \emph{not} output a message when \code{library()/require()} is
+# called with argument \code{quietly=TRUE}.
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{...}{Arguments passed to @see "base::packageStartupMessage".}
+# \item{quietly}{If @FALSE, the message is outputed, otherwise not.
+# If @NA, the message is \emph{not} outputted if @see "base::library"
+# (or \code{require()}) was called with argument \code{quietly=TRUE}.}
+# }
+#
+# \value{
+# Returns nothing.
+# }
+#
+# @author
+#
+# \seealso{
+# @see "base::packageStartupMessage".
+# }
+#
+# @keyword internal
+#*/#########################################################################
+setMethodS3("pkgStartupMessage", "default", function(..., quietly=NA) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Infer 'quietly' from argument 'argument' in library() call?
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ if (is.na(quietly)) {
+ quietly <- FALSE;
+
+ # Just in case the below won't work one day due to R updates...
+ tryCatch({
+ # The default, if not found
+ quietly <- formals(base::library)$quietly;
+
+ # Identify the environment/frame of interest by making sure
+ # it at least contains all the arguments of source().
+ argsToFind <- names(formals(base::library));
+
+ # Scan the call frames/environments backwards...
+ srcfileList <- list();
+ for (ff in sys.nframe():0) {
+ env <- sys.frame(ff);
+
+ # Does the environment look like a library() environment?
+ exist <- sapply(argsToFind, FUN=exists, envir=env, inherits=FALSE);
+ if (!all(exist)) {
+ # Nope, then skip to the next one
+ next;
+ }
+
+ # Was argument 'quietly' specified?
+ missing <- eval(expression(missing(quietly)), envir=env);
+ if (!missing) {
+ quietly <- get("quietly", envir=env, inherits=FALSE);
+ break;
+ }
+
+ # ...otherwise keep searching due to nested library() calls.
+ } # for (ff ...)
+ }, error = function() {});
+ } # if (is.na(quietly)
+
+
+ # Output message?
+ if (!quietly) {
+ packageStartupMessage(...);
+ }
+}, protected=TRUE)
+
+## startupMessage <- pkgStartupMessage
+## startupMessage.default <- pkgStartupMessage.default
+
+############################################################################
+# HISTORY:
+# 2013-08-29
+# o Added pkgStartupMessage().
+############################################################################
diff --git a/R/rccValidators.R b/R/rccValidators.R
new file mode 100644
index 0000000..cad2cf1
--- /dev/null
+++ b/R/rccValidators.R
@@ -0,0 +1,39 @@
+rccValidateFunctionName <- function(name, ...) {
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Validate 'name'
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Assert that the generic function name is a valid function name.
+ firstLetter <- substring(gsub("^[.]*", "", name), 1,1);
+
+ allowedFirst <- c("?", "$", "$<-", "[", "[<-", "[[", "[[<-");
+ allowedFirst <- c(allowedFirst, "+", "-", "*", "^", "%");
+ if (!is.element(firstLetter, allowedFirst)) {
+ if (!is.element(tolower(firstLetter), letters))
+ throw("Except for a few operators, method/function names must begin with a letter: ", name);
+
+ # Check first letter
+ if (firstLetter == toupper(firstLetter))
+ throw("Method/function names should start with a lower case letter: ", name);
+ }
+}
+export(rccValidateFunctionName) <- FALSE;
+
+rccValidateSetMethodS3 <- function(name, ...) {
+ rccValidateFunctionName(name=name)
+}
+export(rccValidateSetMethodS3) <- FALSE;
+
+rccValidateSetGenericS3 <- function(name, ...) {
+ rccValidateFunctionName(name=name)
+}
+export(rccValidateSetGenericS3) <- FALSE;
+
+
+############################################################################
+# HISTORY:
+# 2012-06-22
+# o Now rccValidateFunctionName() also accepts names starting with
+# symbols "+", "-", "*", "^", and "%".
+# 200x-xx-xx
+# o Created.
+############################################################################
diff --git a/R/throw.default.R b/R/throw.default.R
new file mode 100644
index 0000000..60a031d
--- /dev/null
+++ b/R/throw.default.R
@@ -0,0 +1,63 @@
+###########################################################################/**
+# @RdocDefault throw
+#
+# @title "Throws an exception"
+#
+# \description{
+# Throws an exception by calling stop().
+#
+# Note that \code{throw()} can be defined for specific classes, which can
+# then be caught (or not) using \code{\link[base:conditions]{tryCatch}}().
+#
+# \emph{This default function will be overridden by ditto in the \pkg{R.oo}
+# package, if that is loaded. The latter @see "R.oo::throw" implementation
+# is fully backward compatible with this one, but the error object thrown
+# is of class @see "R.oo::Exception".}
+# }
+#
+# @synopsis
+#
+# \arguments{
+# \item{...}{One or several strings that are concatenated and collapsed
+# into on message string.}
+# }
+#
+# \value{
+# Returns nothing.
+# }
+#
+# @examples "../incl/throw.Rex"
+#
+# @author
+#
+# \keyword{error}
+#*/###########################################################################
+setMethodS3("throw", "default", function(...) {
+ stop(...);
+})
+
+
+
+############################################################################
+# HISTORY:
+# 2005-09-17
+# o Added to R.methodsS3 since it is so commonly used by my packages.
+# 2005-02-20
+# o Updated broken link to tryCatch().
+# 2005-02-10
+# o Making use of tryCatch() only.
+# 2002-10-17
+# o Now throw() always throws an Exception.
+# 2002-05-25
+# * Bug fix in Rd \examples{}. Forgot a comment.
+# 2002-04-21
+# * Redefined throw.default() so it takes several arguments, which are then
+# pasted together with sep="". In other words, instead of doing
+# stop(paste("bla bla", "value:", x, ".\n", sep=""))
+# one can just do
+# throw("bla bla", "value:", x, ".\n")
+# This is also a step towards the new exception model that supports
+# classes.
+# * Extract the throw() functions from trycatch.R, which relies on them, but
+# the throw()'s are stand-alone.
+############################################################################
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..e2e95d4
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,9 @@
+## covr: skip=all
+
+.onAttach <- function(libname, pkgname) {
+ pd <- utils::packageDescription(pkgname)
+ msg <- sprintf("%s v%s", pkgname, pd$Version)
+ if (!is.null(pd$Date)) msg <- sprintf("%s (%s)", msg, pd$Date)
+ msg <- sprintf("%s successfully loaded. See ?%s for help.", msg, pkgname)
+ pkgStartupMessage(msg)
+}
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 53fb4d7..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
- sh ./run-unit-test
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 3996d88..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,21 +0,0 @@
-r-cran-r.methodss3 (1.7.1-1) unstable; urgency=medium
-
- * New upstream version
- * cme fix dpkg-control
- * Fix autopkgtest
-
- -- Andreas Tille <tille at debian.org> Thu, 28 Apr 2016 12:08:42 +0200
-
-r-cran-r.methodss3 (1.7.0-1) unstable; urgency=medium
-
- * New upstream version
- * cme fix dpkg-control
- * Add autopkg test
-
- -- Andreas Tille <tille at debian.org> Sat, 04 Jul 2015 12:02:32 +0200
-
-r-cran-r.methodss3 (1.6.1-1) unstable; urgency=low
-
- * Initial release (Closes: #751151)
-
- -- Andreas Tille <tille at debian.org> Tue, 10 Jun 2014 21:42:03 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index be40f35..0000000
--- a/debian/control
+++ /dev/null
@@ -1,26 +0,0 @@
-Source: r-cran-r.methodss3
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9),
- cdbs,
- r-base-dev (>= 3.0.0)
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-r.methodss3/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-r.methodss3/trunk/
-Homepage: http://cran.r-project.org/web/packages/R.methodsS3/
-
-Package: r-cran-r.methodss3
-Architecture: any
-Depends: ${shlibs:Depends},
- ${R:Depends}
-Description: GNU R utility function for defining S3 methods
- Methods that simplify the setup of S3 generic functions and S3 methods.
- Major effort has been made in making definition of methods as simple as
- possible with a minimum of maintenance for package developers. For
- example, generic functions are created automatically, if missing, and
- naming conflict are automatically solved, if possible. The method
- setMethodS3() is a good start for those who in the future may want to
- migrate to S4. This is a cross-platform package implemented in pure R
- that generates standard S3 methods.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 395f0ee..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,22 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: R.methodsS3
-Upstream-Contact: Henrik Bengtsson <henrikb at braju.com>
-Source: http://cran.r-project.org/web/packages/R.methodsS3/
-
-Files: *
-Copyright: 2012-2014 Henrik Bengtsson
-License: LGPL-2.1+
-Comment: The CRAN policy is to encourage package authors to no include
- the license text "to save space". We as in Debian are aware that this
- is illegal strictly speaking but it seems we will not solve this issue
- package wise with every single package author. The better solution
- would be to form an Debian R team which should discuss this with CRAN
- maintainers in general.
-
-Files: debian/*
-Copyright: 2014 Andreas Tille <tille at debian.org>
-License: LGPL-2.1+
-
-License: LGPL-2.1+
- On Debian GNU/Linux system you can find the complete text of the
- LGPL license in '/usr/share/common-licenses/LGPL-2.1'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 0161555..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/usr/bin/make -f
-# -*- makefile -*-
-# debian/rules file for the Debian/GNU Linux r-cran-r.methodss3 package
-# Copyright 2014 by Andreas Tille <tille at debian.org>
-
-include /usr/share/R/debian/r-cran.mk
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index d2aa55a..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 3725b80..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/bin/sh -e
-
-oname=R.methodsS3
-pkg=r-cran-`echo $oname | tr '[A-Z]' '[a-z]'`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-find . -name "*.gz" -exec gunzip \{\} \;
-for rfile in *.[rR] ; do
- R CMD BATCH $rfile
-done
-rm -fr $ADTTMP/*
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 9eea72a..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,2 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/R.methodsS3_([-\d.]*)\.tar\.gz
diff --git a/inst/CITATION b/inst/CITATION
new file mode 100644
index 0000000..bd4871d
--- /dev/null
+++ b/inst/CITATION
@@ -0,0 +1,30 @@
+citHeader("Please cite R.oo/R.methodsS3 as");
+
+citEntry(
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # BibTeX entry:
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ entry="InProceedings",
+ author = "Henrik Bengtsson",
+ title = "The {R.oo} package - Object-Oriented Programming with References Using Standard {R} Code",
+ booktitle = "Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)",
+ year = "2003",
+ editor = "Kurt Hornik and Friedrich Leisch and Achim Zeileis",
+ address = "Vienna, Austria",
+ month = "March",
+ issn = "1609-395X",
+ url = "http://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf",
+ howpublished = "http://www.r-project.org/conferences/DSC-2003/Proceedings/",
+
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ # Plain-text citation:
+ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ textVersion = paste(sep="",
+ "Bengtsson, H. ",
+ "The R.oo package - Object-Oriented Programming with References Using Standard R Code, ",
+ "Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ",
+ "ISSN 1609-395X, ",
+ "Hornik, K.; Leisch, F. & Zeileis, A. (ed.), ",
+ "2003"
+ )
+);
diff --git a/man/Non-documented_objects.Rd b/man/Non-documented_objects.Rd
new file mode 100644
index 0000000..4918471
--- /dev/null
+++ b/man/Non-documented_objects.Rd
@@ -0,0 +1,41 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% 999.NonDocumentedObjects.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{Non-documented objects}
+\alias{Non-documented objects}
+\title{Non-documented objects}
+
+
+% Utility functions
+\alias{appendVarArgs}
+\alias{appendVarArgs.function}
+\alias{hasVarArgs}
+\alias{hasVarArgs.function}
+
+% Basic validators
+\alias{rccValidateFunctionName}
+\alias{rccValidateSetGenericS3}
+\alias{rccValidateSetMethodS3}
+
+\description{
+ This page contains aliases for all "non-documented" objects that
+ \code{R CMD check} detects in this package.
+
+ Almost all of them are \emph{generic} functions that have specific
+ document for the corresponding method coupled to a specific class.
+ Other functions are re-defined by \code{setMethodS3()} to
+ \emph{default} methods. Neither of these two classes are non-documented
+ in reality.
+ The rest are deprecated methods.
+}
+
+\author{Henrik Bengtsson}
+
+
+\keyword{documentation}
+\keyword{internal}
diff --git a/man/R.KEYWORDS.Rd b/man/R.KEYWORDS.Rd
new file mode 100644
index 0000000..3249481
--- /dev/null
+++ b/man/R.KEYWORDS.Rd
@@ -0,0 +1,30 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% 001.R.KEYWORDS.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+\name{R.KEYWORDS}
+\alias{R.KEYWORDS}
+
+\title{Reserved words in R not to be used for object names}
+
+\description{
+ Reserved words in R not to be used for object names. \code{R.KEYWORDS} is a \code{\link[base]{character}} \code{\link[base]{vector}} of all reserved
+ words in \R according to [1].
+}
+
+\author{Henrik Bengtsson}
+
+\references{
+ [1] Section "Reserved words", R Language Definition, version 2.6.0
+ (2007-09-14) DRAFT.
+}
+
+
+
+\keyword{programming}
+\keyword{internal}
diff --git a/man/R.methodsS3-package.Rd b/man/R.methodsS3-package.Rd
new file mode 100644
index 0000000..418db56
--- /dev/null
+++ b/man/R.methodsS3-package.Rd
@@ -0,0 +1,71 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% 999.package.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{R.methodsS3-package}
+\alias{R.methodsS3-package}
+\alias{R.methodsS3}
+\docType{package}
+
+\title{Package R.methodsS3}
+
+
+\description{
+ Methods that simplify the setup of S3 generic functions and S3 methods. Major effort has been made in making definition of methods as simple as possible with a minimum of maintenance for package developers. For example, generic functions are created automatically, if missing, and naming conflict are automatically solved, if possible. The method setMethodS3() is a good start for those who in the future may want to migrate to S4. This is a cross-platform package implemented in pure R [...]
+ This contents of this package was extracted from the
+ \pkg{R.oo} package [1].
+}
+
+\section{Installation and updates}{
+ To install this package do\cr
+
+ \code{install.packages("R.methodsS3")}
+
+ To get the "devel" version, see \url{http://www.braju.com/R/}.
+}
+
+\section{Dependancies and other requirements}{
+ This package only requires a standard \R installation.
+}
+
+\section{To get started}{
+ To get started, see:
+ \enumerate{
+ \item \code{\link{setMethodS3}}() - Simple and safe creation of S3 methods
+ and, whenever needed, automatic creation of S3 generic function.
+ }
+}
+
+\section{Further readings}{
+ For a detailed introduction to the package, see [1].
+}
+
+\section{How to cite this package}{
+ Whenever using this package, please cite [1] as\cr
+
+ \preformatted{
+Bengtsson, H. The R.oo package - Object-Oriented Programming with References Using
+Standard R Code, Proceedings of the 3rd International Workshop on Distributed
+Statistical Computing (DSC 2003), ISSN 1609-395X, Hornik, K.; Leisch, F. & Zeileis,
+A. (ed.), 2003
+}
+\emph{}
+
+}
+
+\author{Henrik Bengtsson}
+
+\section{License}{
+ The releases of this package is licensed under
+ LGPL version 2.1 or newer.
+}
+
+\references{
+ [1] H. Bengtsson, \emph{The R.oo package - Object-Oriented Programming with References Using Standard R Code}, In Kurt Hornik, Friedrich Leisch and Achim Zeileis, editors, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), March 20-22, Vienna, Austria. \url{http://www.r-project.org/conferences/DSC-2003/Proceedings/}
+ \cr
+}
+\keyword{package}
diff --git a/man/findDispatchMethodsS3.Rd b/man/findDispatchMethodsS3.Rd
new file mode 100644
index 0000000..6de4705
--- /dev/null
+++ b/man/findDispatchMethodsS3.Rd
@@ -0,0 +1,46 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% findDispatchMethodsS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{findDispatchMethodsS3}
+\alias{findDispatchMethodsS3.default}
+\alias{findDispatchMethodsS3}
+
+\title{Finds the S3 methods that a generic function would call}
+
+\description{
+ Finds the S3 methods that a generic function would call, ordered according to an S3 \code{\link[base]{class}}() \code{\link[base]{vector}}.
+}
+
+\usage{
+\method{findDispatchMethodsS3}{default}(methodName, classNames, firstOnly=FALSE, ...)
+}
+
+\arguments{
+ \item{methodName}{A \code{\link[base]{character}} string specifying the name of a
+ generic function.}
+ \item{classNames}{A \code{\link[base]{character}} \code{\link[base]{vector}} of \code{\link[base]{class}}() names.}
+ \item{firstOnly}{If \code{\link[base:logical]{TRUE}}, only the first method is returned.}
+ \item{...}{Not used.}
+}
+
+\value{
+ Returns a names \code{\link[base]{list}} structure.
+}
+
+\seealso{
+ \code{\link{getDispatchMethodS3}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+
+\keyword{programming}
+\keyword{methods}
+\keyword{internal}
diff --git a/man/getDispatchMethodS3.Rd b/man/getDispatchMethodS3.Rd
new file mode 100644
index 0000000..02ad873
--- /dev/null
+++ b/man/getDispatchMethodS3.Rd
@@ -0,0 +1,45 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% getDispatchMethodS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{getDispatchMethodS3}
+\alias{getDispatchMethodS3.default}
+\alias{getDispatchMethodS3}
+
+\title{Gets the S3 method that a generic function would call}
+
+\description{
+ Gets the S3 method that a generic function would call according to an S3 \code{\link[base]{class}}() \code{\link[base]{vector}}.
+}
+
+\usage{
+\method{getDispatchMethodS3}{default}(methodName, classNames, ...)
+}
+
+\arguments{
+ \item{methodName}{A \code{\link[base]{character}} string specifying the name of a
+ generic function.}
+ \item{classNames}{A \code{\link[base]{character}} \code{\link[base]{vector}} of \code{\link[base]{class}}() names.}
+ \item{...}{Not used.}
+}
+
+\value{
+ Returns a \code{\link[base]{function}}, or throws an exception if not found.
+}
+
+\seealso{
+ \code{\link{findDispatchMethodsS3}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+
+\keyword{programming}
+\keyword{methods}
+\keyword{internal}
diff --git a/man/getGenericS3.Rd b/man/getGenericS3.Rd
new file mode 100644
index 0000000..3973921
--- /dev/null
+++ b/man/getGenericS3.Rd
@@ -0,0 +1,43 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% getGenericS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{getGenericS3}
+\alias{getGenericS3.default}
+\alias{getGenericS3}
+
+\title{Gets an S3 generic function}
+
+\description{
+ Gets an S3 generic function.
+}
+
+\usage{
+\method{getGenericS3}{default}(name, envir=parent.frame(), inherits=TRUE, ...)
+}
+
+\arguments{
+ \item{name}{The name of the generic function.}
+ \item{envir}{The \code{\link[base]{environment}} from which the search for the
+ generic \code{\link[base]{function}} is done.}
+ \item{inherits}{A \code{\link[base]{logical}} specifying whether the enclosing frames
+ should be searched or not.}
+ \item{...}{Not used.}
+}
+
+\seealso{
+ \code{\link{setGenericS3}}().
+ \code{\link{getMethodS3}}().
+ \code{\link{isGenericS3}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+\keyword{programming}
+\keyword{methods}
diff --git a/man/getMethodS3.Rd b/man/getMethodS3.Rd
new file mode 100644
index 0000000..b04144c
--- /dev/null
+++ b/man/getMethodS3.Rd
@@ -0,0 +1,42 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% getMethodS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{getMethodS3}
+\alias{getMethodS3.default}
+\alias{getMethodS3}
+
+\title{Gets an S3 method}
+
+\description{
+ Gets an S3 method.
+}
+
+\usage{
+\method{getMethodS3}{default}(name, class="default", envir=parent.frame(), ...)
+}
+
+\arguments{
+ \item{name}{The name of the method.}
+ \item{class}{The class of the method.}
+ \item{envir}{The \code{\link[base]{environment}} from which the search for the
+ S3 method is done.}
+ \item{...}{Not used.}
+}
+
+\seealso{
+ This is just a conveniency wrapper around \code{\link[utils]{getS3method}}
+ that have arguments consistent with \code{\link{setMethodS3}}().
+ \code{\link{getGenericS3}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+\keyword{programming}
+\keyword{methods}
diff --git a/man/isGenericS3.Rd b/man/isGenericS3.Rd
new file mode 100644
index 0000000..0f8e9b6
--- /dev/null
+++ b/man/isGenericS3.Rd
@@ -0,0 +1,45 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% isGenericS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{isGenericS3}
+\alias{isGenericS3.default}
+\alias{isGenericS3}
+
+\title{Checks if a function is a S3 generic function}
+
+\description{
+ Checks if a function is a S3 generic function.
+}
+
+\usage{
+\method{isGenericS3}{default}(fcn, envir=parent.frame(), ...)
+}
+
+\arguments{
+ \item{fcn}{A \code{\link[base]{function}} or a \code{\link[base]{character}} string.}
+ \item{envir}{If argument \code{fcn} is a \code{\link[base]{character}}, this is the
+ \code{\link[base]{environment}} from which the search for the \code{\link[base]{function}} is done.}
+ \item{...}{Not used.}
+}
+
+\details{
+ A function is considered to be a generic S3/UseMethod function if
+ its name matches one of the known S3 generic functions, or if it
+ calls \code{UseMethod()}.
+}
+
+\value{
+ Returns \code{\link[base:logical]{TRUE}} if a generic S3/UseMethod function, otherwise \code{\link[base:logical]{FALSE}}.
+}
+
+\author{Henrik Bengtsson}
+
+
+
+\keyword{programming}
+\keyword{methods}
diff --git a/man/isGenericS4.Rd b/man/isGenericS4.Rd
new file mode 100644
index 0000000..eb16da9
--- /dev/null
+++ b/man/isGenericS4.Rd
@@ -0,0 +1,45 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% isGenericS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{isGenericS4}
+\alias{isGenericS4.default}
+\alias{isGenericS4}
+
+\title{Checks if a function is a S4 generic function}
+
+\description{
+ Checks if a function is a S4 generic function.
+}
+
+\usage{
+\method{isGenericS4}{default}(fcn, envir=parent.frame(), ...)
+}
+
+\arguments{
+ \item{fcn}{A \code{\link[base]{function}} or a \code{\link[base]{character}} string.}
+ \item{...}{Not used.}
+}
+
+\details{
+ A function is considered to be a generic S4 function if its
+ body, that is the source code, contains the regular pattern
+ \code{"standardGeneric"}.
+}
+
+\value{
+ Returns \code{\link[base:logical]{TRUE}} if a generic S4 function, otherwise \code{\link[base:logical]{FALSE}}.
+}
+
+\author{Henrik Bengtsson}
+
+
+
+
+\keyword{programming}
+\keyword{methods}
+\keyword{internal}
diff --git a/man/pkgStartupMessage.Rd b/man/pkgStartupMessage.Rd
new file mode 100644
index 0000000..e08e31b
--- /dev/null
+++ b/man/pkgStartupMessage.Rd
@@ -0,0 +1,44 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% pkgStartupMessage.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{pkgStartupMessage}
+\alias{pkgStartupMessage.default}
+\alias{pkgStartupMessage}
+
+\title{Generates a (package) startup message}
+
+\description{
+ Generates a (package) startup message.
+ Contrary to \code{\link[base]{packageStartupMessage}}(), this method does
+ \emph{not} output a message when \code{library()/require()} is
+ called with argument \code{quietly=TRUE}.
+}
+
+\usage{
+\method{pkgStartupMessage}{default}(..., quietly=NA)
+}
+
+\arguments{
+ \item{...}{Arguments passed to \code{\link[base]{packageStartupMessage}}().}
+ \item{quietly}{If \code{\link[base:logical]{FALSE}}, the message is outputed, otherwise not.
+ If \code{\link[base]{NA}}, the message is \emph{not} outputted if \code{\link[base]{library}}()
+ (or \code{require()}) was called with argument \code{quietly=TRUE}.}
+}
+
+\value{
+ Returns nothing.
+}
+
+\author{Henrik Bengtsson}
+
+\seealso{
+ \code{\link[base]{packageStartupMessage}}().
+}
+
+
+\keyword{internal}
diff --git a/man/setGenericS3.Rd b/man/setGenericS3.Rd
new file mode 100644
index 0000000..3c8a1bf
--- /dev/null
+++ b/man/setGenericS3.Rd
@@ -0,0 +1,75 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% 010.setGenericS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{setGenericS3}
+\alias{setGenericS3.default}
+\alias{setGenericS3}
+
+\title{Creates an S3 generic function}
+
+\description{
+ \emph{Note that this method is a internal method called by
+ \code{\link{setMethodS3}}() and there is no reason for calling it directly!}\cr
+
+ Creates a generic function in S3 style, i.e. setting a
+ function with name \code{name} that dispatches the method \code{name}
+ via \code{UseMethod}. If there is already a function named \code{name}
+ that function is renamed to \code{name.default}.
+}
+
+\usage{
+\method{setGenericS3}{default}(name, export=TRUE, envir=parent.frame(), dontWarn=getOption("dontWarnPkgs"),
+ validators=getOption("R.methodsS3:validators:setGenericS3"), overwrite=FALSE, ...)
+}
+
+\arguments{
+ \item{name}{The name of the generic function.}
+ \item{export}{A \code{\link[base]{logical}} setting attribute \code{"export"}.}
+ \item{envir}{The environment for where this method should be stored.}
+ \item{dontWarn}{If a non-generic method with the same name is found it
+ will be "renamed" to a default method. If that method is found in
+ a package with a name that is \emph{not} found in \code{dontWarn}
+ a warning will be produced, otherwise it will be renamed silently.}
+ \item{validators}{An optional \code{\link[base]{list}} of \code{\link[base]{function}}s that can be used
+ to assert that the generated generic function meets certain
+ criteria.}
+ \item{...}{Not used.}
+ \item{overwrite}{If \code{\link[base:logical]{TRUE}} an already existing generic function with
+ the same name will be overwritten, otherwise not.}
+}
+
+\examples{
+myCat.matrix <- function(..., sep=", ") {
+ cat("A matrix:\n")
+ cat(..., sep=sep)
+ cat("\n")
+}
+
+myCat.default <- function(..., sep=", ") {
+ cat(..., sep=sep)
+ cat("\n")
+}
+
+setGenericS3("myCat")
+
+myCat(1:10)
+mat <- matrix(1:10, ncol=5)
+myCat(mat)
+}
+
+\seealso{
+ To define a method for a class see \code{\link{setMethodS3}}().
+ For more information about S3, see \code{\link[base]{UseMethod}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+\keyword{programming}
+\keyword{methods}
diff --git a/man/setMethodS3.Rd b/man/setMethodS3.Rd
new file mode 100644
index 0000000..f82bd49
--- /dev/null
+++ b/man/setMethodS3.Rd
@@ -0,0 +1,130 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% 030.setMethodS3.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{setMethodS3}
+\alias{setMethodS3.default}
+\alias{setMethodS3}
+
+\title{Creates an S3 method}
+
+\description{
+ Creates an S3 method. A function with name \code{<name>.<class>} will
+ be set to \code{definition}. The method will get the modifiers specified
+ by \code{modifiers}. If there exists no generic function for this method,
+ it will be created automatically.
+}
+
+\usage{
+\method{setMethodS3}{default}(name, class="default", definition, private=FALSE, protected=FALSE,
+ export=FALSE, static=FALSE, abstract=FALSE, trial=FALSE, deprecated=FALSE,
+ envir=parent.frame(), overwrite=TRUE, conflict=c("warning", "error", "quiet"),
+ createGeneric=TRUE, exportGeneric=TRUE, appendVarArgs=TRUE,
+ validators=getOption("R.methodsS3:validators:setMethodS3"), ...)
+}
+
+\arguments{
+ \item{name}{The name of the method.}
+ \item{class}{The class for which the method should be defined. If
+ \code{class == "default"} a function with name \code{<name>.default}
+ will be created.}
+ \item{definition}{The method defintion.}
+ \item{private, protected}{If \code{private=TRUE}, the method is declared
+ private. If \code{protected=TRUE}, the method is declared protected.
+ In all other cases the method is declared public.}
+ \item{export}{A \code{\link[base]{logical}} setting attribute \code{"export"}.}
+ \item{static}{If \code{\link[base:logical]{TRUE}} this method is defined to be static,
+ otherwise not. Currently this has no effect expect as an indicator.}
+ \item{abstract}{If \code{\link[base:logical]{TRUE}} this method is defined to be abstract,
+ otherwise not. Currently this has no effect expect as an indicator.}
+ \item{trial}{If \code{\link[base:logical]{TRUE}} this method is defined to be a trial method,
+ otherwise not. A trial method is a method that is introduced to be
+ tried out and it might be modified, replaced or even removed in a
+ future release. Some people prefer to call trial versions, beta
+ version. Currently this has no effect expect as an indicator.}
+ \item{deprecated}{If \code{\link[base:logical]{TRUE}} this method is defined to be deprecated,
+ otherwise not. Currently this has no effect expect as an indicator.}
+ \item{envir}{The environment for where this method should be stored.}
+ \item{overwrite}{If \code{\link[base:logical]{TRUE}} an already existing method with the same
+ name (and of the same class) will be overwritten, otherwise not.}
+ \item{conflict}{If a method already exists with the same name (and of
+ the same class), different actions can be taken. If \code{"error"},
+ an exception will be thrown and the method will not be created.
+ If \code{"warning"}, a \code{\link[base]{warning}} will be given and the method \emph{will}
+ be created, otherwise the conflict will be passed unnotice.}
+ \item{createGeneric, exportGeneric}{If \code{createGeneric=TRUE},
+ a generic S3/UseMethod function is defined for this method,
+ iff missing, and \code{exportGeneric} species attribute
+ \code{"export"} of it.}
+ \item{appendVarArgs}{If \code{\link[base:logical]{TRUE}}, argument \code{...} is added with a
+ warning, if missing. For special methods such as \code{$} and
+ \code{[[}, this is never done (argument is ignored).
+ This will increase the chances that the method is consistent with a
+ generic function with many arguments and/or argument \code{...}.}
+ \item{validators}{An optional \code{\link[base]{list}} of \code{\link[base]{function}}s that can be used
+ to assert that the generated method meets certain criteria.}
+ \item{...}{Passed to \code{\link{setGenericS3}}(), iff called.}
+}
+
+\examples{
+######################################################################
+# Example 1
+######################################################################
+setMethodS3("foo", "default", function(x, ...) {
+ cat("In default foo():\n");
+ print(x, ...);
+})
+
+
+setMethodS3("foo", "character", function(s, ...) {
+ cat("In foo() for class 'character':\n");
+ print(s, ...);
+})
+
+# The generic function is automatically created!
+print(foo)
+
+foo(123)
+foo("123")
+
+
+######################################################################
+# Example 2
+#
+# Assume that in a loaded package there is already a function bar(),
+# but you also want to use the name 'bar' for the character string.
+# It may even be the case that you do not know of the other package,
+# but your users do!
+######################################################################
+# bar() in other package
+bar <- function(x, y, ...) {
+ cat("In bar() of 'other' package.\n");
+}
+
+
+# Your defintion; will redefine bar() above to bar.default().
+setMethodS3("bar", "character", function(object, ...) {
+ cat("In bar() for class 'character':\n");
+ print(object, ...);
+})
+
+bar(123)
+bar("123")
+
+
+}
+
+\seealso{
+ For more information about S3, see \code{\link[base]{UseMethod}}().
+}
+
+\author{Henrik Bengtsson}
+
+
+
+\keyword{programming}
+\keyword{methods}
diff --git a/man/throw.Rd b/man/throw.Rd
new file mode 100644
index 0000000..8f09ff1
--- /dev/null
+++ b/man/throw.Rd
@@ -0,0 +1,57 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Do not modify this file since it was automatically generated from:
+%
+% throw.default.R
+%
+% by the Rdoc compiler part of the R.oo package.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\name{throw}
+\alias{throw.default}
+\alias{throw}
+
+\title{Throws an exception}
+
+\description{
+ Throws an exception by calling stop().
+
+ Note that \code{throw()} can be defined for specific classes, which can
+ then be caught (or not) using \code{\link[base:conditions]{tryCatch}}().
+
+ \emph{This default function will be overridden by ditto in the \pkg{R.oo}
+ package, if that is loaded. The latter \code{\link[R.oo]{throw}} implementation
+ is fully backward compatible with this one, but the error object thrown
+ is of class \code{\link[R.oo]{Exception}}.}
+}
+
+\usage{
+\method{throw}{default}(...)
+}
+
+\arguments{
+ \item{...}{One or several strings that are concatenated and collapsed
+ into on message string.}
+}
+
+\value{
+ Returns nothing.
+}
+
+\examples{
+rbern <- function(n=1, prob=1/2) {
+ if (prob < 0 || prob > 1)
+ throw("Argument 'prob' is out of range: ", prob)
+ rbinom(n=n, size=1, prob=prob)
+}
+
+rbern(10, 0.4)
+# [1] 0 1 0 0 0 1 0 0 1 0
+tryCatch({
+ rbern(10, 10*0.4)
+}, error=function(ex) {})
+}
+
+\author{Henrik Bengtsson}
+
+\keyword{error}
+
diff --git a/tests/appendVarArgs.R b/tests/appendVarArgs.R
new file mode 100644
index 0000000..6f566fe
--- /dev/null
+++ b/tests/appendVarArgs.R
@@ -0,0 +1,17 @@
+library("R.methodsS3")
+
+message("TESTING: appendVarArgs()...")
+
+foobar <- function(a=1) print(a)
+print(foobar)
+
+foobar <- appendVarArgs(foobar)
+print(foobar)
+
+foobar <- appendVarArgs(foobar)
+print(foobar)
+
+# Cleanup
+rm(list=ls())
+
+message("TESTING: appendVarArgs()...done")
diff --git a/tests/attributes.R b/tests/attributes.R
new file mode 100644
index 0000000..0dc93b6
--- /dev/null
+++ b/tests/attributes.R
@@ -0,0 +1,27 @@
+library("R.methodsS3")
+
+message("TESTING: attributes()...")
+
+export <- R.methodsS3:::export
+`export<-` <- R.methodsS3:::`export<-`
+noexport <- R.methodsS3:::noexport
+`S3class<-` <- R.methodsS3:::`S3class<-`
+
+
+foo <- function() NULL
+str(foo)
+
+foo <- export(foo)
+str(foo)
+
+export(foo) <- TRUE
+str(foo)
+
+foo <- noexport(foo)
+str(foo)
+
+foo.Bar <- function(...) NULL
+S3class(foo.Bar) <- "Bar"
+str(foo)
+
+message("TESTING: attributes()...DONE")
diff --git a/tests/findDispatchMethodsS3.R b/tests/findDispatchMethodsS3.R
new file mode 100644
index 0000000..7dcbbb4
--- /dev/null
+++ b/tests/findDispatchMethodsS3.R
@@ -0,0 +1,11 @@
+library("R.methodsS3")
+
+message("TESTING: findDispatchMethodS3()...")
+
+## Odds and ends
+# Trying to retrieve base::.Options, but should be
+# detected as a non-function and return an empty result
+fcn <- findDispatchMethodsS3("", "Options")
+stopifnot(length(fcn) == 0L)
+
+message("TESTING: findDispatchMethodS3()...DONE")
diff --git a/tests/getDispatchMethodS3.R b/tests/getDispatchMethodS3.R
new file mode 100644
index 0000000..83e5218
--- /dev/null
+++ b/tests/getDispatchMethodS3.R
@@ -0,0 +1,15 @@
+library("R.methodsS3")
+
+message("TESTING: getDispatchMethodS3()...")
+
+fcn <- getDispatchMethodS3("print", "default")
+print(fcn)
+
+tryCatch({
+ fcn <- getDispatchMethodS3("print", "unknown")
+ print(fcn)
+}, error = function(ex) {
+ print(ex)
+})
+
+message("TESTING: getDispatchMethodS3()...DONE")
diff --git a/tests/isGenericS3S4.R b/tests/isGenericS3S4.R
new file mode 100644
index 0000000..bb49c46
--- /dev/null
+++ b/tests/isGenericS3S4.R
@@ -0,0 +1,21 @@
+library("R.methodsS3")
+
+message("TESTING: isGenericS3/S4()...")
+
+FUNs <- list(
+ isGenericS3=isGenericS3,
+ isGenericS4=isGenericS4
+)
+
+for (name in names(FUNs)) {
+ cat(sprintf("%s():\n", name))
+ FUN <- FUNs[[name]]
+ print(FUN("print"))
+ print(FUN("show"))
+ print(FUN("unknown"))
+ print(FUN(print))
+ print(FUN(sum))
+ print(FUN(function() NULL))
+}
+
+message("TESTING: isGenericS3/S4()...DONE")
diff --git a/tests/pkgStartupMessage.R b/tests/pkgStartupMessage.R
new file mode 100644
index 0000000..3c32f2c
--- /dev/null
+++ b/tests/pkgStartupMessage.R
@@ -0,0 +1,13 @@
+library("R.methodsS3")
+
+message("TESTING: pkgStartupMessage()...")
+
+msg <- "Hello world!"
+pkgStartupMessage(msg)
+
+for (quietly in c(NA, FALSE, TRUE)) {
+ msg <- sprintf("Hello world! (quietly=%s)", quietly)
+ pkgStartupMessage(msg, quietly=quietly)
+}
+
+message("TESTING: pkgStartupMessage()...DONE")
diff --git a/tests/setGenericS3.R b/tests/setGenericS3.R
new file mode 100644
index 0000000..372e11c
--- /dev/null
+++ b/tests/setGenericS3.R
@@ -0,0 +1,40 @@
+library("R.methodsS3")
+
+message("TESTING: setGenericS3()...")
+
+myCat.matrix <- function(..., sep=", ") {
+ cat("A matrix:\n")
+ cat(..., sep=sep)
+ cat("\n")
+}
+
+myCat.default <- function(..., sep=", ") {
+ cat(..., sep=sep)
+ cat("\n")
+}
+
+setGenericS3("myCat")
+
+myCat(1:10)
+mat <- matrix(1:10, ncol=5)
+myCat(mat)
+
+setGenericS3("foo", validators=list(R.methodsS3:::rccValidateSetGenericS3))
+setGenericS3("foo<-")
+
+bar.default <- function(...) cat("bar.default\n")
+bar <- function(...) cat("bar\n")
+setGenericS3("bar")
+
+print(getGenericS3("print"))
+
+
+# Your defintion will redefine bar() above to bar.default().
+foobar <- function() print("foobar()")
+setGenericS3("foobar")
+
+
+# Cleanup
+rm(list=ls())
+
+message("TESTING: setGenericS3()...DONE")
diff --git a/tests/setMethodS3.R b/tests/setMethodS3.R
new file mode 100644
index 0000000..37e4afa
--- /dev/null
+++ b/tests/setMethodS3.R
@@ -0,0 +1,82 @@
+library("R.methodsS3")
+
+message("TESTING: setMethodS3()...")
+
+######################################################################
+# Example 1
+######################################################################
+setMethodS3("foo", "default", function(x, ...) {
+ cat("In default foo():\n")
+ print(x, ...)
+})
+
+
+setMethodS3("foo", "character", function(s) {
+ cat("In foo() for class 'character':\n")
+ print(s, ...)
+})
+
+# The generic function is automatically created!
+print(foo)
+
+foo(123)
+foo("123")
+
+
+######################################################################
+# Example 2
+#
+# Assume that in a loaded package there is already a function bar(),
+# but you also want to use the name 'bar' for the character string.
+# It may even be the case that you do not know of the other package,
+# but your users do!
+######################################################################
+# bar() in other package
+bar <- function(x, y, ...) {
+ cat("In bar() of 'other' package.\n")
+}
+
+
+# Your defintion will redefine bar() above to bar.default().
+setMethodS3("bar", "character", function(object, ...) {
+ cat("In bar() for class 'character':\n")
+ print(object, ...)
+})
+
+bar(123)
+bar("123")
+
+setMethodS3("bar<-", "character", function(x, value) {
+ attr(x, "bar") <- value
+ x
+})
+
+x <- "a"
+bar(x) <- "hello"
+str(x)
+
+
+setMethodS3("$", "SomeClass", function(x, name) {
+ attr(x, name)
+})
+
+setMethodS3("$<-", "SomeClass", function(x, name, value) {
+ attr(x, name) <- value
+ x
+})
+
+
+
+setMethodS3("yaa", "character", abstract=TRUE, validators=list(R.methodsS3:::rccValidateSetMethodS3))
+
+print(getMethodS3("yaa", "character"))
+
+# Redefine
+setMethodS3("yaa", "character", abstract=TRUE, validators=list(R.methodsS3:::rccValidateSetMethodS3))
+
+
+
+# Cleanup
+rm(list=ls())
+
+message("TESTING: setMethodS3()...DONE")
diff --git a/tests/throw.R b/tests/throw.R
new file mode 100644
index 0000000..68e6d4a
--- /dev/null
+++ b/tests/throw.R
@@ -0,0 +1,19 @@
+library("R.methodsS3")
+
+message("TESTING: throw()...")
+
+rbern <- function(n=1, prob=1/2) {
+ if (prob < 0 || prob > 1)
+ throw("Argument 'prob' is out of range: ", prob)
+ rbinom(n=n, size=1, prob=prob)
+}
+
+rbern(10, 0.4)
+# [1] 0 1 0 0 0 1 0 0 1 0
+tryCatch({
+ rbern(10, 10*0.4)
+}, error=function(ex) {
+ print(ex)
+})
+
+message("TESTING: throw()...DONE")
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-r.methodss3.git
More information about the debian-med-commit
mailing list