R/060.Class.R

In HenrikBengtsson/R.oo: R Object-Oriented Programming with or without References

###########################################################################/**
# @RdocClass Class
#
# @title "The Class class describes an Object class"
#
# \description{
#  @classhierarchy
#
#  @get "title".
#  First of all, this class is most commonly used \emph{internally} and
#  neither the end user nor the programmer need to no about the class Class.
# }
#
# @synopsis
#
# \arguments{
#   \item{name}{Name of the class.}
#   \item{constructor}{Constructor (@function) of any Object class.}
# }
#
# \section{Fields and Methods}{
#  @allmethods
# }
#
# \details{
#   The class Class describes the Object class or one of its subclasses.
#   All classes and constructors created by \code{setConstructorS3()} will
#   be of class Class. Its methods provide ways of accessing static fields
#   and static methods. Its \emph{print()} method will print detailed
#   information about the class and its fields and methods.
# }
#
# @author
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setConstructorS3("Class", Class) # Class()






###########################################################################/**
# @RdocMethod as.character
#
# @title "Returns a short string describing the class"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# \examples{
#   print(as.character(Object))
#
#   # gives:  "Class Object: no fields, 8 methods (no inherited)"
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("as.character", "Class", function(x, ...) {
  # To please R CMD check
  this <- x

  if (is.null(getStaticInstance(this)))
    return(as.character.Object(this))

  fields <- getFields(this)
  nbrOfFields <- length(fields)
  methods <- getMethods(this, unique=TRUE)
  count <- unlist(lapply(methods, FUN=length))
  names(count) <- names(methods)
  nbrOfMethods <- sum(count)
  count <- count[-1L]

  s <- paste(class(this)[1L], " ", getName(this), " has ",
  nbrOfFields,  " field" , if (nbrOfFields  != 1L) "s", " and ",
  nbrOfMethods, " method", if (nbrOfMethods != 1L) "s", sep="")

  if (length(count) > 0L) {
    isAre <- c("is", "are")[1L + (count != 1L)]
    isAre[1L] <- paste(isAre[1L], "implemented in")
    isAre[-1L] <- "in"
    s <- paste(sep="", s, " of which ",
               paste(paste(count, isAre, names(count)), collapse=", "), ".")
  } else {
    s <- paste(s, ".", sep="")
  }

  s
}) # as.character()




###########################################################################/**
# @RdocMethod print
#
# @title "Prints detailed information about the class and its fields and methods"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Arguments passed to @seemethod "getDetails".}
# }
#
# \value{
#   Returns nothing.
# }
#
# \examples{
#   print(Object)
# }
#
# @author
#
# \seealso{
#   @seemethod "getDetails"
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("print", "Class", function(x, ...) {
  cat(getDetails(x, ...))
}) # print()






###########################################################################/**
# @RdocMethod getName
#
# @title "Gets the name of the class"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a @character string.
# }
#
# \examples{
#   print(getName(Object))   # "Object"
#   print(getName(Class))    # "Class"
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getName", "Class", function(this, ...) {
  static <- getStaticInstance(this)
  class(static)[1L]
}) # getName()






###########################################################################/**
# @RdocMethod getSuperclasses
#
# @title "Gets the super classes of this class"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a @vector of @character strings.
# }
#
# \examples{
#   print(getSuperclasses(RccViolationException))
#   \dontrun{
#   returns
#   [1] "Exception" "try-error" "Object"
#   }
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @seemethod "getKnownSubclasses".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getSuperclasses", "Class", function(this, ...) {
  class(getStaticInstance(this))[-1L]
}) # getSuperclasses()




