###########################################################################/**
# @RdocClass Verbose
#
# @title "Class to writing verbose messages to a connection or file"
#
# \description{
#  @classhierarchy
#
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{con}{A @connection or a @character string filename.}
#   \item{on}{A @logical indicating if the writer is on or off.}
#   \item{threshold}{A @numeric threshold that the \code{level} argument
#     of any write method has to be equal to or larger than in order to the
#     message being written. Thus, the lower the threshold is the more and
#     more details will be outputted.}
#   \item{timestamp}{If @TRUE, each output is preceded with a timestamp.}
#   \item{removeFile}{If @TRUE and \code{con} is a filename, the file is
#     first deleted, if it exists.}
#   \item{asGString}{If @TRUE, all messages are interpreted as
#     @see "GString" before being output, otherwise not.}
#   \item{core}{Internal use only.}
#   \item{...}{Not used.}
# }
#
# \section{Fields and Methods}{
#  @allmethods
# }
#
# \section{Output levels}{
#   As a guideline, use the following levels when outputting verbose/debug
#   message using the Verbose class. For a message to be shown, the output
#   level must be greater than (not equal to) current threshold.
#   Thus, the lower the threshold is set, the more messages will be seen.
#
#   \itemize{
#    \item{<= -100}{Only for debug messages, i.e. messages containing all
#      necessary information for debugging purposes and to find bugs in
#      the code. Normally these messages are so detailed so they will be
#      a pain for the regular user, but very useful for bug reporting and
#      bug tracking by the developer.}
#    \item{-99 -- -11}{Detailed verbose messages. These will typically be
#      useful for the user to understand what is going on and do some simple
#      debugging fixing problems typically due to themselves and not due to
#      bugs in the code.}
#    \item{-10 -- -1}{Verbose messages. For example, these will typically
#      report the name of the file to be read, the current step in a sequence
#      of analysis steps and so on. These message are not very useful for
#      debugging.}
#    \item{0}{Default level in all output methods and default threshold.
#      Thus, by default, messages at level 0 are not shown.}
#    \item{>= +1}{Message that are always outputted (if threshold is
#      kept at 0).  We recommend not to output message at this level, because
#      methods should be quiet by default (at the default threshold 0).}
#   }
# }
#
# \section{A compatibility trick and a speed-up trick}{
#   If you want to include calls to Verbose in a package of yours in order
#   to debug code, but not use it otherwise, you might not want to load
#   R.utils all the time, but only for debugging.
#   To achieve this, the value of a reference variable to a Verbose class
#   is always set to @TRUE, cf. typically an Object reference has value @NA.
#   This makes it possible to use the reference variable as a first test
#   before calling Verbose methods. Example:
#   \preformatted{
#     foo <- function(..., verbose=FALSE) {
#       # enter() will never be called if verbose==FALSE, thus no error.
#       verbose && enter(verbose, "Loading")
#     }
#   }
#
#   Thus, R.utils is not required for \code{foo()}, but for
#   \code{foo(verbose==Verbose(level=-1))} it is.
#
#   Moreover, if using the @see "NullVerbose" class for ignoring all verbose
#   messages, the above trick will indeed speed up the code, because
#   the value of a NullVerbose reference variable is always @FALSE.
# }
#
# \section{Extending the Verbose class}{
#   If extending this class, make sure to output messages via
#   @seemethod "writeRaw" or one of the other output methods (which in
#   turn all call the former).
#   This guarantees that @seemethod "writeRaw" has full control of the
#   output, e.g. this makes it possible to split output to standard
#   output and to file.
# }
#
# @examples "../incl/Verbose.Rex"
#
# @author
#
# \seealso{
#   @see "NullVerbose".
# }
#
# @keyword programming
# @keyword IO
#*/###########################################################################
setConstructorS3("Verbose", function(con=stderr(), on=TRUE, threshold=0, asGString=TRUE, timestamp=FALSE, removeFile=TRUE, core=TRUE, ...) {
  if (is.character(con)) {
    if (removeFile && isFile(con))
      file.remove(con)
  } else if (inherits(con, "connection")) {
  } else if (!is.null(con)) {
    stop("Unknown type on argument 'con': ", class(con))
  }

  if (!is.numeric(threshold) || length(threshold) != 1)
    throw("Argument 'threshold' must be a single numeric value.")

  # Argument 'threshold':
  threshold <- as.numeric(threshold)

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

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

  # Argument 'core':
  if (!is.logical(core))
    throw("Argument 'core' is not logical: ", mode(core))

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

  extend(Object(core), "Verbose",
    .timestamp       = timestamp,
    .timestampFormat = "%Y%m%d %H:%M:%S|",
    indentPos        = 0,
    indentStep       = 1,
    rightMargin      = 75,
    threshold        = threshold,
    defaultLevel     = 0,
    asGString        = asGString,
    .ignore          = !on,
    .con             = con,
    .stack           = c(),
    .stackLevel      = c()
  )
})



