R/Rdoc.R

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

##########################################################################/**
# @RdocClass Rdoc
#
# @title "Class for converting Rdoc comments to Rd files"
#
# \description{
#  @classhierarchy
#
#  @get "title".
# }
#
# @synopsis
#
# \section{Fields and Methods}{
#  @allmethods
# }
#
# @author
#
# \examples{\dontrun{@include "../incl/Rdoc.Rex"}}
#
# \references{
#   R developers,
#   \emph{Guidelines for Rd files},
#   \url{https://developer.r-project.org/Rds.html},
#   2003
# }
#
# @keyword documentation
#*/###########################################################################
setConstructorS3("Rdoc", function() {
  extend(Object(), "Rdoc",
    .START      = paste(sep="", "/", "**"),  # To hide it from itself!!!
    .STOP       = paste(sep="", "*", "/"),   #   -  "  -
    .nameFormat = "method.class",
    .manPath    = "../man/",
    package     = NULL,
    source      = NULL
  )
})



###########################################################################/**
# @RdocMethod getNameFormat
#
# @title "Gets the current name format"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seemethod "setNameFormat"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getNameFormat", "Rdoc", function(static, ...) {
  Rdoc$.nameFormat
}, static=TRUE)




###########################################################################/**
# @RdocMethod setNameFormat
#
# @title "Sets the current name format"
#
# \description{
#   @get "title".
#   Throws a @see "RccViolationException" if an unknown format is requested.
# }
#
# @synopsis
#
# \arguments{
#   \item{nameFormat}{
#    If \code{"method.class"}, help files for methods belonging to classes are
#    named <method>.<class>.
#    If \code{"class.method"}, help files for methods belonging to classes are
#    named <class>.<method>.
#    These are currently the only name formats supported.
#   }
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seemethod "getNameFormat"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("setNameFormat", "Rdoc", function(static, nameFormat, ...) {
  if (nameFormat == "class.method") {
  } else if (nameFormat == "method.class") {
  } else {
    throw(RdocException("Unknown name format: ", nameFormat))
  }
  Rdoc$.nameFormat <- nameFormat
}, static=TRUE)




###########################################################################/**
# @RdocMethod getKeywords
#
# @title "Gets the keywords defined in R with descriptions"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seemethod "setManPath"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getKeywords", "Rdoc", function(this, fullInfo=FALSE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Locate the KEYWORDS.db file
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  path <- Sys.getenv("R_DOC_DIR")
  if (is.null(path) || nchar(path) == 0) {
    # Backward compatibility
    path <- file.path(Sys.getenv("R_HOME"), "doc")
    tryCatch({
      path <- R.home("doc")
    }, error = function(ex) {})

    if (!file.exists(path)) {
      throw("Cannot determine the R doc directory. R_DOC_DIR was not set and R_HOME/doc/ does not exist: ", path)
    }
  }

  pathname <- file.path(path, "KEYWORDS.db")
  if (!file.exists(pathname)) {
    throw("The KEYWORDS.db file was not found: ", pathname)
  }


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Read keywords
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  keywords <- readLines(pathname, warn=FALSE)
  keywords <- strsplit(keywords, ":")
  names <- lapply(keywords, FUN=function(x) x[1])
  names <- unlist(names)
  names <- gsub("[[:space:]]+$", "", gsub("^[[:space:]]+", "", names))
  desc  <- lapply(keywords, FUN=function(x) x[2])
  desc <- unlist(desc)
  desc <- gsub("[[:space:]]+$", "", gsub("^[[:space:]]+", "", desc))
  keywords <- strsplit(names, "\\|")
  len <- unlist(lapply(keywords, FUN=length))
  keywords <- unlist(lapply(keywords, FUN=function(x) x[length(x)]))
  keywords <- keywords[len > 1]
  desc <- desc[len > 1]
  names(keywords) <- desc

  keywords
}, static=TRUE)


###########################################################################/**
# @RdocMethod isKeyword
#
# @title "Checks if a word is a Rd keyword"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @logical.
# }
#
# @author
#
# \seealso{
#   @seemethod "getKeywords"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("isKeyword", "Rdoc", function(this, word, ...) {
  is.element(word, Rdoc$getKeywords())
}, static=TRUE)



###########################################################################/**
# @RdocMethod getManPath
#
# @title "Gets the path to the directory where the Rd files will be saved"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seemethod "setManPath"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getManPath", "Rdoc", function(this, ...) {
  this$.manPath
}, static=TRUE)



###########################################################################/**
# @RdocMethod setManPath
#
# @title "Sets the path to the directory where the Rd files should be saved"
#
# \description{
#   @get "title". By default the path is \code{../man/} assuming that the
#   current directory is \code{../R/}, which is where source files commonly
#   are placed.
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seemethod "getManPath"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("setManPath", "Rdoc", function(this, path="../man/", ...) {
  info <- file.info(path)
  if (is.na(info$isdir))
    path <- gsub("/$", "", path)
  info <- file.info(path)
  if (is.na(info$isdir))
    throw("Path does not exists: ", path)
  if (info$isdir != TRUE)
    throw("Specified path is not a directory: ", path)
  this$.manPath <- as.character(path)
}, static=TRUE)



###########################################################################/**
# @RdocMethod createManPath
#
# @title "Creates the directory where the Rd files should be saved"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns @TRUE if the directory was creates, @FALSE if it already exists
#  and throws an @Exception if failed.
# }
#
# @author
#
# \seealso{
#   @seemethod "getManPath"
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("createManPath", "Rdoc", function(this, ...) {
  # Check if the path already exists, otherwise create it.
  path <- getManPath(this)
  # file.exists() and file.info() is sensitive to trailing '/'.
  path <- gsub("/$", "", path)
  isdir <- as.logical(file.info(path)["isdir"])
  if (file.exists(path) && isdir)
    return(FALSE)

  # Path 'destPath' does not exist at all. It might be that there is
  # a file with the same name, but in any case, the OS should
  # take care of conflict if it thinks it is a conflict.
  if (!dir.create(path))
    throw(Exception("Could not create destination directory: ", path))

  return(TRUE)
}, static=TRUE, protected=TRUE)





###########################################################################/**
# @RdocMethod createName
#
# @title "Creates a class-method name"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{class}{A class name (@character string).}
#   \item{method}{A method name (@character string).}
#   \item{escape}{If @TRUE, non-valid filename characters are escaped into
#     valid character strings.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns @character string.
# }
#
# @author
#
# \seealso{
#   @seemethod "escapeRdFilename".
#   @seeclass
# }
#
# @keyword documentation
# @keyword internal
#*/###########################################################################
setMethodS3("createName", "Rdoc", function(static, class, method, escape=TRUE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Get name format to be used (can be set globally)
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  nameFormat <- Rdoc$getNameFormat()
  if (nameFormat == "class.method") {
    name <- paste(class, ".", method, sep="")
  } else if (nameFormat == "method.class") {
    name <- paste(method, ".", class, sep="")
  } else {
    throw(RdocException("Unknown name format: ", nameFormat))
  }

  if (escape) {
    name <- Rdoc$escapeRdFilename(name)
  }

  name
}, static=TRUE, private=TRUE)



###########################################################################/**
# @RdocMethod escapeRdFilename
#
# @title "Escape non-valid characters in a filename"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{filename}{A filename (@character string) to be escaped.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("escapeRdFilename", "Rdoc", function(static, filename, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Escape non-valid filenames
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  filename <- gsub("\\\\\\$", "DOLLAR", filename)
  filename <- gsub("[$]", "DOLLAR", filename)
  filename <- gsub("<-", "< -", filename)
  filename <- gsub("<", "LT", filename)
  filename <- gsub("[[]", "-LB-", filename)

  # From R v1.8.1 can't Rd filenames contain whitespace.
  filename <- gsub("[ \t]", "_", filename)

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # A filename must start with a letter or a digit
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  startOk <- (regexpr("^[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9]", filename) != -1)
  if (!startOk) {
    # Fix Rd filename (not really important actually).
    filename <- paste("000", filename, sep="")
  }

  filename
}, protected=TRUE, static=TRUE) # escapeRdFilename()