###########################################################################/**
# @RdocMethod getKnownSubclasses
#
# @title "Gets all subclasses that are currently loaded"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a @vector of @character strings.
# }
#
# \examples{
#   \dontrun{
#   # Due to a bug in R CMD check (R v1.7.1) the MicroarrayData$read() call
#   # below will call getKnownSubclasses(), which will generate
#   #   "Error in exists(objectName, mode = "function") :
#   #	   [2003-07-07 23:32:41] Exception: F used instead of FALSE"
#   # Note that the example still work, just not in R CMD check
#
#   print(getKnownSubclasses(Exception))
#   }
#   \dontrun{
#   returns
#   [1] "Exception" "try-error" "Object"
#   }
# }
#
# @author
#
# \seealso{
#   @seemethod "getSuperclasses".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getKnownSubclasses", "Class", function(this, sort=TRUE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  getKnownSubclassesInEnvironment <- function(name, envir, ...) {
    # Get all objects
    objectNames <- ls(envir=envir)

    # Exclude itself (to avoid recursive calls)
    objectNames <- setdiff(objectNames, name)

    # Nothing to do?
    if (length(objectNames) == 0L) return(NULL)

    # Keep only functions that are Class objects
    keep <- suppressWarnings({
      sapply(objectNames, FUN=function(objectName) {
        expr <- substitute({
          tryCatch({
            is.function(x) && inherits(x, "Class")
          }, error=function(ex) FALSE)
        }, list(x=as.name(objectName)))
        eval(expr, envir=envir)
      })
    })
    objectNames <- objectNames[keep]

    # Nothing to do?
    if (length(objectNames) == 0L) return(NULL)

    classes <- NULL
    for (objectName in objectNames) {
      clazz <- get(objectName, mode="function", envir=envir, inherits=FALSE)
      # Get all its super classes...
      extends <- getSuperclasses(clazz)
      # Does it extend this class?
      if (is.element(name, extends)) {
        classes <- c(classes, getName(clazz))
      }
    } # for (objectName ...)

    classes
  } # getKnownSubclassesInEnvironment()


  name <- getName(this)
  classes <- c()

##  # (a) Search loaded namespaces
##  for (ns in loadedNamespaces()) {
##    envir <- getNamespace(ns)
##    classesT <- getKnownSubclassesInEnvironment(name, envir=envir)
##    classes <- c(classes, classesT)
##  }

  # (a) Search attached search paths
  for (pos in seq_along(search())) {
    envir <- as.environment(pos)
    classesT <- getKnownSubclassesInEnvironment(name, envir=envir)
    classes <- c(classes, classesT)
  }

  # Drop duplicates
  classes <- unique(classes)

  if (sort && length(classes) > 1L)
    classes <- sort(classes)

  classes
})



###########################################################################/**
# @RdocMethod newInstance
#
# @title "Creates a new instance of this class"
#
# \description{
#  @get "title".
#  Important: It should always be possible to create a new Object by
#  calling the constructor without arguments.
#  This method is simply calling the constructor method of the class.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a reference to an @see "Object".
# }
#
# \examples{
#   obj <- newInstance(Object, NA)
#
#   # equivalent to
#
#   obj <- Object(NA)
# }
#
# @author
#
# \seealso{
#   @see "newInstance.Object".
#   @see "newInstance.BasicObject".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("newInstance", "Class", function(this, ...) {
  this(...)
}) # newInstance()





###########################################################################/**
# @RdocMethod isAbstract
#
# @title "Checks if a class is abstract or not"
#
# \description{
#  @get "title". A class is abstract if it has abstract methods.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is abstract, otherwise @FALSE.
# }
#
# \examples{
#   if (isAbstract(RccViolationException))
#     throw("The class RccViolationException should NOT be abstract.")
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isAbstract", "Class", function(this, ...) {
  methods <- getMethods(this)
  methods <- unlist(methods)
  methods <- methods[nchar(methods) > 0L]
  for (method in methods) {
    mtd <- .getS3Method(method, envir=environment(this))
    if (is.element("abstract", attr(mtd, "modifiers")))
      return(TRUE)
  }
  FALSE
})




###########################################################################/**
# @RdocMethod isStatic
#
# @title "Checks if a class is static or not"
#
# \description{
#  @get "title". A class is static if it has static methods.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is static, otherwise @FALSE.
# }
#
# \examples{
#   if (!isStatic(RccViolationException))
#     throw("RccViolationException should be static because Exception is.")
# }
#
# @author
#
# \seealso{
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isStatic", "Class", function(this, ...) {
  methods <- getMethods(this)
  methods <- unlist(methods)
  methods <- methods[nchar(methods) > 0L]
  for (method in methods) {
    mtd <- .getS3Method(method, envir=environment(this))
    if (is.element("static", attr(mtd, "modifiers")))
      return(TRUE)
  }
  FALSE
})