###########################################################################/**
# @RdocMethod "as.character"
#
# @title "Returns a character string version of this object"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("as.character", "Verbose", function(x, ...) {
  # To please R CMD check
  this <- x

  s <- paste(class(this)[1], ": isOn()=", isOn(this), ",
                                         threshold=", this$threshold, sep="")
  s <- paste(s, ", timestamp=", this$.timestamp, sep="")
  s <- paste(s, ", timestampFormat=", this$.timestampFormat, sep="")
  s
})



#########################################################################/**
# @RdocMethod equals
#
# @title "Checks if this object is equal to another"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{other}{Another Object.}
#   \item{...}{Not used.}
# }
#
# \value{Returns @TRUE if they are equal, otherwise @FALSE.}
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/#########################################################################
setMethodS3("equals", "Verbose", function(this, other, ...) {
  res <- FALSE
  if (!inherits(other, "Verbose")) {
    attr(res, "reason") <- "Not same class"
    return(res)
  }

  fields <- getFields(this, private=TRUE)
  for (field in fields) {
    if (!equals(this[[field]], other[[field]])) {
      attr(res, "reason") <- field
      return(res)
    }
  }

  TRUE
}, protected=TRUE)




###########################################################################/**
# @RdocMethod setThreshold
#
# @title "Sets verbose threshold"
#
# \description{
#   @get "title". Output requests below this threshold will be ignored.
# }
#
# @synopsis
#
# \arguments{
#  \item{threshold}{A @numeric threshold.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns old threshold.
# }
#
# @author
#
# \seealso{
#   @seemethod "getThreshold" and @seemethod "isVisible".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("setThreshold", "Verbose", function(this, threshold, ...) {
  ## Argument 'threshold':
  if (length(threshold) != 1) {
    throw("Argument 'threshold' must be a scalar.")
  } else if (is.na(threshold)) {
    throw("Argument 'threshold' must not be a missing value: ", threshold)
  }
  
  if (is.logical(threshold)) {
    threshold <- -as.integer(threshold)  ## => FALSE = 0, TRUE = -1
  } else if (!is.numeric(threshold)) {
    throw("Argument 'threshold' must be a logical or a numeric: ", mode(threshold))
  }
  
  old <- this$threshold
  this$threshold <- threshold
  invisible(old)
})


###########################################################################/**
# @RdocMethod setDefaultLevel
#
# @title "Sets the current default verbose level"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{level}{A @numeric value.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns old default level.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("setDefaultLevel", "Verbose", function(this, level, ...) {
  if (is.na(as.numeric(level)))
    throw("Invalid value on argument 'level': ", level)
  oldLevel <- this$defaultLevel
  this$defaultLevel <- as.numeric(level)
  invisible(oldLevel)
})