###########################################################################/**
# @RdocMethod compile
#
# @title "Compile source code files containing Rdoc comments into Rd files"
#
# \description{
#   @get "title".
#
#  \emph{Note, the class and methods to be compiled have to be loaded into
#  \R by for instance \code{library()} or  \code{source()} before calling
#  this method.}
# }
#
# @synopsis
#
# \arguments{
#   \item{filename}{The pathname or filename pattern of the Rdoc files to be
#     compiled.}
#   \item{destPath}{The path where the generated Rd files should be saved.}
#   \item{showDeprecated}{If @TRUE, Rd files are generated for deprecated
#     objects too, otherwise not.}
#   \item{addTimestamp}{If @TRUE, a date and time stamp is added to the
#     Rd header comments.  This timestamp might be confusing for version
#     control systems, which is why it can be turned off with @FALSE.}
#   \item{locale}{The locale to be set/used when compiling Rdoc comments.
#     This help assuring strings are sorted the same way across systems.}
#   \item{source}{If @TRUE, the Rdoc files will be \code{source()}:ed first.
#     This work of course only for Rdoc files that are R source files.}
#   \item{verbose}{If @TRUE, detailed compilation information is printed.}
#   \item{debug}{If @TRUE, extra debug information is printed.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("compile", "Rdoc", function(this, filename=".*[.]R$", destPath=getManPath(this), showDeprecated=FALSE, addTimestamp=FALSE, locale="C", verbose=FALSE, source=FALSE, check=TRUE, debug=FALSE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Global variables
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  authorWarn <- FALSE
  pkgAuthors <- NULL


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  isCapitalized <- function(str) {
    first <- substring(str,1,1)
    (first == toupper(first))
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # a d d K e y w o r d ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  validateKeyword <- function(keyword) {
    knownKeywords <- Rdoc$getKeywords()
    if (!is.element(keyword, knownKeywords)) {
      alts <- agrep(keyword, knownKeywords)
      alts <- paste("'", knownKeywords[alts], "'", collapse=", ", sep="")
      if (nchar(alts) > 0)
        alts <- paste("Did you mean ", alts, "?", sep="")
      throw(RdocException("Unknown keyword: ", keyword, ". ",
                                                alts, source=sourcefile))
    }
  } # validateKeyword()


  rdocKeywords <- c()

  addKeyword <- function(keyword) {
    keyword <- as.character(keyword)

    # A remove keyword?
    if (regexpr("^-", keyword) != -1) {
      rdocKeywords <<- unique(c(rdocKeywords, keyword))
      keyword <- gsub("^-", "", keyword)
    } else {
      rdocKeywords <<- unique(c(rdocKeywords, keyword))
    }

    # Validate keyword
    validateKeyword(keyword)
  } # addKeyword()


  getRdKeywords <- function(...) {
    # Get all keywords
    if (length(rdocKeywords) == 0)
      return("")

    isRemove <- (regexpr("^-", rdocKeywords) != -1)
    keywords <- rdocKeywords[!isRemove]
    exclKeywords <- gsub("^-", "", rdocKeywords[isRemove])
    keywords <- setdiff(keywords, exclKeywords)
    keywords <- unique(keywords)

    # Empty current list of keywords
    rdocKeywords <<- c()

    if (length(keywords) == 0)
      return(NULL)

    lines <- paste("\\keyword{", keywords, "}", sep="")
    lines <- paste(lines, collapse="\n")
    lines
  } # getRdKeywords()


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # e s c a p e N a m e ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # From the help:
  #  \name{name}
  #    name typically is the basename of the Rd file containing the
  #    documentation. It is the "name" of the Rd object represented
  #    by the file, has to be unique in a package, and must not
  #    contain LaTeX special characters (#, $, %, &, ~, _, ^, \, {, }).
  escapeName <- function(name) {
    name <- gsub("\\#", "POUND", name)
    name <- gsub("\\$", "DOLLAR", name)
    name <- gsub("\\%", "PERCENT", name)
    name <- gsub("\\&", "AND", name)
    name <- gsub("\\~", "TILDE", name)
    name <- gsub("\\_", "UNDERSCORE", name)
    name <- gsub("\\^", "POWER", name)
    name <- gsub("\\\\", "BACKSLASH", name)
    name <- gsub("\\{", "LCURLY", name)
    name <- gsub("\\}", "RCURLY", name)
    name <- gsub("<-", "< -", name)
    name
  } # escapeName()

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # e s c a p e A l i a s ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  escapeAlias <- function(alias) {
    # Don't escape aliases?!?  /HB 2004-03-03
    alias <- gsub("\\%", "\\\\%", alias)