###########################################################################/**
# @RdocMethod isPrivate
#
# @title "Checks if a class is defined private or not"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is private, otherwise @FALSE.
# }
#
# \examples{
#   if (isPrivate(RccViolationException))
#     throw("The class RccViolationException should NOT be private.")
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isPrivate", "Class", function(this, ...) {
  is.element("private", attr(this, "modifiers"))
})


###########################################################################/**
# @RdocMethod isProtected
#
# @title "Checks if a class is defined protected or not"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is protected, otherwise @FALSE.
# }
#
# \examples{
#   if (isProtected(RccViolationException))
#     throw("The class RccViolationException should NOT be protected.")
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isProtected", "Class", function(this, ...) {
  is.element("protected", attr(this, "modifiers"))
})



###########################################################################/**
# @RdocMethod isPublic
#
# @title "Checks if a class is defined public or not"
#
# \description{
#  @get "title". A class is public if it is neither private nor protected.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is public, otherwise @FALSE.
# }
#
# \examples{
#   if (!isPublic(RccViolationException))
#     throw("The class RccViolationException should be public.")
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isPublic", "Class", function(this, ...) {
  !isPrivate(this) && !isProtected(this)
})



###########################################################################/**
# @RdocMethod isDeprecated
#
# @title "Checks if a class is deprecated or not"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if the class is deprecated, otherwise @FALSE.
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isDeprecated", "Class", function(this, ...) {
  is.element("deprecated", attr(this, "modifiers"))
})






###########################################################################/**
# @RdocMethod forName
#
# @title "Gets a Class object by a name of a class"
#
# \description{
#  @get "title". If no such class exists and exception is thrown.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Optional arguments passed to internal lookup function.}
# }
#
# \value{
#   Returns a @see "Class".
# }
#
# \examples{
#   print(Class$forName("Exception"))
# }
#
# @author
#
# \seealso{
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("forName", "Class", function(static, name, ...) {
  .getClassByName(name, ..., mustExist=TRUE)
}, static=TRUE) # forName()






###########################################################################/**
# @RdocMethod getPackage
#
# @title "Gets the package to which the class belongs"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a @see "Package".
# }
#
# \examples{
#   print(getPackage(Object))
# }
#
# @author
#
# \seealso{
#   @see "Package".
#   @see "base::class".
#   @see "setConstructorS3".
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getPackage", "Class", function(this, ...) {
  name <- getName(this)

  pkgName <- NULL

  # (a) Search name spaces
  envirLast <- NULL
  envir <- environment(this)
  while (!identical(envir, globalenv()) && !identical(envir, envirLast)) {
    envirLast <- envir

    if (exists(name, mode="function", envir=envir, inherits=FALSE)) {
      res <- get(name, mode="function", envir=envir, inherits=FALSE)
      if (inherits(res, "Class")) {
        pkgName <- environmentName(envir)
        pkgName <- gsub("^package:", "", pkgName)
        return(pkgName)
      }
    }

    # Next
    envir <- parent.env(envir)
  } # while (...)


  # (b) Search attached ("loaded") packages
  packages <- search()
  for (pos in seq_along(packages)) {
    envir <- pos.to.env(pos)
    if (exists(name, mode="function", envir=envir, inherits=FALSE)) {
      res <- get(name, mode="function", envir=envir, inherits=FALSE)
      if (inherits(res, "Class")) {
        pkgName <- environmentName(envir)
        pkgName <- gsub("^package:", "", pkgName)
        return(pkgName)
      }
    }
  } # for (pos ...)

  NULL
})