###########################################################################/**
# @RdocMethod getThreshold
#
# @title "Gets current verbose threshold"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a @numeric value.
# }
#
# @author
#
# \seealso{
#   @seemethod "setThreshold" and @seemethod "isVisible".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("getThreshold", "Verbose", function(this, ...) {
  threshold <- this$threshold

  # Assert that threshold is within the valid range.  This is part of the
  # transition of move from negative to positive verbose levels:
  # 1. Disallow all positive value for a long time.
  # 2. Yet later, ignore the sign, i.e. abs(threshold).
  # 3. Much later, disallow all negative values for a long time.
  # 4. Possibly, allow negative values after all this.
  # /HB 2011-09-18
  validRange <- getOption("R.utils::Verbose/validThresholdRanges", c(-Inf,Inf))
  if (!is.null(validRange)) {
    validRange <- Arguments$getDoubles(validRange, length=c(2,2))
    if (threshold < validRange[1] || threshold > validRange[2]) {
      throw(sprintf("The threshold is out of the valid range [%s,%s]: %s",
                                    validRange[1], validRange[2], threshold))
    }
  }

  threshold
})


###########################################################################/**
# @RdocMethod isVisible
#
# @title "Checks if a certain verbose level will be shown or not"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{level}{A @numeric value to be compared to the threshold.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE, if given level is greater than (not equal to) the current
#   threshold, otherwise @FALSE is returned.
# }
#
# @author
#
# \seealso{
#   @seemethod "getThreshold" and @seemethod "setThreshold".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("isVisible", "Verbose", function(this, level=this$defaultLevel, ...) {
  isOn(this) && (is.null(level) || level > this$threshold)
})



###########################################################################/**
# @RdocMethod as.logical
#
# @title "Gets a logical value of this object"
#
# \description{
#   @get "title".  Returns \code{isVisible(this, level=this$defaultLevel)}.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a @logical value.
# }
#
# @author
#
# \seealso{
#   @seemethod "isVisible".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("as.logical", "Verbose", function(x, ...) {
  # To please R CMD check
  this <- x

  isVisible(this, level=this$defaultLevel)
})



###########################################################################/**
# @RdocMethod as.double
#
# @title "Gets a numeric value of this object"
#
# \description{
#   @get "title".  Returns what @seemethod "getThreshold" returns.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a @numeric value.
# }
#
# @author
#
# \seealso{
#   @seemethod "getThreshold" and @seemethod "getThreshold".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("as.double", "Verbose", function(x, ...) {
  # To please R CMD check
  this <- x
  getThreshold(this, ...)
})




###########################################################################/**
# @RdocMethod on
#
# @title "Turn on the output"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns (invisibly) @TRUE.
# }
#
# @author
#
# \seealso{
#   @seemethod "off" and @seemethod "isOn".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("on", "Verbose", function(this, ...) {
  this$.ignore <- FALSE
  invisible(TRUE)
})


###########################################################################/**
# @RdocMethod off
#
# @title "Turn off the output"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns (invisibly) @FALSE.
# }
#
# @author
#
# \seealso{
#   @seemethod "on" and @seemethod "isOn".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("off", "Verbose", function(this, ...) {
  this$.ignore <- TRUE
  invisible(FALSE)
})


###########################################################################/**
# @RdocMethod isOn
#
# @title "Checks if the output is on"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if output is on, otherwise @FALSE.
# }
#
# @author
#
# \seealso{
#   @seemethod "on" and @seemethod "off".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("isOn", "Verbose", function(this, ...) {
  !as.logical(this$.ignore)
})




###########################################################################/**
# @RdocMethod writeRaw
#
# @title "Writes objects if above threshold"
#
# \description{
#   @get "title".
#   This method is used by all other methods of this class for output.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "base::paste".}
#  \item{sep}{The default separator @character string.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("writeRaw", "Verbose", function(this, ..., sep="", level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  msg <- paste(..., sep="")
  if (this$asGString) {
    if (length(msg) > 1) {
      msg <- sapply(msg, FUN=function(s) {
        as.character(GString(s))
      })
    } else {
      msg <- as.character(GString(msg))
    }
  }

  cat(file=this$.con, append=TRUE, msg)

  invisible(TRUE)
}, protected=TRUE)




