###########################################################################/**
# @RdocDefault findSourceTraceback
#
# @title "Finds all 'srcfile' objects generated by source() in all call frames"
#
# @synopsis
#
# \description{
#   @get "title".  This makes it possible to find out which files are
#   currently scripted by @see "base::source".
# }
#
# \arguments{
#  \item{...}{Not used.}
# }
#
# \value{
#   Returns a named list of @see "base::srcfile" objects and/or
#   @character strings.
#   The names of the list entries corresponds to the 'filename'
#   value of each corresponding 'srcfile' object.
#   The returned list is empty if @see "base::source" was not called.
# }
#
# @examples "../incl/findSourceTraceback.Rex"
#
# @author
#
# \seealso{
#   See also @see "utils::sourceutils".
# }
#
# @keyword IO
# @keyword programming
#*/###########################################################################
setMethodS3("findSourceTraceback", "default", function(...) {
  # Identify the environment/frame of interest by making sure
  # it at least contains all the arguments of source().
  argsToFind <- names(formals(source));

  # Scan the call frames/environments backwards...
  srcfileList <- list();
  for (ff in sys.nframe():0) {
    env <- sys.frame(ff);

    # Does the environment look like a source() environment?
    exist <- sapply(argsToFind, FUN=exists, envir=env, inherits=FALSE);
    if (!all(exist)) {
      # Nope, then skip to the next one
      next;
    }
    # Identify the source file
    srcfile <- get("srcfile", envir=env, inherits=FALSE);
    if (!is.null(srcfile)) {
      if (!is.function(srcfile)) {
        srcfileList <- c(srcfileList, list(srcfile));
      }
    }
  } # for (ff ...)

  # Extract the pathnames to the files called
  pathnames <- sapply(srcfileList, FUN=function(srcfile) {
    if (inherits(srcfile, "srcfile")) {
      pathname <- srcfile$filename;
    } else if (is.environment(srcfile)) {
      pathname <- srcfile$filename;
    } else if (is.character(srcfile)) {
      # Occurs with source(..., keep.source=FALSE)
      pathname <- srcfile;
    } else {
      pathname <- NA_character_;
      warning("Unknown class of 'srcfile': ", class(srcfile)[1L]);
    }
    pathname;
  });
  names(srcfileList) <- pathnames;

  srcfileList;
}) # findSourceTraceback()


############################################################################
# HISTORY:
# 2013-07-27
# o BUG FIX: findSourceTraceback() would give an error "Unknown class of
#   'srcfile': character" for source(..., keep.source=FALSE) in recent
#   R devel and R v3.0.1 patched.  Thanks Duncan Murdoch for the report.
# 2012-06-07
# o DOCUMENTATION: Added a link to help("sourceutils", package="utils").
# 2010-09-29
# o BUG FIX: Each entry identified by findSourceTraceback() would
#   be duplicated.
# o Added an example to help(findSourceTraceback).
# 2010-03-02
# o BUG FIX: findSourceTraceback() stopped working; probably due to some
#   recent updates in base::source().
# 2009-10-20
# o Created.
############################################################################