###########################################################################/**
# @RdocMethod getStaticInstance
#
# @title "Gets the static instance of this class"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a reference to an @see "Object".
# }
#
# \examples{
#   obj <- getStaticInstance(Object)
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getStaticInstance", "Class", function(this, ...) {
  # First, make sure you have a reference to the actual Class object.
  if (!is.function(this)) {
    this <- .getClassByName(class(this)[1L], envir=environment(this))
  }

  # If the static instance of this class is missing create one.
  envir <- attr(this, ".env")
  static <- get(".staticInstance", envir=envir)
  if (is.null(static)) {
    if (!exists(".isCreatingStaticInstance", envir=envir, inherits=FALSE)) {
      assign(".isCreatingStaticInstance", TRUE, envir=envir, inherits=FALSE)
      on.exit({
        rm(list=".isCreatingStaticInstance", envir=envir)
      }, add=TRUE)

      constructor <- this
      static <- constructor()

      # Set the environment of the static instance to be the same
      # as the constructor function, i.e. the Class.
      environment(static) <- environment(this)

      assign(".staticInstance", static, envir=envir)
    } else {
      # Otherwise, just create a dummy instance in case any code is trying
      # to access it.
      static <- Object()

      # Set the environment of the static instance to be the same
      # as the constructor function, i.e. the Class.
      environment(static) <- environment(this)
    }
  } else {
    # BACKWARD PATCH: In case an old static object has been loaded
    # then it may not have the proper environment set.
    environment(static) <- environment(this)
  }

  static
}) # getStaticInstance()



###########################################################################/**
# @RdocMethod isBeingCreated
#
# @title "Checks if a class is currently being initiated initiated"
#
# \description{
#   @get "title".
#   When extending a class for the first time, which is
#   typically done in a constructor, a static instance of the class is
#   created by calling the constructor without parameters.
#   This method provides a way to detect that second call inside the
#   constructor.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if a static instance exists, otherwise @FALSE.
# }
#
# @examples "../incl/isBeingCreated.Class.Rex"
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("isBeingCreated", "Class", function(this, ...) {
  # First, make sure you have a reference to the actual Class object.
  if (!is.function(this)) {
    this <- get(class(this)[1L], mode="function")
    if (!inherits(this, "Class"))
      throw("Not a Class object: ", class(this)[1L])
  }

  # If the static instance of this class is missing create one.
  envir <- attr(this, ".env")
  staticInstance <- get(".staticInstance", envir=envir)
  if (!is.null(staticInstance))
    return(FALSE)

  if (!exists(".isCreatingStaticInstance", envir=envir, inherits=FALSE))
    return(FALSE)

  get(".isCreatingStaticInstance", envir=envir, inherits=FALSE)
})



###########################################################################/**
# @RdocMethod getFields
#
# @title "Returns the field names of a class"
#
# \description{
#   @get "title".
# }
#
# \arguments{
#   \item{private}{If @TRUE, private fields will also be returned,
#   otherwise only public fields are returned.}
#   \item{...}{Not used.}
# }
#
# @synopsis
#
# \value{
#  Returns a @character @vector of field names.
# }
#
# \examples{
#   print(getFields(Exception))
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getFields", "Class", function(this, private=FALSE, ...) {
  static <- getStaticInstance(this)
  if (inherits(static, "Class")) {
    # Do not do a recursive call!
    class(static) <- setdiff(class(static), "Class")
  }
  getFields(static, private=private)
}) # getFields()