###########################################################################/**
# @RdocMethod cat
#
# @title "Concatenates and prints objects if above threshold"
#
# \description{
#   @get "title".
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "base::cat".}
#  \item{sep}{The default separator @character string.}
#  \item{newline}{If @TRUE, a newline is added at the end, otherwise not.}
#  \item{level}{A @numeric value to be compared to the threshold.}
#  \item{timestamp}{A @logical indicating if output should start with a
#     timestamp, or not.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seemethod "timestampOn" and \code{timestampOff}().
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("cat", "Verbose", function(this, ..., sep="", newline=TRUE, level=this$defaultLevel, timestamp=this$.timestamp) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  indent <- paste(rep(" ", length.out=this$indentPos), collapse="")
  msg <- paste(..., sep=sep)
  msg <- paste(indent, msg, sep="")
  if (timestamp) {
    fmt <- this$.timestampFormat
    if (is.function(fmt)) {
      stamp <- fmt()
    } else {
      stamp <- format(Sys.time(), fmt)
    }
    msg <- paste(stamp, msg, sep="")
  }
  if (newline)
    msg <- paste(msg, "\n", sep="")

  # Write output
  writeRaw(this, msg)
})


###########################################################################/**
# @RdocMethod printf
#
# @title "Formats and prints object if above threshold"
#
# \description{
#   @get "title".
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "base::sprintf".}
#  \item{fmtstr}{A @character string specify the printf format string.}
#  \item{level}{A @numeric value to be compared to the threshold.}
#  \item{timestamp}{A @logical indicating if output should start with a
#     timestamp, or not.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#*/###########################################################################
setMethodS3("printf", "Verbose", function(this, fmtstr, ..., level=this$defaultLevel, timestamp=this$.timestamp) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  cat(this, sprintf(fmtstr, ...), newline=FALSE, timestamp=timestamp)
})


###########################################################################/**
# @RdocMethod enter
# @aliasmethod enterf
#
# @title "Writes a message and indents the following output"
#
# \description{
#   @get "title".
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# \usage{
#   @usage "enter,Verbose"
#   @usage "enterf,Verbose"
# }
#
# \arguments{
#  \item{fmtstr}{An @see "base::sprintf" format string, which together with
#    \code{...} constructs the message.}
#  \item{...}{Objects to be passed to @seemethod "cat"
#             (or @see "base::sprintf").}
#  \item{indent}{The number of characters to add to the indentation.}
#  \item{sep}{The default separator @character string.}
#  \item{suffix}{A @character string to be appended to the end of the message.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("enter", "Verbose", function(this, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) {
  msg <- paste(..., sep=sep)
  msg <- as.character(GString(msg))
  cat(this, msg, suffix, sep=sep, level=level)
  this$.stack <- c(this$.stack, msg)
  this$.stackLevel <- c(this$.stackLevel, level)
  this$indentPos <- this$indentPos + indent
  invisible(TRUE)
})


setMethodS3("enterf", "Verbose", function(this, fmtstr, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) {
  enter(this, sprintf(fmtstr, ...), indent=indent, sep=sep, suffix=suffix, level=level)
})



###########################################################################/**
# @RdocMethod exit
#
# @title "Writes a message and unindents the following output"
#
# \description{
#   @get "title".
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @seemethod "cat". If not specified
#      the message used in the corresponding @seemethod "enter" call is used.}
#  \item{indent}{The number of characters to be removed from the indentation.}
#  \item{sep}{The default separator @character string.}
#  \item{suffix}{A @character string to be appended to the end of the message.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("exit", "Verbose", function(this, ..., indent=-this$indentStep, sep="", suffix="...done", level=NULL) {
  args <- list(...)

  # Argument 'indent'
  if (this$indentPos + indent < 0) {
    throw("Cannot exit(): Argument 'indent' makes 'indentPos' negative: ",
                                                    this$indentPos + indent)
  }

  len <- length(this$.stack)

  # Balance check
  if (length(len) == 0) {
    throw("Internal error:  Cannot exit(). Unbalanced enter()/exit() stack - it is already empty.")
  }

  lastMsg <- this$.stack[len]
  this$.stack <- this$.stack[-len]
  lastLevel <- this$.stackLevel[len]
  this$.stackLevel <- this$.stackLevel[-len]

  this$indentPos <- this$indentPos + indent

  if (length(args) == 0) {
    msg <- lastMsg
  } else {
    msg <- paste(..., sep=sep)
  }

  if (is.null(level))
    level <- lastLevel

  cat(this, msg, suffix, sep="", level=level)

  invisible(TRUE)
})