#    alias <- gsub("\\$", "\\\\$", alias)
#    alias <- gsub("<-", "< -", alias)
    alias
  } # escapeAlias()


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # e x t r a c t R d o c s ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  extractRdocs <- function(filename, verbose=FALSE, debug=FALSE) {
    if (!file.exists(filename))
      throw(RdocException("File not found: ", filename))

    # Read all lines from the source code file
    lines <- readLines(filename, warn=FALSE)

    if (length(lines) == 0)
      return(list())

    # Keep only the lines that are comments.
    lines <- lines[(regexpr("^ *#", lines) != -1)]

    if (length(lines) == 0)
      return(list())

    # Find all Rdoc begins and ends
    begins <- which(regexpr("/\\*\\*", lines) != -1)
    ends <- which(regexpr("\\*/", lines) != -1)

    if (length(begins) != length(ends))
      throw(RdocException("Number of Rdoc begins do not match number of Rdoc ends: ", filename))

    if (any(begins - ends > 0))
      throw(RdocException("Some of the Rdoc begins comes after the Rdoc ends: ", filename))


    rdocs <- list()
    for (k in seq_along(begins)) {
      idx <- begins[k]:ends[k]
      tmp <- lines[idx]

      # Remove everything before the begin tag including the tag
      tmp[1] <- gsub("^#.*/\\*\\*", "", tmp[1])

      # Remove everything after the end tag including the tag
      last <- length(tmp)
      tmp[last] <- gsub("^#.*\\*/.*", "", tmp[last])

      # Remove all leading single and double comment characters
      tmp <- gsub("^#{1,3}", "", tmp)

      # Find (minimum) indentation
      indents <- regexpr("[^ ]", tmp[nchar(tmp) > 0])
      indent <- min(indents)
      tmp <- substring(tmp, first=indent)

      # Remove all trailing whitespace
      tmp <- gsub("[ \t\v\r\n]$", "", tmp)

      # Remove all empty lines at the beginning
      while (nchar(tmp[1]) == 0)
        tmp <- tmp[-1]

      # Remove all empty lines at the end
      while (nchar(tmp[length(tmp)]) == 0)
        tmp <- tmp[-length(tmp)]

      attr(tmp, "sourcefile") <- filename
      rdocs[[k]] <- tmp
    }

    rdocs
  } # extractRdocs()


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # w r i t e R d ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  sourcefile <- NA
  writeRd <- function(rds, path=getManPath(this), addTimestamp=TRUE, verbose=FALSE, debug=FALSE) {
    for (rd in rds) {
      name <- attr(rd, "name")
      if (!is.null(path)) {
        if (regexpr("/$", path) == -1 && regexpr("\\$", path) == -1)
          path <- paste(path, "/", sep="")
      }

      filename <- Rdoc$escapeRdFilename(name)
      filename <- paste(path, filename, ".Rd", sep="")
      if (verbose) {
        cat("Generating ", filename, "...", sep="")
      }
      sourcefile <<- sourcefile <- attr(rd, "sourcefile")

      hdr <- c("%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
      hdr <- c(hdr, "% Do not modify this file since it was automatically generated from:")
      hdr <- c(hdr, "% ")
      hdr <- c(hdr, paste("%  ", sourcefile, sep=""))
      hdr <- c(hdr, "% ")
      if (addTimestamp) {
        hdr <- c(hdr, paste("% on ", date(), ".", sep=""))
        hdr <- c(hdr, "% ")
      }
      hdr <- c(hdr, "% by the Rdoc compiler part of the R.oo package.")
      hdr <- c(hdr, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
      bfr <- paste(c(hdr, "", rd, ""), collapse="\n")
      writeChar(bfr, eos=NULL, con=filename)
    }
  } # writeRd()

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # c o m p i l e R d o c ()
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  compileRdoc <- function(rdocs, showDeprecated=FALSE, verbose=FALSE, debug=FALSE) {
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # Validate arguments
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if (!is.list(rdocs))
      throw(RdocException("Internal error: Expected a list: ", class(rdocs)[1L]))


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # Defines all simple tags that are shortcuts to different help documents.
    # Example: @TRUE -> \\code{\\link[base:logical]{TRUE}}
    # NA means that the text should just be place inside \code{}.
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    shorttags <- list(
      # Package base:
      "0"           = NA,
      "1"           = NA,
      "..."         = NA,
      "."           = NA,         # Must come *after* "..."
      "array"       = "base",
      "attributes"  = "base",
      "attr"        = "base",
      "ANY"         = NA,
      "call"        = "base",
      "character"   = "base",
      "complex"     = "base",
      "connection"  = "base:connections",
      "data.frame"  = "base",
      "dimnames"    = "base",
      "dim"         = "base",
      "double"      = "base",
      "environment" = "base",
      "expression"  = "base",
      "factor"      = "base",
      "FALSE"       = "base:logical",
      "formula"     = "base",
      "function"    = "base",
      "Inf"         = "base:is.finite",
      "integer"     = "base",
      "length"      = "base",
      "list"        = "base",
      "logical"     = "base",
      "matrix"      = "base",
      "names"       = "base",
      "name"        = "base",
      "NA"          = "base",
      "NaN"         = "base:is.finite",
      "NULL"        = "base",
      "numeric"     = "base",
      "table"       = "base",
      "TRUE"        = "base:logical",
      "raw"         = "base",
      "ts"          = "base",
      "vector"      = "base",
      "warning"     = "base",
      # Package R.oo:
      "Object"      = "R.oo",
      "Exception"   = "R.oo",
      "throw"       = "R.oo"
    )

    names <- names(shorttags)
    match <- gsub("\\.", "\\\\.", names)
    attr(shorttags, "beginsWith") <- paste("^@", match, sep="")
    attr(shorttags, "contains") <- paste("[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9.]@", match, sep="")
    replace <- paste("\\link[", unlist(shorttags), "]{", names, "}", sep="")
    replace[is.na(shorttags)] <- names[is.na(shorttags)]
    replace <- paste("\\code{", replace, "}", sep="")
    attr(shorttags, "replace") <- replace


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    getTagValue <- function(bfr) {
      # 1. Remove all leading whitespace
      bfr <- gsub("^[ \t]", "", bfr)

      # 2a. Is there a '{' + '}' pair?  (nesting brackets are not allowed)
      if ((beginPos <- regexpr("^\\{", bfr)) != -1L) {
        # Find the end '}'
        endPos <- regexpr("\\}", bfr)
        if (endPos == -1L)
          throw(RdocException("Closing } is missing: ", substring(bfr, first=1L, last=20L), source=sourcefile))
        value <- substring(bfr, first=beginPos+1L, last=endPos-1L)
        bfr <- substring(bfr, first=endPos+1L)
      }
      # 2b. ...or a '"' + '"' pair?  (*internal* escaped " are ignored)
      else if ((beginPos <- regexpr("^\"", bfr)) != -1L) {
        endPos <- regexpr("[^\\]\"", bfr)
        if (endPos == -1L)
          throw(RdocException("Closing \" is missing: ", substring(bfr, first=1L, last=20L), source=sourcefile))
        value <- substring(bfr, first=beginPos+1L, last=endPos)
        bfr <- substring(bfr, first=endPos+2L)
      }
      # 2c. ...otherwise the value is the first word found
      #     (on the same line!)
      else {
        beginPos <- 1L
        endPos <- regexpr("([ \t\n\r]|$)", bfr)
        value <- substring(bfr, first=1L, last=endPos-1L)
        # Ad hoc. /HB 2013-03-25
        if (value != "}") {
          bfr <- substring(bfr, first=endPos)
        } else {
          value <- ""
        }
      }

      attr(bfr, "value") <- value
      bfr
    } # getTagValue()


    isObjectDeprecated <- function(name, ...) {
      obj <- getObject(this, name=name, ...)
      mods <- attr(obj, "modifiers")
      is.element("deprecated", mods)
    } # isObjectDeprecated()


    # Read and parse authors from DESCRIPTION's 'Authors@R' or 'Author'.
    getPackageAuthors <- function() {
      if (!is.null(pkgAuthors)) {
         return(pkgAuthors)
      }
      pkg <- Package(Rdoc$package)
      authors <- getAuthor(pkg, as="person")
      authorsN <- format(authors, include=c("given", "family"))

      maintainers <- getMaintainer(pkg, as="person")
      maintainersN <- format(maintainers, include=c("given", "family"))

      # Append maintainers, if not already listed as authors
      keep <- !is.element(maintainersN, authorsN)
      maintainers <- maintainers[keep]
      if (length(maintainers) > 0L) {
##        authors <- c(authors, maintainers)
      }

      authors
    } # getPackageAuthors()


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocClass <- function(bfr) {
      bfr <- getTagValue(bfr)
      class <<- attr(bfr, "value")

      typeOfClass <- typeOfClass(class)
      if (is.na(typeOfClass)) {
        throw(RdocException("Class is either not defined or loaded, or not an S4/setClass() or S3/setConstructorS3() class: ", class))
      }

      if (typeOfClass == "S4") {
        clazz <<- getClass(class)
      } else if (typeOfClass == "S3-Object") {
        clazz <<- Class$forName(class)
      }

      line <- paste("\\name{", escapeName(class), "}\n", sep="")
      line <- paste(line, "\\docType{class}\n", sep="")
      line <- paste(line, "\\alias{", class, "}\n", sep="")
      addKeyword("classes")

      if (typeOfClass == "S4") {
        line <- paste(line, "\\alias{", class, "-class}\n", sep="")
        usage <- Rdoc$getClassS4Usage(clazz)
      } else if (typeOfClass == "S3-Object") {
        usage <<- Rdoc$getUsage(method=class)
        isDeprecated <<- isDeprecated(clazz)
      }

      name <<- class
      objectName <<- class

      rd <<- paste(rd, line, sep="")
      bfr
    } # tagRdocClass()

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagClass <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      class <<- value
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocMethod <- function(bfr) {
      bfr <- getTagValue(bfr)
      method <- attr(bfr, "value")
      objectName <<- paste(method, class, sep=".")
      isDeprecated <<- isObjectDeprecated(objectName)

      # Find method
      fcn <- NULL
      tryCatch({
        fcn <- Rdoc$getObject(objectName, mode="function")
      }, error = function(ex) {
        cat("Failed...\n")
        print(ex)
        cat("Failed...done\n")
      })

      if (!is.function(fcn)) {
        throw(RdocException("Could not get method. Function was not found: ", objectName, "()", source=Rdoc$source))
      }

      methodName <- createName.Rdoc(NULL, class, method, escape=FALSE)

      isStatic <- is.element("static", attr(fcn, "modifiers"))
      if (isStatic) {
        staticName <- paste(class, method, sep="$")
        name <- staticName
        alias <- c(staticName, escapeAlias(methodName))
      } else {
        name <- escapeName(methodName)
        alias <- escapeAlias(methodName)
      }

      # Treat internal and non-internal methods differently
      if (isCapitalized(class)) {
        alias <- c(alias, paste(class, method, sep="."))
        alias <- c(alias, paste(method, ",", class, "-method", sep=""))
      }
      alias <- c(alias, paste(method, class, sep="."))

      # Multiple aliases(?)
      alias <- unique(alias)
      alias <- paste("\\alias{", alias, "}", sep="")

      line <- paste("\\name{", name, "}", sep="")
      line <- c(line, alias)
      line <- paste(line, collapse="\n")

      # Treat internal and non-internal methods differently
      if (isCapitalized(class)) {
        addKeyword("internal")
      }

      addKeyword("methods")

      name <<- methodName; # Filename
      usage <<- Rdoc$getUsage(method=method, class=class)
      rd <<- paste(rd, line, sep="")

      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocDefault <- function(bfr) {
      bfr <- getTagValue(bfr)
      default <- attr(bfr, "value")
      objectName <<- default
      isDeprecated <<- isObjectDeprecated(objectName)
      name <- default
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, ".default}\n", sep="")
      line <- paste(line, "\\alias{", name, "}", sep="")
      usage <<- Rdoc$getUsage(method=default, class="default")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocGeneric <- function(bfr) {
      bfr <- getTagValue(bfr)
      generic <- attr(bfr, "value")
      objectName <<- generic
      isDeprecated <<- isObjectDeprecated(objectName)
      name <- generic
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      addKeyword("methods")
      usage <<- Rdoc$getUsage(method=generic)
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocFunction <- function(bfr) {
      bfr <- getTagValue(bfr)
      fcn <- attr(bfr, "value")
      objectName <<- fcn
      isDeprecated <<- isObjectDeprecated(objectName)
      name <- fcn
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      usage <<- Rdoc$getUsage(method=fcn)
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocObject <- function(bfr) {
      bfr <- getTagValue(bfr)
      object <- attr(bfr, "value")
      objectName <<- object
      isDeprecated <<- isObjectDeprecated(objectName)
      name <- object
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}", sep="")
      usage <<- NULL
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocData <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      name <- value
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      line <- paste(line, "\\docType{data}\n", sep="")
      addKeyword("datasets")
      objectName <<- value
      usage <<- NULL
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocDocumentation <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      name <- value
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      addKeyword("documentation")
      hasTitle <- (regexpr("(@|[\\])title", bfr) != -1)
      if (!hasTitle)
        line <- paste(line, "\\title{", name, "}\n", sep="")
      objectName <<- value
      usage <<- NULL
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocAbout <- function(bfr) {
      # An @RdocAbout does *not* have a value
      # bfr <- getTagValue(bfr)
      name <- ". About this package"
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      addKeyword("documentation")
      line <- paste(line, "\n", sep="")
      hasTitle <- (regexpr("(@|[\\])title", bfr) != -1)
      if (!hasTitle)
        line <- paste(line, "\\title{About this package}\n", sep="")
      objectName <<- name
      usage <<- NULL
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagRdocPackage <- function(bfr) {
      # An @RdocPackage takes the package name as an argument
      bfr <- getTagValue(bfr)
      name <- attr(bfr, "value")
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "-package}\n", sep="")
      line <- paste(line, "\\alias{", name, "-package}\n", sep="")
      line <- paste(line, "\\alias{", name, "}\n", sep="")
      line <- paste(line, "\\docType{package}\n", sep="")
      addKeyword("package")
      line <- paste(line, "\n", sep="")
      hasTitle <- (regexpr("(@|[\\])title", bfr) != -1)
      if (!hasTitle)
        line <- paste(line, "\\title{Package ", name, "}\n", sep="")
      name <<- paste(name, "-package", sep="")
      objectName <<- name
      usage <<- NULL
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagName <- function(bfr) {
      bfr <- getTagValue(bfr)
      if (!is.null(name)) {
        warning("Tag ignored: @RdocDefault is not needed if @RdocClass is specified.")
        return(bfr)
      }
      value <- attr(bfr, "value")
      name <- value
      name <<- name <- escapeName(name)
      line <- paste("\\name{", name, "}\n", sep="")
      line <- paste(line, "\\alias{", name, "}", sep="")
      objectName <<- value
      usage <<- Rdoc$getUsage(method=value)
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagAlias <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      alias <- value
      alias <- escapeAlias(alias)
      line <- paste("\\alias{", alias, "}", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagAliasMethod <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      method <- value
      method <- escapeAlias(method)
      line <- paste("\\alias{", class, ".", method, "}\n", sep="")
      line <- paste(line, "\\alias{", method, ".", class, "}\n", sep="")
      line <- paste(line, "\\alias{", method, ",", class, "-method}\n", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagAliasUndocumented <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      alias <- unlist(tools::undoc(package=value))
      alias <- sapply(alias, FUN=escapeAlias)
      lines <- paste("\\alias{", alias, "}", sep="")
      lines <- paste(lines, collapse="\n")
      rd <<- paste(rd, lines, sep="")
      bfr
    }


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagUsage <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      if (nchar(value) == 0L) {
        # Usage is inferred from the @RdocNnn tag.
      } else if (nchar(value) > 0L) {
        # Usage is inferred from the @usage <spec> tag.
        parts <- strsplit(value, split=",", fixed=TRUE)[[1]]
        nparts <- length(parts)
        method <- parts[1L]
        if (nparts == 1L) {
          usage <- Rdoc$getUsage(method=method)
        } else if (nparts == 2L) {
          class <- parts[2L]
          usage <- Rdoc$getUsage(method=method, class=class)
        }
      }
      usage <- paste(usage, collapse="\n")
      line <- usage
      rd <<- paste(rd, line, sep="")
      bfr
    }

    tagSynopsis <- function(bfr) {
      usage <- c("", usage, "")
      usage <- paste(usage, collapse="\n")
      line <- paste("\\usage{", usage, "}", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagKeyword <- function(bfr) {
      bfr <- getTagValue(bfr)
      keyword <- attr(bfr, "value")
      addKeyword(keyword)
      bfr
    }


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagInclude <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      if (!file.exists(value)) {
        throw(RdocException("File to be included not found: ", value, source=sourcefile))
      } else {
        include <- readLines(value, warn=FALSE)
        include <- paste(include, collapse="\n")
        include <- gsub("\\%", "\\\\%", include)
        line <- paste(include, "\n", sep="")
        rd <<- paste(rd, line, sep="")
      }
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagExamples <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      if (!file.exists(value)) {
        throw(RdocException("File containing examples to be included not found: ", value, source=sourcefile))
      } else {
        include <- readLines(value, warn=FALSE)
        include <- paste(include, collapse="\n")
        include <- gsub("\\%", "\\\\%", include)
        line <- paste("\\examples{\n", include, "\n}", sep="")
      }
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagVisibility <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      visibility <<- value
      if (!is.element(visibility, c("private", "protected", "public")))
        throw(RdocException("Unknown type of visibility: ", value, source=sourcefile))
      if (visibility == "private")
        addKeyword("internal")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagGet <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      if (exists(value)) {
        line <- as.character(get(value))
      } else if (!is.null(getOption(value))) {
        line <- as.character(getOption(value))
      } else {
        throw(RdocException("R variable does not exist: ", value, source=sourcefile))
      }
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagSet <- function(bfr, envir=parent.frame()) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      keyValue <- strsplit(value, "=")[[1]]
      assign(keyValue[1], value=keyValue[2], envir=envir)
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagAuthor <- function(bfr) {
      bfrT <- getTagValue(bfr)
      value <- attr(bfrT, "value")
      value <- as.character(value)
      hasValue <- (nchar(value) > 0L)
      hasValue <- hasValue && (regexpr("^[ \t]*[\n\r]", value) == -1L)

      # Does the @author tag has a value?
      if (hasValue) {
        # Non-empty @author tag with value, e.g. '@author "HB"'

        value <- gsub("^[ \t]*['\"]?", "", value)
        value <- gsub("['\"]?[ \t]*$", "", value)

        # (i) All authors?
        if (value == "*") {
          pkgAuthors <<- authors <- getPackageAuthors()
        } else {
          # (ii) All initials?  An initial = 2-5 upper case letters
          tmp <- unlist(strsplit(value, split=",", fixed=TRUE))
          tmp <- gsub("^[ \t]*", "", tmp)
          tmp <- gsub("[ \t]*$", "", tmp)
          tmpU <- toupper(tmp)
          pattern <- sprintf("^[%s]{2,5}$", paste(base::LETTERS, collapse=""))
          allInitials <- all( (tmpU == tmp) & (regexpr(pattern, tmp) != -1L) )
          if (allInitials) {
            initials <- tmp

            # Create all initials of the 'authors'
            pkgAuthors <<- authors <- getPackageAuthors()
            fullnames <- format(authors, include=c("given", "family"))
            known <- abbreviate(fullnames, minlength=2L)
            known <- toupper(known)

            # Check if the initials match
            idxs <- match(initials, known)
            unknown <- initials[is.na(idxs)]
            if (length(unknown) > 0L) {
              known <- paste(sQuote(known), sQuote(fullnames), sep="=")
              throw(RdocException("Rdoc 'author' tag specifies initials (", paste(sQuote(unknown), collapse=", "), ") that are not part of the known ones (", paste(known, collapse=", "), ")", source=sourcefile))
            }
            authors <- authors[idxs]
          } else {
            authors <- as.person(value)
          }
        }
        bfr <- bfrT
      } else {
        # Empty @author tag, i.e. '@author'

        pkgAuthors <<- authors <- getPackageAuthors()
        # If there are creators of the package (which there should be),
        # use those as the default for an empty '@author' tag.
        isCreator <- sapply(authors, FUN=function(a) is.element("cre", a$role))
        if (any(isCreator)) {
          authors <- authors[isCreator]
        }

        if (exists("author", mode="character", envir=globalenv())) {
          if (!authorWarn) {
            author <- get("author", mode="character", envir=globalenv())
            warning("Detected an 'author' character variable in the global environment. Note that, since R.oo 1.13.0, the author for an (empty) Rdoc @author tag is inferred from the 'Authors@R' or 'Author' DESCRIPTION field and no longer take from the global 'author' variable: ", sQuote(author))
            authorWarn <<- TRUE
          }
        }
      }

      authorsTag <- format(authors, include=c("given", "family"))
      authorsTag <- paste(authorsTag, collapse=", ")

      line <- paste("\\author{", authorsTag, "}", sep="")
      rd <<- paste(rd, line, sep="")

      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagHowToCite <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      package <- Package(value)
      howToCite <- getHowToCite(package, newline=NULL)
      if (is.null(howToCite)) {
        line <- "\\emph{No citation information available.}\n"
      } else {
        line <- gsub("\n", " ", howToCite)
        line <- gsub("[ ]+", " ", line)
        line <- lapply(line, FUN=strwrap, width=85L)
        line <- lapply(line, FUN=paste, collapse="\n")
        line <- unlist(line, use.names=FALSE)
        line <- paste(line, collapse="\n\n")
        line <- paste("\\preformatted{\n", line, "\n}\n", sep="")

        ## Not sure exactly when this was fixed in R, but now the workaround
        ## triggers an 'R CMD check' NOTE on "Warning: trimming empty <p>".
        ## /HB 2022-06-11
        if (getRversion() < "4.0.0") {
          # Add the following line to fix a "R CMD check-bug" in LaTeX.
          # /HB 2004-03-10
          line <- paste(line, "\\emph{}\n", sep="")
        }
      }
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagSeeclass <- function(bfr) {
      line <- paste("For more information see \\code{\\link{", class, "}}.", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagSeemethod <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      line <- paste("\\code{\\link[", package, ":", Rdoc$createName(class, value), "]{*", value, "}()}", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagSeeOtherMethods <- function(bfr) {
      clazz <<- Class$forName(class)
      method <- gsub(paste("[.]", class, "$", sep=""), "", objectName)

      classes <- list(getSuperclasses(clazz), getKnownSubclasses(clazz))
      for (k in 1:2) {
        methods <- paste(method, classes[[k]], sep=".")
        exists <- sapply(methods, FUN=exists, mode="function")
        classes[[k]] <- classes[[k]][exists]
        methods <- methods[exists]
        for (l in seq_along(methods)) {
          fcn <- get(methods[l], mode="function")
          modifiers <- attr(fcn, "modifiers")
          isPrivate <- is.element("private", modifiers)
          isDeprecated <- is.element("deprecated", modifiers)
          if (isPrivate || isDeprecated)
            methods[l] <- NA
        }
        classes[[k]] <- classes[[k]][!is.na(methods)]
      }

      for (k in 1:2) {
        classes[[k]] <- paste("\\code{\\link[", package, ":", Rdoc$createName(classes[[k]], method), "]{", classes[[k]], "}}", sep="")
      }

      line <- "\\cr\\bold{Implementations of this method in}"
      line <- paste(line, " i) \\bold{superclasses:} ")
      line <- paste(line, paste(classes[[1]], collapse=", "), sep="")
      line <- paste(line, ", and ii) \\bold{subclasses:} ")
      line <- paste(line, paste(classes[[2]], collapse=", "), ".", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagSee <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      pkgObject <- strsplit(value, "::", value)[[1]]
      fcn <- ""
      if (length(pkgObject) == 1) {
        pkg <- NULL
        obj <- pkgObject[1]
        if (exists(obj, mode="function")) {
          expr <- substitute(inherits(fcn, "Class"), list(fcn=as.name(obj)))
          if (!eval(expr))
            fcn <- "()"
        }
      } else {
        pkg <- pkgObject[1]
        obj <- pkgObject[2]
        .require <- require;  # To please R CMD check
        if (.require(package=pkg, character.only=TRUE)) {
          pos <- which(paste("package:", "base", sep="") == search())
          if (exists(obj, where=pos, mode="function", inherits=FALSE))
            fcn <- "()"
        }
        pkg <- paste("[", pkg, "]", sep="")
      }
      line <- paste("\\code{\\link", pkg, "{", obj, "}}", fcn, sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagClasshierarchy <- function(bfr) {
      txt <- getRdHierarchy(clazz)
      subclasses <- getKnownSubclasses(clazz)

      # If possible, create links to Rd docs for each of the subclasses.
      links <- c()
      for (name in subclasses) {
        link <- name
        if (exists(name, mode="function")) {
          cls <- get(name, mode="function")
          if (inherits(cls, "Class")) {
            pkg <- getPackage(cls)
            if (is.null(pkg))
              link <- paste("\\link{", link ,"}", sep="")
            else
              link <- paste("\\link[", pkg, "]{", link ,"}", sep="")
            if (isAbstract(cls))
              link <- paste("\\emph{", link, "}", sep="")
          }
        }

#        link <- paste("\\code{", link ,"}", sep="")
        links <- c(links, link)
      } # for (name in ...)
      subclasses <- paste(links, collapse=", ")

      txt <- paste(txt, "\\bold{Directly known subclasses:}\\cr\n", sep="")
      txt <- paste(txt, subclasses, sep="")
      txt <- paste(txt, "\\cr\n\n", sep="")
      txt <- paste(txt, getRdDeclaration(clazz), "\n", sep="")
      line <- txt
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagMethods <- function(bfr) {
      methods <- getRdMethods(clazz, visibility=visibility)
      line <- methods
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagAllMethods <- function(bfr) {
      bfr <- getTagValue(bfr)
      visibilities <- attr(bfr, "value")
      # Ad hoc patch for parser /060530.
      addEnd <- (identical(visibilities, "}"))
      visibilities <- gsub(" ", "", visibilities)
      visibilities <- unlist(strsplit(visibilities, split="|", fixed=TRUE))
      methods <- getRdMethods(clazz, visibilities=visibilities)
      line <- paste(methods, "\n\n", sep="")
      methods <- Rdoc$methodsInheritedFrom(clazz, visibility, showDeprecated=showDeprecated, sort=sort)
      line <- paste(line, methods, sep="")
      if (addEnd)
        line <- paste(line, "}", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagTitle <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      title <<- as.character(value)

      # Check the title for correctness according to https://developer.r-project.org/Rds.html
      firstLetter <- substring(title, 1,1)
      if (firstLetter != toupper(firstLetter))
        throw(RdocException("Titles shoule be capitalized: ", title, source=sourcefile))
      if (regexpr("[.]$", title) != -1)
        throw(RdocException("Titles should not end with a period: ", title, source=sourcefile))
      if (regexpr("[^\\][\\][:letter:]", title) != -1)
        throw(RdocException("Titles should not contain markup: ", title, source=sourcefile))

      if (isDeprecated)
        title <<- paste("Deprecated: ", title, sep="")
      line <- paste("\\title{", title, "}", sep="")
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagEval <- function(bfr) {
      bfr <- getTagValue(bfr)
      value <- attr(bfr, "value")
      expr <- as.character(value)
      result <- eval(parse(text=expr))
      line <- result
      rd <<- paste(rd, line, sep="")
      bfr
    }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tagInheritedmethods <- function(bfr) {
      methods <- Rdoc$methodsInheritedFrom(clazz, visibility, sort=sort)
      line <- methods
      rd <<- paste(rd, line, sep="")
      bfr
    }


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    tags <- list(
      "RdocClass"         = tagRdocClass,
      "RdocGeneric"       = tagRdocGeneric,
      "RdocFunction"      = tagRdocFunction,
      "RdocDefault"       = tagRdocDefault,
      "RdocMethod"        = tagRdocMethod,
      "RdocObject"        = tagRdocObject,
      "RdocData"          = tagRdocData,
      "RdocDocumentation" = tagRdocDocumentation,
      "RdocAbout"         = tagRdocAbout,
      "RdocPackage"       = tagRdocPackage,
  #
      "classhierarchy"   = tagClasshierarchy,  # must be *before* "class".
      "synopsis"         = tagSynopsis,
      "usage"            = tagUsage,
      "keyword"          = tagKeyword,
  #
      "Class"            = tagRdocClass,
      "methodname"       = tagRdocMethod,
      "name"             = tagName,
  #
      "aliasmethod"      = tagAliasMethod,     # must be *before* "alias".
  #   "aliasundocumented" = tagAliasUndocumented, # not useful.
      "alias"            = tagAlias,
      "title"            = tagTitle,
  #
      "class"            = tagClass,
      "include"          = tagInclude,
      "inheritedmethods" = "tagInheritedmethods",
      "examples"         = tagExamples,
      "visibility"       = tagVisibility,
      "get"              = tagGet,
      "set"              = tagSet,
      "author"           = tagAuthor,
      "howtocite"        = tagHowToCite,
      "seeclass"         = tagSeeclass,
      "seemethod"        = tagSeemethod,
      "seeothermethods"  = tagSeeOtherMethods,
      "see"              = tagSee,
      "methods"          = tagMethods,
      "allmethods"       = tagAllMethods,
      "eval"             = tagEval
    )
    names <- names(tags)
    attr(tags, "beginsWith") <- paste("^@", names, sep="")


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # SETUP
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # Set the locale
    Sys.setlocale(locale=locale)


    # Make a best guess what the package is that is created by querying
    # the DESCRIPTION file, which should be in the parent directory of
    # the getManPath() directory.
    pkgPath <- dirname(getManPath(this))
    pathname <- file.path(pkgPath, "DESCRIPTION")
    if (!file.exists(pathname)) {
      stop("Cannot infer package name. File not found: ", pathname)
    }
    pi <- read.dcf(file=pathname)
    package <- pi[,"Package", drop=TRUE]
    if (length(package) == 0L) {
      throw("Failed to infer package name.  No 'Package' was listed in ", sQuote(pathname), ".")
    }
    if (length(package) > 1L) {
      throw("Failed to infer package name.  More than one 'Package' were listed in ", sQuote(pathname), ": ", paste(sQuote(package), collapse=", "))
    }

    Rdoc$package <- package

    class <- NULL
    clazz <- NULL
    Rdoc$source <- sourcefile <<- NULL

    rds <- list()
    for (rdoc in rdocs) {
      # Remember the name of the source file in case of an error...
      Rdoc$source <- sourcefile <<- attr(rdoc, "sourcefile")

      title <- NULL
      objectName <- NULL
      isDeprecated <- FALSE
      method <- NULL
      name <- NULL
      usage <- NULL
      visibility <- NULL

      # ==============================================================
      # 1. Replace all shorttags
      #
      #    This can be vectorized since all shorttags are read only
      #    and does not rely on any state of Rdoc etc.
      #    This should speed up the process.
      # ==============================================================
      for (kk in seq_along(shorttags)) {
        replace <- attr(shorttags, "replace")[kk]

        # (a) Replace all occurances at the beginning of the lines.
        pattern <- attr(shorttags, "beginsWith")[kk]
        rdoc <- gsub(pattern, replace, rdoc)

        # (b) Replace all other occurances.
        ready <- FALSE
        while (!ready) {
          pattern <- attr(shorttags, "contains")[kk]
          pos <- regexpr(pattern, rdoc)
          idx <- (pos != -1L)
          if (any(idx)) {
            len <- attr(pos, "match.length")[idx]
            pos <- pos[idx]
            prefix <- substring(rdoc[idx], first=1L, last=pos)
            suffix <- substring(rdoc[idx], first=pos+len)
            rdoc[idx] <- paste(prefix, replace, suffix, sep="")
          } else {
            ready <- TRUE
          }
        }
      } # for (kk ...)


      # ==============================================================
      # 2. Compile the remaining lines
      #
      #    This can *not* be vectorized since some tags may change the
      #    state of the Rdoc compiler or set a local variable, which
      #    will affect following tags.
      # ==============================================================

      # (a) Make on big string of the whole Rdoc comment.
      #     This will simplify handling of line breaks within a tag
      #     argument, e.g. when @title "Bla bla\nbla" exists.
      rdoc <- paste(rdoc, collapse="\n")

      # (b) Get the first occurance of a tag.
      #     A tag begins with a '@', but can not have a letter, a
      #     number or a '.' in front since then it could be a code
      #     fragment refering to a S4 slot.
      patternL <- "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
      pattern <- sprintf("[^%s0-9.]@", patternL)
      pattern2 <- sprintf("[^%s0-9]@", patternL)

      rd <- ""
      while (TRUE) {
        # (i) It can be that the tag start at position 1...
        pos <- regexpr("^@", rdoc)

        # (ii) ...otherwise...
        if (pos == -1L) {
          pos <- regexpr(pattern, rdoc)
          if (pos == -1L)
            break;  # No more tags. Done!
          # Save everything before the tag...
          rd <- paste(rd, substring(rdoc, first=1L, last=pos), sep="")
          # ...and make the tag be at the first position.
          rdoc <- substring(rdoc, first=pos+1L)
        }

        if (debug)
          str(rdoc)

        # (iii) Identify the tag
        tagName <- NULL
        tagFunction <- NULL
        for (kk in seq_along(tags)) {
          patternKK <- attr(tags, "beginsWith")[kk]
          pos <- regexpr(patternKK, rdoc)
          if (pos != -1L) {
            len <- attr(pos, "match.length")
            tagIdx <- kk
            tagName <- names(tags)[kk]
            if (debug)
              cat(paste("Found tag: ", tagName, "\n", sep=""))
            tagFunction <- tags[[kk]]
            break
          }
        } # for (kk ...)

        if (!is.null(tagFunction)) {
          # Shift the Rdoc buffer
          rdoc <- substring(rdoc, first=len+1L)
          if (is.function(tagFunction)) {
            # Evaluate the tag function in the current environment
            # so all variables can be shared between tags.
            # All tag functions must return the resulting buffer!
            expr <- substitute(tagFunction(rdoc),
                      list(tagFunction=tagFunction, rdoc=rdoc))
            rdoc <- eval(expr)
          }
        } else {
          pos <- regexpr(pattern2, substring(rdoc, first=2L))
          tagName <- substring(rdoc, first=1L, last=pos)
          msg <- sprintf("Unknown tag not processed in '%s': '%s'", sourcefile, tagName)
          warning(msg)
          rd <- paste(rd, substring(rdoc, first=1L, last=1L), sep="")
          rdoc <- substring(rdoc, first=2L)
        }

        if (isDeprecated && !showDeprecated)
          break
      } # while(TRUE), i.e. get first tag...

      if (showDeprecated || !isDeprecated) {
        # Do not forget to add the rest!
        rd <- paste(rd, rdoc, sep="")
        rdoc <- NULL


        # Append all keywords at the end
        rd <- paste(rd, getRdKeywords(), sep="\n")

        # Remove all empty lines
        rd <- gsub("[ \t]\n", "\n", rd)
        rd <- gsub("[ \t]\r", "\r", rd)

        if (is.null(name)) {
          # @RdocClass, @RdocDefault and/or @RdocMethod was not given. Search for classical \name{...}
          search <- regexpr("\\name\\{[^\\}]*\\}", rd)
          if (search == -1L) {
            throw(RdocException("The resulting Rd text does not have a \\name{} tag: ", substring(rd, first=1L, last=40L), source=sourcefile))
          }
          name <- substring(rd, first=search+5L, last=search+attr(search, "match.length")-2)
          search <- regexpr("\\name\\{[^\\}]*\\}", substring(rd, first=search+1L))
          if (search != -1L)
            throw(RdocException("The resulting Rd text has more than one \\name{} tag.", source=sourcefile))
        }

        visibility <- "public"
        if (is.null(visibility)) {
          if (is.null(objectName)) {
          } else if (!exists(objectName)) {
            # If no object was found, assume that it is a Rdoc comment for
            # a non-object, i.e. a concept or similar.
          } else {
            object <- get(objectName)
            modifiers <- attr(object, "modifiers")
            if (is.element("private", modifiers)) {
              visibility <- "private"
            } else if (is.element("protected", modifiers)) {
              visibility <- "protected"
            }
          }
        }

        attr(rd, "visibility") <- as.character(visibility)
        attr(rd, "isDeprecated") <- isDeprecated
        attr(rd, "name") <- as.character(name)
        attr(rd, "sourcefile") <- sourcefile

        # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        # Check Rd code?
        # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        if (check) {
          if (compareVersion(as.character(getRversion()), "2.10.0") >= 0) {
            # R v2.10.0 and newer
            tryCatch({
              con <- textConnection(rd)
              rdParse <- tools::parse_Rd(file=con)
            }, warning = function(w) {
              filename <- sprintf("%s.Rd.ERROR", attr(rd, "name"))
              cat(rd, sep="\n", file=filename)
              throw(RdocException(sprintf("Syntax error in generated Rd code (see '%s') for Rdoc comment '%s' (in '%s') was detected by tools:parse_Rd(): %s", filename, attr(rd, "name"), attr(rd, "sourcefile"), as.character(w))))
            }, finally = {
              close(con)
              con <- NULL
            })
          } else {
            # R v2.9.2 and before
            tryCatch({
              ns <- getNamespace("tools")
              tools_Rd_parse <- get("Rd_parse", mode="function", envir=ns)
              rdParse <- tools_Rd_parse(text=rd)
              if (length(rdParse$rest) > 0) {
                throw(RdocException("Unknown top-level text in generated Rd code for Rdoc comment '", attr(rd, "name"), "' (in '", attr(rd, "sourcefile"), "') (typically due to too many or a missing bracket): ", paste(rdParse$rest, collapse=", ", sep="")))
              }
            }, error = function(e) {
              throw(RdocException("Syntax error in generated Rd code for Rdoc comment '", attr(rd, "name"), "' (in '", attr(rd, "sourcefile"), "') was detected by tools:Rd_parse(): ", as.character(e)))
            })
          }
        } # if (check)

        rds <- c(rds, list(rd))
      } else {
        warning(paste("No Rd file for '", objectName, "' was generated since it was declared deprecated.", sep=""))
      } # if (!isDeprecated)
    } # for (rdoc in rdocs)

    rds
  } # compileRdoc()


  # A local version of the sourceTo() in R.io.
  sourceTo <- function(..., local=TRUE, envir=parent.frame()) {
    # Wrap up the arguments to source
    args <- list(...)

    if (!is.element("file", names(args)))
      names(args)[1] <- "file"

    # Override any 'local' argument
    args$local <- local

    # Create a call expression to source(..., local=local)
    expr <- substitute({
      do.call(source, args)
    }, list(args=args))

    # Call source()
    eval(expr, envir=envir)
  } # sourceTo()
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  # Assert that the manPath exists.
  createManPath(this)

  filename <- as.character(filename)
  if (length(filename) == 1L && !file.exists(filename)) {
    if (regexpr("\\*", filename) != -1L || regexpr("\\?", filename) != -1L) {
      # Filename pattern
      pattern <- filename
      # List all files
      filename <- list.files()
      # Match to filename pattern
      filename <- grep(paste(pattern, "$", sep=""), filename, value=TRUE)
      # Keep only files
      filename <- filename[file_test("-f", filename)]
      # Keep only newer files?
    }
  }

  # Load the source code in case it contains new stuff.
  if (source) {
    lapply(filename, FUN=source)
  }

  for (file in filename) {
    if (verbose)
      cat("Generating Rd files from source file ", file, "...", sep="")

    rdocs <- extractRdocs(file, verbose=verbose, debug=debug)
    rd <- compileRdoc(rdocs, showDeprecated=showDeprecated, verbose=verbose, debug=debug)
    writeRd(rd, path=destPath, addTimestamp=addTimestamp, verbose=verbose, debug=debug)
    if (verbose)
      cat("\n")
  }

  if (check) {
    check(this, manPath=destPath, verbose=verbose)
  }
}, static=TRUE) # compile()







###########################################################################/**
# @RdocMethod hierarchy
#
# @title "Gets the class hierarchy"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("hierarchy", "Rdoc", function(this, class, ...) {
  package <- getPackage(class)
  s <- paste("Package: ", package, "\\cr\n")
  what <- if (inherits(class, "Class")) "Class" else "Interface"
  s <- paste(s, "\\bold{", what, " ", getName(class), "}\\cr\n\n", sep="")
  indent <- ""
  for (extend in rev(getSuperclasses(class))) {
    link <- sapply(extend, FUN=function(name) {
#      isAbstract <- FALSE
      link <- name
      if (exists(name, mode="function")) {
        cls <- get(name, mode="function")
        if (inherits(cls, "Class")) {
          pkg <- getPackage(cls)
          if (is.null(pkg))
            link <- paste("\\link{", link ,"}", sep="")
          else
            link <- paste("\\link[", pkg, "]{", link ,"}", sep="")
#          if (isAbstract(cls)) {
#            link <- paste("\\emph{", link, "}", sep="")
#            isAbstract <- TRUE
#          }
        }
      }
      paste("\\code{", link ,"}", sep="")
    })
    if (indent == "") {
      s <- paste(s, link, "\\cr\n", sep="")
      indent <- "~~"
    } else {
      s <- paste(s, "\\code{", indent, "+--}", link, "\\cr\n", sep="")
      indent <- paste(indent, "~~~~~", sep="")
    }
    s <- paste(s, "\\code{", indent, "|}\\cr\n", sep="")
  }
  link <- paste("\\code{", getName(class), "}", sep="")
  if (isAbstract(class))
    link <- paste("\\emph{", link, "}", sep="")
  s <- paste(s, "\\code{", indent, "+--}", link, "\\cr\n\n", sep="")
  s
}, private=TRUE, static=TRUE)






###########################################################################/**
# @RdocMethod declaration
#
# @title "Gets the class declaration"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("declaration", "Rdoc", function(this, class, ...) {
  s <- "public"; # visibility(class)
  if (isAbstract(class))
    s <- paste(s, "abstract")
  if (isStatic(class))
    s <- paste(s, "static")
  if (inherits(class, "Class"))
    s <- paste(s, "class")
  else
    throw(getName(class), " is neither a class nor an interface.")

  s <- paste(s, " \\bold{", getName(class), "}\\cr\n", sep="")
  links <- getSuperclasses(class)

  if (length(links) > 0) {
    name <- links[1]
    link <- name
    if (exists(name, mode="function")) {
      cls <- get(name, mode="function")
      if (inherits(cls, "Class")) {
        pkg <- getPackage(cls)
        if (is.null(pkg))
          link <- paste("\\link{", link ,"}", sep="")
        else
          link <- paste("\\link[", pkg, "]{", link ,"}", sep="")
        if (isAbstract(cls))
          link <- paste("\\emph{", link, "}", sep="")
      }
    }
    paste("\\code{", link ,"}", sep="")
    s <- paste(s, "extends ", link, "\\cr\n", sep="")
  }
  s
}, private=TRUE, static=TRUE)





###########################################################################/**
# @RdocMethod methodsInheritedFrom
#
# @title "Gets all methods inherited from a class in Rd format"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("methodsInheritedFrom", "Rdoc", function(this, class, visibility=c("public", "protected", "private"), showDeprecated=FALSE, inheritedFrom=NULL, sort=TRUE, trial=FALSE, ...) {
  s <- ""

  private <- is.element("private", visibility)

  # Classes
  for (extend in getSuperclasses(class)) {
    # Try to find a Class object with this name.
    clazz <- NULL
    tryCatch({
      clazz <- Class$forName(extend)
    }, error = function(ex) {})

    if (is.null(clazz)) {
      # Use methods() to find methods
      methods <- methods(class=extend)
      pattern <- paste("[.]", extend, "$", sep="")
      methods <- gsub(pattern, "", methods)
    } else {
      # Get all methods of this Class
      methods <- getMethods(clazz, private=private, deprecated=showDeprecated)
      methods <- methods[[extend]]
      methods <- names(methods)
    }
    if (length(methods) > 0) {
      methods <- paste(methods, collapse=", ")
      s <- paste(s, sprintf("\\bold{Methods inherited from %s}:\\cr\n", extend))
      s <- paste(s, methods, "\n\n", sep="")
    }
  }

  s
}, private=TRUE, static=TRUE)



setMethodS3("getObject", "Rdoc", function(static, name, mode="any", package=static$package, ...) {
  # Search for object in:
  #  (i) the package names iff found, then
  # (ii) then the search path.

  # Try to infer the package's namespace.
  ns <- NULL
  if (is.character(package)) {
    tryCatch({
      ns <- getNamespace(package)
    }, error = function(ex) {})
  }

  if (is.environment(ns) && exists(name, mode=mode, envir=ns)) {
    obj <- get(name, mode=mode, envir=ns)
  } else if (exists(name, mode=mode)) {
    obj <- get(name, mode=mode)
  } else {
    throw("Failed to locate object of mode \"", mode, "\": ", name)
  }

  obj
}, private=TRUE, static=TRUE)



###########################################################################/**
# @RdocMethod getUsage
#
# @title "Gets the usage of a method"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{method}{A method name (@character string).}
#   \item{class}{An optional class name (@character string).}
#   \item{wrap}{An @integer specifying the maximum number of characters per line.  Longer lines will be wrapped with newlines.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getUsage", "Rdoc", function(static, method, class=NULL, wrap=90L, indent=2L, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  buildUsage <- function(method, class=NULL, args, valueArg=NULL, wrap=90L, head=NULL, ...) {
    # Argument 'args':
    stopifnot(is.list(args))

    indentStr <- paste(rep(" ", times=indent), collapse="")

    correction <- 0L
    if (length(head) == 0L) {
      if (is.null(class)) {
        head <- method
        # Escape '%*%' to '\%*\%'
        head <- gsub("%", "\\%", head, fixed=TRUE)
        # Quote any method name containing '%'
        if (regexpr("%", head, fixed=TRUE) != -1L)
          head <- sprintf("`%s`", head)
      } else {
        # The effective length of this in the help manual is nchar(method).
        head <- sprintf("\\method{%s}{%s}", method, class)
        correction <- nchar(head) - nchar(method)
      }
    }
    correction0 <- correction

    lines <- NULL
    line <- paste(head, "(", sep="")
    if (length(args) == 0L) {
      line <- paste(line, ") ", sep="")
    }

    while (length(args) > 0L) {
      subargs <- args[[1L]]
      nsubargs <-length(subargs)

      # Try to keep <key>=<value> together
      if (nsubargs >= 3L) {
        # If <key>=<value> fit on a line, then keep the together...
        if (sum(nchar(subargs[1:3L])) <= wrap) {
          subargs[3L] <- paste(subargs[1:3], collapse="")
          subargs <- subargs[-(1:2)]
        } else if (sum(nchar(subargs[1:2L])) <= wrap) {
        # ...otherwise, at least keep <key>= together, iff possible.
          subargs[2L] <- paste(subargs[1:2], collapse="")
          subargs <- subargs[-1L]
        }
        nsubargs <-length(subargs)
      }

      # Remaining arguments
      args <- args[-1L]
      nargs <- length(args)
      suffix <- if (nargs > 0L) ", " else ") "

      # For each subargument
      for (kk in seq_len(nsubargs)) {
        subarg <- subargs[kk]
##        str(list(kk=kk, subarg=subarg))

        if (kk == nsubargs) {
          subarg <- paste(subarg, suffix, sep="")
        } else {
          subarg <- paste(subarg, " ", sep="")
        }
        len <- nchar(subarg)

        # Does argument fit on the same line?
        if (nchar(line) - correction + len <= wrap) {
          line <- paste(line, subarg, sep="")
        } else {
          lines <- c(lines, line)
          line <- paste(indentStr, subarg, sep="")
          correction <- 0L
        }
      } # for (kk ...)
    } # while (length(args) > 0L)

    # Append a value assignment, i.e. "... <- value"?
    if (!is.null(valueArg)) {
      arg <- paste("<- ", valueArg, sep="")
      # Does it fit on the same line?
      if (nchar(line) - correction + nchar(arg) <= wrap) {
        line <- paste(line, arg, sep="")
      } else {
        lines <- c(lines, line)
        line <- paste(indentStr, arg, sep="")
      }
    }
    lines <- c(lines, line)
    lines <- gsub("[ ]$", "", lines); # Trim trailing space

    # Sanity check
    lens <- nchar(lines)
    lens[1L] <- lens[1L] - correction0
    stopifnot(all(lens <= wrap))

##    print(lines)

    lines
  } # buildUsage()


  if (!is.null(class)) {
    fcnName <- paste(method, class, sep=".")
  } else {
    fcnName <- method
  }

  fcn <- NULL
  tryCatch({
    fcn <- getObject(static, name=fcnName, mode="function")
  }, error = function(ex) {
    cat("Failed...\n")
    print(ex)
    cat("Failed...done\n")
  })
  if (!is.function(fcn)) {
    throw(RdocException("Could not get usage. Function was not found: ", fcnName, "()", source=Rdoc$source))
  }

  isStatic <- is.element("static", attr(fcn, "modifiers"))
  isConstructor <- inherits(fcn, "Class")
  args <- Rdoc$argsToString(fcn, escapeRd=TRUE, collapse=FALSE)

  # Replacement methods are special
  isReplacement <- (regexpr("<-$", method) != -1L)
  if (isReplacement) {
    method <- gsub("<-$", "", method)
    nargs <- length(args)
    valueArg <- args[nargs]
    args <- args[-nargs]
  } else {
    valueArg <- NULL
  }

  if (isConstructor) {
    usage <- buildUsage(method, args=args, valueArg=valueArg, wrap=wrap)
  } else if (isStatic) {
    # (a) The S3 method call
    lines <- buildUsage(method, class=class, args=args, valueArg=valueArg, wrap=wrap)
    usageM <- paste(lines, collapse="\n")

    # (b) The "static" method call, e.g. Class$forName(...)
    # Adjust line width ('wrap') to fit prefix '## ' as well.
    lines <- buildUsage(method, class=class, args=args[-1L], valueArg=valueArg, head=paste(class, method, sep="$"), wrap=wrap - 3L)
    lines <- paste("## ", lines, sep="")
    usageS <- paste(lines, collapse="\n")

    # (c) Combine
    usage <- c("## Static method (use this):",
               usageS,
               "",
               "## Don't use the below:",
               usageM)
  } else if (!is.null(class)) {
    usage <- buildUsage(method, class=class, args=args, valueArg=valueArg, wrap=wrap)
  } else {
    usage <- buildUsage(method, args=args, valueArg=valueArg, wrap=wrap)
  }

  usage
}, private=TRUE, static=TRUE) # getUsage()




###########################################################################/**
# @RdocMethod getClassS4Usage
#
# @title "Gets the usage of a S4 class"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{class}{A class name (@character string).}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getClassS4Usage", "Rdoc", function(static, class, ...) {
  if (!inherits(class, "classRepresentation"))
    throw(InternalErrorException("Wrong usage."))

  name <- class@className

  usage <- paste("new(", name, ")", sep="")

  hasConstructor <- exists(name, mode="function")
  if (hasConstructor) {
    constructor <- get(name, mode="function")
    args <- Rdoc$argsToString(constructor, collapse=TRUE)
    args <- paste(args, collapse=", ")
    constructorUsage <- paste(name, "(", args, ")", sep="")
    usage <- paste(usage, "\n", constructorUsage, sep="")
  }

  usage
}, private=TRUE, static=TRUE)




###########################################################################/**
# @RdocMethod argsToString
#
# @title "Gets the arguments signature of a function"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{fcn}{A @function.}
#  \item{escapeRd}{If @TRUE, certain Rd markup symbols are escaped.}
#  \item{collapse}{If @TRUE, each argument is returned as a single string,
#   otherwise split up into a vector of strings as far as possible.}
#  \item{...}{Not used.}
# }
#
# \value{
#  Returns a @list of @character strings.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("argsToString", "Rdoc", function(static, fcn, escapeRd=FALSE, collapse=TRUE, ...) {
  a <- args(fcn)

  # Nothing to do?
  if (is.null(a)) {
    return("[primitive function]")
  }

  # Sanity check
  if (typeof(a) != "closure") {
    throw("Expected closure but found something else: ", typeof(a))
  }

  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)) {
      argDefault <- deparse(argDefault, width.cutoff=20L)
      argDefault <- trim(argDefault)

      # Escape '%' (which is a comment in Rd format)?
      if (escapeRd) {
        argDefault <- gsub("\\%", "\\\\%", argDefault)
      }

      if (collapse) {
        argDefault <- paste(argDefault, collapse=" ")
        s <- paste(s, "=", argDefault, sep="", collapse="")
      } else {
        s <- c(s, "=", argDefault)
      }
    }

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

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




###########################################################################/**
# @RdocMethod getRdTitle
#
# @title "Extracts the title string of a Rd file"
#
# \description{
#   @get "title" corresponding the the specified method of the specified class.
# }
#
# @synopsis
#
# \arguments{
#   \item{method}{The method to be search for.}
#   \item{class}{The class the method belongs to.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getRdTitle", "Rdoc", function(this, class, method, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  tools_fetchRdDB <- get("fetchRdDB", mode="function", envir=getNamespace("tools"), inherits=FALSE)


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # e s c a p e N a m e ( )
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  escapeName <- function(name) {
    name <- gsub("\\#", "POUND", name)
    name <- gsub("\\$", "DOLLAR", name)
    name <- gsub("\\%", "PERCENT", name)
    name <- gsub("\\&", "AND", name)
    name <- gsub("\\~", "TILDE", name)
    name <- gsub("\\_", "UNDERSCORE", name)
    name <- gsub("\\^", "POWER", name)
    name <- gsub("\\\\", "BACKSLASH", name)
    name <- gsub("\\{", "LCURLY", name)
    name <- gsub("\\}", "RCURLY", name)
    name <- gsub("<-", "< -", name)
    name
  } # escapeName()

  title <- NULL

  # Search for the file <class>.<method>.Rd in the man/ directory
  name <- createName.Rdoc(NULL, getName(class), method, escape=FALSE)
  name <- escapeName(name)

  rdName <- Rdoc$escapeRdFilename(name)
  rdFile <- paste(rdName, "Rd", sep=".")
  url <- file.path(getManPath(this), rdFile)
  if (file.exists(url)) {
    src <- paste(readLines(url, warn=FALSE), collapse="\n")

    # Search for \title{...} in the Rd source
    titlePos <- regexpr("\\title\\{[^\\}]*}", src)
    if (titlePos == -1) {
      warning(paste("Could not find a \\title{} definition in the Rd file for ", method, " in ", getName(class), ". Will search in loaded packages.", sep=""))
      ""
    } else {
      title <- trim(substring(src, first=titlePos+6, last=titlePos+attr(titlePos, "match.length")-2))
    }
  } else {
    warning(paste("The Rd file for ", method, " in ", getName(class), " could not be found. Will search in loaded packages.", sep=""))
  }

  if (is.null(title)) {
    methodName <- paste(method, ".", getName(class), sep="")
    packageName <- Rdoc$getPackageNameOf(methodName, mode="function")
    if (length(packageName) == 1) {
      if (compareVersion(as.character(getRversion()), "2.10.0") >= 0) {
        # R v2.10.0 and newer
        path <- system.file("help", package=packageName)
        filebase <- file.path(path, packageName)
        tryCatch({
          entry <- tools_fetchRdDB(filebase, key=methodName)
          tags <- lapply(entry, FUN=attr, "Rd_tag")
          idx <- which(tags == "\\title")
          if (length(idx) > 1) {
            idx <- idx[1]
          }
          if (length(idx) == 1) {
            entry <- entry[[idx]]
            entry <- entry[[1]]
            title <- entry[1]
          }
        }, error = function(ex) {
          warning(as.character(ex))
        })
      } else {
        package <- Package(packageName)
        tryCatch({
          contents <- getContents(package)
          pos <- which(contents[,"Entry"] == name)
          if (length(pos) == 0) {
            warning(paste("Reverted to the CONTENTS file of package '", packageName, "', but found not matching entry: ", name, sep=""))
          } else if (length(pos) > 2) {
            warning(paste("Found more than one matching entry in the CONTENTS file of package '", packageName, "'. Using the first one only: ", name, sep=""))
            pos <- pos[1]
          }
          if (length(pos) != 0) {
            title <- as.character(contents[pos, "Description"])
            attr(title, "package") <- packageName
          }
        }, error=function(ex) {
          warning(as.character(ex))
        })
      }
    }
  }

  title
}, private=TRUE, static=TRUE)




###########################################################################/**
# @RdocMethod getPackageNameOf
#
# @title "Gets the package of a method or an object"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{objectName}{An method or object name (@character string).}
#  \item{mode}{Mode of object (@character string).}
#  \item{unique}{If @TRUE, only the first matching package is returned if
#    more than one is found.}
#  \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("getPackageNameOf", "Rdoc", function(static, objectName, mode="any", unique=TRUE, ...) {
  # Search all namespaces that are *attached*
  pkgs <- grep("^package:", search(), value=TRUE)
  pkgs <- gsub("^package:", "", pkgs)
  found <- sapply(pkgs, FUN=function(pkg) {
    exists(objectName, mode=mode, envir=asNamespace(pkg))
  })
  package <- names(found)[found]
  if (length(package) == 1L) return(package)
  if (length(package) > 1L && unique) {
    warning("Found more than one occurance of '", objectName, "' among the attached namespaces. Will only return the first one: ", paste(sQuote(package), collapse=", "))
    return(package[1L])
  }

  # If not found, then search any other namespace *loaded*
  pkgs <- setdiff(loadedNamespaces(), pkgs)
  found <- sapply(pkgs, FUN=function(pkg) {
    exists(objectName, mode=mode, envir=asNamespace(pkg))
  })
  package <- names(found)[found]
  if (length(package) == 1L) return(package)
  if (length(package) > 1L && unique) {
    warning("Found more than one occurance of '", objectName, "' among the loaded namespaces. Will only return the first one: ", paste(sQuote(package), collapse=", "))
    return(package[1L])
  }

  character(0L)
}, private=TRUE, static=TRUE)