###########################################################################/**
# @RdocMethod getMethods
#
# @title "Returns the method names of class and its super classes"
#
# \description{
#   @get "title" as a list.
# }
#
# @synopsis
#
# \arguments{
#   \item{private}{If @TRUE, private methods are also returned,
#     otherwise only public ones are returned.}
#   \item{deprecated}{If @TRUE, deprecated methods are also returned.}
#   \item{unique}{If @TRUE, only methods that are not implemented
#     in one of the subclasses are returned for each class.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a named @list of named @character strings.
# }
#
# \examples{
#   names <- getMethods(Exception)
#   print(names)
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getMethods", "Class", function(this, private=FALSE, deprecated=TRUE, unique=TRUE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  findS3MethodsByEnvironment <- function(classNames, envir, exclMods=NULL, res=list()) {
    # Get all objects
    names <- ls(envir=envir, all.names=private)

    # 1. Keep only names with a . (period), because the others cannot
    #    be methods of an S3 class.
    names <- grep("\\.", names, value=TRUE)

    # 2. For each class find the methods belong to that class.
    for (className in classNames) {
      pattern <- paste("\\.", className, "$", sep="")
      namesT <- grep(pattern, names, value=TRUE)
      # Nothing todo?
      if (length(namesT) == 0L) next

      # For all methods identified, see which are functions
      isFunction <- sapply(namesT, FUN=exists, mode="function", envir=envir)
      isFunction <- unlist(isFunction, use.names=FALSE)
      namesT <- namesT[isFunction]
      names(namesT) <- gsub(pattern, "", namesT)
      # Nothing todo?
      if (length(namesT) == 0L) next

      # Keep only non-private methods?
      if (!is.null(exclMods)) {
        keep <- sapply(namesT, FUN=function(name) {
    	  fcn <- get(name, mode="function", envir=envir)
          modifiers <- attr(fcn, "modifiers")
    	  !any(is.element(exclMods, modifiers))
     	})
        namesT <- namesT[keep]
      }
      # Nothing todo?
      if (length(namesT) == 0L) next

      namesT <- c(res[[className]], namesT)

      # Drop duplicates
      dups <- duplicated(namesT)
      namesT <- namesT[!dups]

      res[[className]] <- namesT
    } # for (className)

    res
  } # findS3MethodsByEnvironment()

  findS3Methods <- function(classNames, where=c("ns", "search")[-1L], envir=NULL, exclMods=NULL) {
    res <- list()

    # Nothing todo?
    if (length(classNames) == 0L) return(res)

    if (!is.null(envir)) {
      res <- findS3MethodsByEnvironment(classNames, envir=envir, exclMods=exclMods, res=res)
    }

##    # (a) Search loaded namespaces
##    if (is.element("ns", where)) {
##      for (ns in loadedNamespaces()) {
##        envir <- getNamespace(ns)
##        res <- findS3MethodsByEnvironment(classNames, envir=envir, exclMods=exclMods, res=res)
##      }
##    }

    # (a) Search attached search paths
    if (is.element("search", where)) {
      for (pos in seq_along(search())) {
        envir <- as.environment(pos)
        res <- findS3MethodsByEnvironment(classNames, envir=envir, exclMods=exclMods, res=res)
      }
    }

    res
  } # findS3Methods()


  # Argument 'private':
  private <- as.logical(private)


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Find all related S3 classes
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Exclude methods with certain modifiers?
  exclMods <- NULL
  if (!private) {
    exclMods <- c(exclMods, "private")
  }
  if (!deprecated) {
    exclMods <- c(exclMods, "deprecated")
  }

  # Scan for such methods
  static <- getStaticInstance(this)
  classNames <- class(static)
  envir <- environment(static)
  result <- findS3Methods(classNames, envir=envir, exclMods=exclMods)


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Cleanup
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Keep only unique method names, regardless of Class?
  nClasses <- length(result)
  if (unique && nClasses >= 2L) {
    names <- lapply(result, FUN=names)
    for (kk in seq_len(nClasses-1L)) {
      # Nothing todo?
      if (length(names[[kk]]) == 0L) next
      for (ll in (kk+1L):nClasses) {
        # Nothing todo?
        if (length(names[[ll]]) == 0L) next
        uniqueNames <- setdiff(names[[ll]], names[[kk]])
        unique <- match(uniqueNames, names[[ll]])
        result[[ll]] <- result[[ll]][unique]
        names[[ll]] <- names[[ll]][unique]
      } # for (ll ...)
    } # for (kk ...)    }
  } # if (unique)

  # Remove classes with no methods
  if (nClasses > 0L) {
    result <- result[sapply(result, FUN=function(x) (length(x) > 0L))]
  }

  result
}, protected=TRUE, dontWarn="base") # getMethods()