###########################################################################/**
# @RdocMethod more
#
# @title "Creates a cloned instance with a lower threshold"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{dThreshold}{The amount the threshold should be lowered.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a cloned @see "Verbose" object.
# }
#
# @author
#
# \seealso{
#   @seemethod "less"
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("more", "Verbose", function(this, dThreshold=1, ...) {
  # Clone first!
  res <- clone(this)

  # Decrease the threshold
  res$threshold <- res$threshold - dThreshold

  # Return the clone
  res
})


###########################################################################/**
# @RdocMethod less
#
# @title "Creates a cloned instance with a higher threshold"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{dThreshold}{The amount the threshold should be raised.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a cloned @see "Verbose" object.
# }
#
# @author
#
# \seealso{
#   @seemethod "more"
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("less", "Verbose", function(this, dThreshold=1, ...) {
  # Clone first!
  res <- clone(this)

  # Increase the threshold
  res$threshold <- res$threshold + dThreshold

  # Return the clone
  res
})


###########################################################################/**
# @RdocMethod print
#
# @title "Prints objects if above threshold"
#
# \description{
#   @get "title".
#   The output is \emph{not} indented.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "base::print".}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("print", "Verbose", function(x, ..., level=this$defaultLevel) {
  # To please R CMD check
  this <- x

  # So that print(this), which often called when 'this' is typed, works.
  args <- list(...)
  if (length(args) == 0) {
    return(NextMethod())
  }

  # ...otherwise...
  capture(this, print(...), level=level)
})




###########################################################################/**
# @RdocMethod str
#
# @title "Prints the structure of an object if above threshold"
#
# \description{
#   @get "title".
#   The output is \emph{not} indented.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "utils::str".}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("str", "Verbose", function(object, ..., level=this$defaultLevel) {
  # To please R CMD check
  this <- object

  if (!isVisible(this, level))
    return(invisible(FALSE))

  capture(this, str(...))
})


###########################################################################/**
# @RdocMethod summary
#
# @title "Generates a summary of an object if above threshold"
#
# \description{
#   @get "title".
#   The output is \emph{not} indented.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Objects to be passed to @see "base::summary".}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("summary", "Verbose", function(object, ..., level=this$defaultLevel) {
  # To please R CMD check
  this <- object

  if (!isVisible(this, level))
    return(invisible(FALSE))

  capture(this, print(summary(...)))
})


###########################################################################/**
# @RdocMethod evaluate
#
# @title "Evaluates a function and prints its results if above threshold"
#
# \description{
#   @get "title".
#   The output is \emph{not} indented.
# }
#
# @synopsis
#
# \arguments{
#  \item{fun}{A @function to be evaluated (only if above threshold).}
#  \item{...}{Additional arguments passed to the function.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#*/###########################################################################
setMethodS3("evaluate", "Verbose", function(this, fun, ..., level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  print(this, fun(...))
})