###########################################################################/**
# @RdocMethod check
#
# @title "Checks the compiled Rd files"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{manPath}{The path to the Rd files (@character string).}
#  \item{verbose}{If @TRUE, extra information is outputted.}
#  \item{...}{Not used.}
# }
#
# \value{
#  Returns a printable object, which, if non-empty will show the errors.
# }
#
# \details{
#  Internally the \code{tools} package is used.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("check", "Rdoc", function(this, manPath=getManPath(this), verbose=FALSE, ...) {
  # file paths with trailing '/' are not recognized! /HB 2004-10-13
  manPath <- gsub("/$", "", manPath)
  if (verbose)
    cat("Checking Rd files in '", manPath, "'...\n", sep="")

  if (compareVersion(as.character(getRversion()), "2.10.0") >= 0) {
    # For R (>= 2.10.0)
    pathnames <- list.files(pattern="[.]Rd$", path=manPath, full.names=TRUE)
    res <- NULL
    for (kk in seq_along(pathnames)) {
      pathname <- pathnames[kk]
      res <- tools::checkRd(pathname)
    }
  } else {
    # For R (< 2.10.0)
    tools_check_Rd_files_in_man_dir <- get("check_Rd_files_in_man_dir", mode="function", envir=getNamespace("tools"), inherits=FALSE)
    res <- tools_check_Rd_files_in_man_dir(manPath)
    if (length(res$files_with_surely_bad_Rd) > 0) {
      throw("Syntax error in Rd file(s): ",
                          paste(res$files_with_surely_bad_Rd, collapse=", "))
    }

    if (length(res$files_with_likely_bad_Rd) > 0) {
      print(res$files_with_likely_bad_Rd)
      throw("Syntax error in Rd file(s): ",
                          paste(res$files_with_surely_bad_Rd, collapse=", "))
    }
  }

  if (verbose)
    cat("Checking Rd files in '", manPath, "'...done\n", sep="")
  res
})



###########################################################################/**
# @RdocMethod isVisible
#
# @title "Checks if a member is visible given its modifiers"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{modifiers}{A @character string of modifiers.}
#  \item{visibilities}{A @character string of visibility flags.}
#  \item{...}{Not used.}
# }
#
# \value{
#  Returns @TRUE if the modifiers are equal or higher than the visibility
#  flags, otherwise @FALSE.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword documentation
#*/###########################################################################
setMethodS3("isVisible", "Rdoc", function(static, modifiers, visibilities, ...) {
  if (is.element("deprecated", modifiers) && !is.element("deprecated", visibilities))
    return(FALSE)

  if (is.element("trial", modifiers) && !is.element("trial", visibilities))
    return(FALSE)

  levels <- c("private", "protected", "public")
  modifiers <- intersect(modifiers, levels)
  if (length(modifiers) == 0)
    return(TRUE)

  visibilities <- intersect(visibilities, levels)
  if (length(visibilities) == 0)
    return(TRUE)

  modifiers <- factor(modifiers, levels=levels)
  visibilities <- factor(visibilities, levels=levels)

  any(as.integer(visibilities) <= as.integer(modifiers))
}, static=TRUE, protected=TRUE) # isVisible()