###########################################################################/**
# @RdocMethod argsToString
#
# @title "Gets the arguments of a function as a character string"
#
# \description{
#   Gets the arguments (with default values) of a function as a character
#   string, which can be used for debugging purposes etc.
#   Used by: classinfo().
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# \examples{
#   Class$argsToString(plot)
# }
#
# \seealso{
#   @seeclass
# }
#
# @author
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("argsToString", "Class", function(this, fcn, ...) {
  a <- args(fcn)
  if (is.null(a))
    return("[primitive function]")

  if (typeof(a) != "closure")
    throw("Expected closure but found something else.")
  args <- formals(a)
  argsNames <- names(args)

  res <- list()
  for (kk in seq_along(args)) {
    arg     <- args[kk]
    argName <- argsNames[kk]

    s <- argName

    argDefault <- arg[[1L]]
    if (!missing(argDefault)) {
      if (is.character(argDefault)) {
        s <- paste(s, "=", "\"", argDefault, "\"", sep="", collapse="")
      } else if (is.null(argDefault)) {
        s <- paste(s, "=NULL", sep="", collapse="")
      } else if (is.language(argDefault)) {
        argDefault <- as.character(arg[1L])
        s <- paste(s, "=", argDefault, sep="", collapse="")
      } else {
        s <- paste(s, "=", argDefault, sep="", collapse="")
      }
    }

    res <- c(res, list(s))
  }

  res
}, private=TRUE, static=TRUE) # argsToString



###########################################################################/**
# @RdocMethod getDetails
#
# @title "Lists the fields and methods of a class"
#
# \description{
#   @get "title" (or an object).
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns an invisible @character string of the class information.
# }
#
# \examples{
#   getDetails(Exception)
# }
#
# @author
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("getDetails", "Class", function(this, private=FALSE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # The class name
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  class <- getName(this)
  s <- class

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # The super classes
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  superclasses <- getSuperclasses(this)
  if (length(superclasses) > 0L) {
    s <- paste(s, " extends ", paste(superclasses, collapse=", "), " {", sep="")
  }

  s <- paste(s, "\n", sep="")

  indent <- 2L
  indentStr <- paste(rep(" ", length.out=indent), collapse="")

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # The fields
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  fields  <-  getFields(this, private=private)
  if (length(fields) > 0L) {
    modifiers <- rep("public", length.out=length(fields))
    isPrivate <- (regexpr("^\\.", fields) != -1L)
    modifiers[isPrivate] <- "private"
    for (kk in seq_along(fields)) {
      s <- paste(s, indentStr, modifiers[kk], " ", fields[kk], "\n", sep="")
    }
  }

##   formalsToString <- function(methodName, isConstructor=FALSE) {
##     args <- argsToString(Class, method, argOffset)
##     s <- paste(sep="", s, methodName, "(", args, ")\n")
##   } ## formalsToString(...)

  methodsPerClass <- getMethods(this, private=private)
  if (length(methodsPerClass) > 0L) {
    envir <- environment(this)
    for (methods in methodsPerClass) {
      if (length(methods) > 0L) {
        methodNames <- names(methods)
        modifiers <- rep("public", length.out=length(methodNames))
        isPrivate <- (regexpr("^\\.", methodNames) != -1L)
        modifiers[isPrivate] <- "private"
        for (kk in seq_along(methodNames)) {
          fcn <- .getS3Method(methods[kk], envir=envir, mustExist=TRUE)
          fcnModifiers <- attr(fcn, "modifiers")
          if (is.element("protected", fcnModifiers)) {
            modifiers[kk] <- "protected"
          } else if (is.element("private", fcnModifiers)) {
            modifiers[kk] <- "private"
          }
          if (is.element("public", fcnModifiers) || private == TRUE) {
            if (is.element("abstract", fcnModifiers))
              modifiers[kk] <- paste(modifiers[kk], " ", "abstract", sep="")
            if (is.element("static", fcnModifiers))
              modifiers[kk] <- paste(modifiers[kk], " ", "static", sep="")

  	    s <- paste(s, indentStr, modifiers[kk], " ", methodNames[kk], "(", sep="")
            args <- paste(argsToString(Class, fcn)[-1L], collapse=", ")
            s <- paste(s, args, ")\n", sep="")
          }
        }
      }
    }
  }

  s <- paste(s, "}\n", sep="")
  invisible(s)
}, private=TRUE);  # getDetails()