###########################################################################/**
# @RdocMethod capture
#
# @title "Captures output of a function"
#
# \description{
#   @get "title".
#   Evaluates its arguments with the output being verbosed.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Arguments to be captured.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns a @vector of @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#*/###########################################################################
setMethodS3("capture", "Verbose", function(this, ..., level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  args <- substitute(list(...))[-1]

  bfr <- NULL;  # To please R CMD check R v2.6.0.
  file <- textConnection("bfr", "w", local=TRUE)
  sink(file)
  on.exit({
    sink()
    close(file)
  })

  pf <- parent.frame()
  evalVis <- function(expr) {
    withVisible(eval(expr, pf))
  }

  for (kk in seq_along(args)) {
    expr <- args[[kk]]
    if (mode(expr) == "expression") {
      tmp <- lapply(expr, FUN=evalVis)
    } else if (mode(expr) == "call") {
      tmp <- list(evalVis(expr))
    } else if (mode(expr) == "name") {
      tmp <- list(evalVis(expr))
    } else {
      stop("Bad argument")
    }
    for (item in tmp) {
      if (item$visible)
         print(item$value)
    }
  }

  indent <- paste(rep(" ", length.out=this$indentPos), collapse="")
  bfr2 <- paste(indent, bfr, sep="")
  bfr2 <- paste(bfr2, collapse="\n")
  bfr2 <- paste(bfr2, "\n", sep="")
  writeRaw(this, bfr2)
})


###########################################################################/**
# @RdocMethod newline
#
# @title "Writes one or several empty lines"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{n}{The number of empty lines to write.}
#  \item{...}{Not used.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("newline", "Verbose", function(this, n=1, ..., level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  if (n < 0)
    stop("Argument 'n' must be zero or greater: ", n)
  if (n > 0)
    writeRaw(this, paste(rep("\n", n), collapse=""))
  invisible(TRUE)
})


###########################################################################/**
# @RdocMethod ruler
#
# @title "Writes a ruler"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{char}{A @character string to make up the ruler.}
#  \item{toColumn}{The column number where the ruler should finish.}
#  \item{length}{The length of the ruler.}
#  \item{...}{Not used.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("ruler", "Verbose", function(this, char="-", toColumn=this$rightMargin, length=toColumn-this$indentPos, level=this$defaultLevel, ...) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  char <- as.character(char)
  char <- strsplit(char, split="")[[1]]
  ruler <- rep(char, length.out=length)
  ruler <- paste(ruler, collapse="")
  cat(this, ruler)
})



###########################################################################/**
# @RdocMethod header
#
# @title "Writes a header"
#
# \description{
#   @get "title" surrounded by a frame.
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{The title.}
#  \item{char}{The @character string to make up the frame.}
#  \item{padding}{The number of rows and character to pad the title above,
#                 below, and to the left.}
#  \item{prefix}{The prefix of all padded lines and the title line.}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("header", "Verbose", function(this, ..., char="-", padding=0, prefix=paste(char, paste(rep(" ", max(padding, 1)), collapse=""), sep=""), level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  ruler(this, char=char)

  for (kk in seq_len(padding))
    writeRaw(this, prefix, "\n")

  cat(this, prefix, ..., sep="", collapse="\n")

  for (kk in seq_len(padding))
    writeRaw(this, prefix, "\n")

  ruler(this, char=char)
})



###########################################################################/**
# @RdocMethod timestamp
#
# @title "Writes a timestamp"
#
# \description{
#   @get "title" with default format [2005-06-23 21:20:03].
# }
#
# @synopsis
#
# \arguments{
#  \item{stamp}{A timestamp @character to be written.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("timestamp", "Verbose", function(this, format=getTimestampFormat(this), ...) {
  if (is.function(format)) {
    stamp <- format()
  } else {
    stamp <- format(Sys.time(), format)
  }
  cat(this, stamp, ...)
})


###########################################################################/**
# @RdocMethod getTimestampFormat
#
# @title "Gets the default timestamp format"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a @character string or a @function.
# }
#
# @author
#
# \seealso{
#   @seemethod "setTimestampFormat".
#   @seemethod "timestampOn".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("getTimestampFormat", "Verbose", function(this, ...) {
  this$.timestampFormat
})