###########################################################################/**
# @RdocMethod $
# @aliasmethod [[
#
# @title "Makes the fields and methods of an Class accessible via the $ and the [[ operator"
#
# \usage{
#   \method{$}{Class}(this, name)
#   \method{[[}{Class}(this, name, exact=TRUE)
# }
#
# \description{
#   Makes the fields and methods of an Class accessible via the \code{$}
#   operator. This method is never called explicitly, but through an indirect
#   usage of the \code{$} operator, e.g. \code{obj$name} or
#   \code{obj$getValue()}.
#
#   \enumerate{
#    \item This method will first search for a \code{get<Name>()} method,
#    e.g. if name has the value \code{"age"}, a \code{getAge()} will be
#    looked for. If such a method exists it will be called with the Class
#    as the first and only argument, e.g. \code{getAge(this)}.
#    A \code{get<Name>()} is only looked for if \code{<name>} is not a
#    private field. A private field is a name \emph{beginning} with a
#    \code{.} (period). The rational for this naming convention is to be
#    consistent with how \code{\link[base]{ls}()} works, which will not list
#    such members by default.
#
#    \item If no such method exists, first then, this method will look a
#    field in the Class can has the name \code{name}.
#
#    \item If such neither exists, a method with name \code{name} will be
#    searched for and returned.
#
#    \item If no fields or methods are found at all, @NULL is returned.
#   }
# }
#
# \arguments{
#   \item{name}{The name of the field or method to be accessed.}
# }
#
# \value{
#  Returns the value of a field or a method (@function).
#  If no such field or method exists, @NULL is returned.
# }
#
# \examples{\dontrun{For a complete example see help(Class).}}
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("$", "Class", function(this, name) {
  .subset2Internal(this, name=name, exact=TRUE)
})

setMethodS3("[[", "Class", function(this, name, exact=TRUE) {
  .subset2Internal(this, name=name, exact=exact)
})

setMethodS3(".subset2Internal", "Class", function(this, name, exact=TRUE, ...) {
  if (is.function(this)) {
    static <- getStaticInstance(this)
  } else {
    static <- this
  }

  firstChar <- substr(name, start=1L, stop=1L)
  isPrivate <- identical(firstChar, ".")

  # Do not try to access private fields using a get<Name>() method,
  # because such a functionality means that the user *expects* that
  # there actually is a field called '.<name>', which he or she
  # should not do since it is a private field!
  if (!isPrivate && is.null(attr(static, "disableGetMethods"))) {
    # 1. Is it a get<Name>() method?
    capitalizedName <- name
    substr(capitalizedName, start=1L, stop=1L) <- toupper(firstChar)
    getMethodNames <- paste("get", capitalizedName, ".", class(static), sep="")
    envir <- environment(static)
    for (getMethodName in getMethodNames) {
      fcn <- .getS3Method(getMethodName, envir=envir, mustExist=FALSE)
      if (!is.null(fcn)) {
        ref <- static
        attr(ref, "disableGetMethods") <- TRUE
        return(fcn(ref))
      }
    }
  }

  # 2. Is it a field?
  envir <- attr(static, ".env")
  # For static method calls, e.g. Class$load, 'static' has no
  # environment assigned and therefore, for now, no static
  # fields.
  if (!is.null(envir) && exists(name, envir=envir, inherits=FALSE)) {
    return(get(name, envir=envir, inherits=FALSE))
  }

  # 3. Is it an attribute field (slot)?
  if (is.element(name, names(attributes(static)))) {
    return(attr(static, name))
  }

  # 4. Is it a static S3 method?
  envir <- environment(static)
  methodNames <- paste(name, class(static), sep=".")
  for (methodName in methodNames) {
    mtd <- .getS3Method(methodName, envir=envir, mustExist=FALSE)
    if (!is.null(mtd)) {
      # Using explicit UseMethod() code
      code <- sprintf("function(...) \"%s\"(static, ...)", name)
      expr <- base::parse(text=code)
      fcn <- eval(expr)

      # Set the environment of the static function to inherit from the
      # environment of the static instance/object, which in turn is the
      # same as the environment of the Class/constructor.
      envT <- environment(static)

      # BACKWARD COMPATIBILTY/ROBUSTNESS: In case an old static object
      # has been loaded, make sure to not crash, i.e. behave as before.
      if (!is.null(envT)) {
        env <- new.env(parent=envT)
        env$static <- static
        environment(fcn) <- env
      }

      return(fcn)
    }
  }

  NULL
}, private=TRUE) # .subset2Internal()




###########################################################################/**
# @RdocMethod $<-
# @aliasmethod [[<-
#
# @title "Makes the fields and methods of an Class assignable via the $<- and the [[<- operator"
#
# \usage{
#   \method{$}{Class}(this, name) <- value
#   \method{[[}{Class}(this, name) <- value
# }
#
# \description{
#   Makes the fields and methods of an Class assignable via the \code{$<-}
#   operator. This method is never called explicitly, but through an indirect
#   usage of the \code{$<-} operator, e.g. \code{obj$name <- "foo"}.
#
#   \enumerate{
#     \item This method will first search for a \preformatted{set<Name>()}
#     method, e.g. if name has the value \code{"age"}, a \code{setAge()} will
#     be looked for. If such a method exists it will be called with the Class
#     as the first argument and \code{value} as the second, e.g.
#     \code{setAge(this, value)}.
#     A \code{get<Name>()} is only looked for if \code{<name>} is not a
#     private field. A private field is a name \emph{beginning} with a
#     \code{.} (period). The rational for this naming convention is to be
#     consistent with how \code{\link[base]{ls}()} works, which will not
#     list such members  by default.
#
#     \item If no such method exists it will assign the \code{value} to a
#     (existing or a non-existing) field named \code{name}.
#   }
#
#   Because any \preformatted{set<Name>()} is called first, it is possible
#   to \emph{encapsulate} (hide away) fields with certain names or to put
#   restrictions to what values can be assigned to them.
# }
#
# \arguments{
#   \item{name}{The name of the \preformatted{set<Name>()} method or the
#     name of the field to be assigned the new value.}
#   \item{value}{The value to be assigned.}
# }
#
# \value{
#  Returns itself, i.e. \code{this}, as all \code{$<-} methods must do.
# }
#
# \examples{\dontrun{For a complete example see help(Class).}}
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
# @keyword methods
#*/###########################################################################
setMethodS3("$<-", "Class", function(this, name, value) {
  if (is.function(this))
    static <- getStaticInstance(this)
  else
    static <- this

  firstChar <- substr(name, start=1L, stop=1L)
  isPrivate <- identical(firstChar, ".")

  # Do not try to access private fields using a set<Name>() method,
  # because such a functionality means that the user *expects* that
  # there actually is a field called '.<name>', which he or she
  # should not do since it is a private field!
  if (!isPrivate && is.null(attr(static, "disableSetMethods"))) {
    # 1. Is it a set<Name>() method?
    capitalizedName <- name
    substr(capitalizedName,start=1L, stop=1L) <- toupper(firstChar)
    setMethodNames <- paste("set", capitalizedName, ".", class(static), sep="")
    envir <- environment(static)
    for (setMethodName in setMethodNames) {
      mtd <- .getS3Method(setMethodName, envir=envir, mustExist=FALSE)
      if (!is.null(mtd)) {
        ref <- static
        attr(ref, "disableSetMethods") <- TRUE
        mtd(ref, value)
        return(this)
      }
    }
  }

  # 3. Is it an attribute field (slot)?
  if (is.element(name, names(attributes(static)))) {
    attr(static, name) <- value
    return(this)
  }

  # 4. Otherwise, assign the value to an (existing or non-existing) field.
  assign(name, value, envir=attr(static, ".env"))

  invisible(this)
}) # $<-()




setMethodS3("[[<-", "Class", function(this, name, value) {
  do.call(`$<-`, list(this, name, value))
}) # "[[<-"()


setMethodS3(".DollarNames", "Class", .DollarNames.Object, appendVarArgs=FALSE, private=TRUE)