###########################################################################/**
# @RdocMethod setTimestampFormat
#
# @title "Sets the default timestamp format"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{format}{If a @function, this function is called (without arguments)
#    whenever a timestamp is generated. If a @character string, it used as
#    the format string in \code{format(Sys.date(), fmt)}.}
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns (invisibly) the old timestamp format.
# }
#
# @author
#
# \seealso{
#   @seemethod "getTimestampFormat".
#   @seemethod "timestampOn".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("setTimestampFormat", "Verbose", function(this, format="%Y%m%d %H:%M:%S|", ...) {
  if (!is.function(format))
    format <- as.character(format)

  oldValue <- this$.timestampFormat
  this$.timestampFormat <- format

  invisible(oldValue)
})


###########################################################################/**
# @RdocMethod timestampOn
# @aliasmethod timestampOff
#
# @title "Turns automatic timestamping on and off"
#
# \description{
#   @get "title".
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns (invisibly) the old timestamp status.
# }
#
# @author
#
# \seealso{
#   @seemethod "setTimestampFormat".
#   @seemethod "timestampOn".
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("timestampOn", "Verbose", function(this, ...) {
  oldStatus <- this$.timestamp
  this$.timestamp <- TRUE
  invisible(oldStatus)
})

setMethodS3("timestampOff", "Verbose", function(this, ...) {
  oldStatus <- this$.timestamp
  this$.timestamp <- FALSE
  invisible(oldStatus)
})



###########################################################################/**
# @RdocMethod printWarnings
#
# @title "Outputs any warnings recorded"
#
# \description{
#   @get "title".
#   The output is indented according to @seemethod "enter"/@seemethod "exit"
#   calls.
# }
#
# @synopsis
#
# \arguments{
#  \item{title}{A @character string to be outputted before the warnings, if
#    they exists.}
#  \item{...}{Arguments passed to @seemethod "cat".}
#  \item{level}{A @numeric value to be compared to the threshold.}
# }
#
# \value{
#   Returns nothing.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @alias printWarnings
# @alias warnings.Verbose
# @keyword programming
#*/###########################################################################
setMethodS3("printWarnings", "Verbose", function(this, title="Warnings detected:", ..., level=this$defaultLevel) {
  if (!isVisible(this, level))
    return(invisible(FALSE))

  if (exists("last.warning", envir=.GlobalEnv)) {
    if (!is.null(title))
      cat(this, title)
    txt <- paste(capture.output(base::warnings()), collapse="\n")
    cat(this, txt, ..., level=level)
  }

  invisible(TRUE)
})


setMethodS3("warnings", "Verbose", function(this, ...) {
  .Deprecated(new = "printWarnings()", package = .packageName)
  printWarnings(this, ...)
}, deprecated = TRUE)


###########################################################################/**
# @RdocMethod pushState
# @aliasmethod popState
#
# @title "Pushes the current indentation state of the Verbose object"
#
# \description{
#   @get "title", which is controlled by @seemethod "enter" and
#   @seemethod "exit".  By pushing the state when entering a function and
#   using @see "base::on.exit" to pop the state, the correct state will
#   set regardless of if the functions returned naturally or via an error.
# }
#
# @synopsis
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns (invisibly) @TRUE.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#
# @keyword programming
#*/###########################################################################
setMethodS3("pushState", "Verbose", function(this, ...) {
  if (is.null(this$.stackState))
    this$.stackState <- list()

  stack <- list(
    stack      = this$.stack,
    stackLevel = this$.stackLevel
  )

  this$.stackState <- c(this$.stackState, list(stack))
  invisible(TRUE)
})


setMethodS3("popState", "Verbose", function(this, ...) {
  if (length(this$.stackState) == 0)
    throw("Stack empty!")

  n <- length(this$.stackState)
  stack <- this$.stackState[[n]]

  this$.stackState <- this$.stackState[-n]

  fromN <- length(this$.stack)
  toN <- length(stack$stack)

  if (fromN > toN) {
    for (kk in seq(from=fromN, to=toN+1, by=-1))
      exit(this)
  } else {
    this$.stack <- stack$stack
    this$.stackLevel <- stack$stackLevel
  }
  invisible(TRUE)
})
