data <- function(..., list=character(0))
{
	names <- c(as.character(substitute(list(...))[-1]), list)
	if(length(names) == 0) {
		datafile<-system.file("data","index.doc")
		if( datafile == "" )
			stop("no index file for data")
		xx<-scan(datafile,skip=3,what="",sep="\t")
		cat("   R DATA SETS \n")
		cat(t(matrix(xx[!is.na(xx)],nc=2,byrow=T)),sep=c("\t\t","\n"))
	}
	else
		for(name in names) {
			file <- system.file("data", name)
			if(file == "") stop(paste("no data set called", name))
			else source(file)
	}
	invisible(names)
}

"load.from.datalib" <-
function (name)
{
	file <- system.file("datalib", name)
	if (file == "")
		stop(paste("no data set called", name))
	eval(parse(file))
}
help <- function (topic, data, library)
{
  if(!missing(topic)) {
    topic <- substitute(topic)
    if (is.character(topic) || is.name(topic)) {
      if (!is.character(topic)) 
	topic <- deparse(topic)
      if (!is.na(match(topic, c("+", "-", "*", "/", "^", "%%")))) 
	topic <- "Arithmetic"
      else if (!is.na(match(topic, c("<", ">", "<=", ">=", "==", "!=")))) 
	topic <- "Comparison"
      else if (!is.na(match(topic, c("&", "&&", "|", "||", "!")))) 
	topic <- "Logic"
      else if (!is.na(match(topic, c("[", "[[", "$"))))
	topic <- "Extract"
      system(paste("RLIBS=\"", paste(.lib.loc, collapse = " "), "\";",
		   "export RLIBS;", "${RHOME}/cmd/help", topic,
		   paste(.library(), collapse = " ")))
    } else {
      topic <- as.character(topic)
      if (topic[1] == "data") {
	file <- system.file("data", paste(topic[2], ".doc", sep = ""))
	if (file == "") 
	  stop(paste("no documentation for dataset", topic[2]))
	else system(paste("$RHOME/cmd/pager", file))
      } else if (topic[1] == "library") {
	file <- system.file("help", paste(topic[2], "/INDEX", sep = ""))
	if (file == "") 
	  stop(paste("no documentation for dataset", topic[2]))
	else system(paste("$RHOME/cmd/pager", file))
      }
      else stop("unimplemented help feature")
    }
  } else if(!missing(data)) {
    topic <- as.character(substitute(data))
    file <- system.file("data", paste(topic, ".doc", sep = ""))
    if (file == "") 
      stop(paste("no documentation for dataset", topic))
    else system(paste("$RHOME/cmd/pager", file))
  } else if(!missing(library)) {
    topic <- as.character(substitute(library))
    file <- system.file("help", paste(topic, "/INDEX", sep = ""))
    if (file == "") 
      stop(paste("no documentation for library", topic))
    else system(paste("$RHOME/cmd/pager", file))
  }
  else system("$RHOME/cmd/help help base")
}
require <- function(name, quietly = FALSE)
{
  name <- as.character(substitute(name)) # allowing "require(eda)"
  if (is.na(match(paste("package", name, sep=":"), search()))) {
    if (!quietly)
      cat("Autoloading required library:", name, "\n")
    .library(name, logical = TRUE)
  }
  else
    TRUE
}

provide <- function(name) 
{
  if (!exists(".Provided", inherits = TRUE)) 
    assign(".Provided", character(0), envir = .GlobalEnv)
  if (missing(name)) 
    .Provided
  else {
    name <- as.character(substitute(name))
    if (is.na(match(name, .library())) &&
	is.na(match(name, .Provided))) {
      assign(".Provided", c(name, .Provided), envir = .GlobalEnv)
      TRUE
    }
    else
      FALSE
  }
}

library <- function(name, help = NULL, lib.loc = .lib.loc)
{
  if (missing(name)) {
    if (missing(help)) {
      for (lib in lib.loc) {
	cat("\nPackages in library `", lib, "':\n\n", sep = "")
	system(paste("cat ", lib, "/help/LibIndex 2>/dev/null", sep = ""))
      }
      invisible(.library())
    }
    else {
      pkg <- as.character(substitute(help))
      file <- system.file("help", paste(pkg, "/INDEX", sep = ""))
      if (file == "")
	stop(paste("no documentation for package `", pkg, "'", sep = ""))
      else
	system(paste("$RHOME/cmd/pager", file))
    }
  }
  else {
    name <- as.character(substitute(name))
    invisible(.library(name))
  }
}

.library <- function(chname, logical.return = FALSE)
{
  if (missing(chname)) {		# ``substitute'' for old .Libraries
    s <- search()
    return(invisible(substring(s[substr(s,1,8) == "package:"], 9)))
  }
  lib.source <- function(file, env)
    {
      exprs <- parse(n = -1, file = file)
      if (length(exprs) == 0) return(invisible())
      for (i in exprs)
	yy <- eval(i, env)
      invisible()
    }
  libname <- paste("package", chname, sep = ":")
  if (is.na(match(libname, search()))) {
    file <- system.file("library", chname)
    if (file == "") {
      txt <- paste("there is no package called `", chname, "'", sep= "")
      if (logical.return) { warning(txt); return(FALSE) } else stop(txt)
    }
    env <- attach(NULL, name=libname)
    lib.source(file, env)
    lib.fixup(env, .GlobalEnv)
  }
  if (logical.return) TRUE else invisible(.library())
}

library.dynam <- function(name)
{
  if (!exists(".Dyn.libs"))
    assign(".Dyn.libs", character(0), envir = .GlobalEnv)
  if (is.na(match(name, .Dyn.libs))) {
    .Internal(dyn.load(system.file("lib", name)))
    assign(".Dyn.libs", c(.Dyn.libs, name), envir = .GlobalEnv)
  }
  invisible(.Dyn.libs)
}
system <- function(call, intern=FALSE) 
	.Internal(system(call,intern))

system.file <- function(dir, name) .Internal(system.file(dir,name))
unix.time <- function(expr)
{
  ## Purpose: Return CPU (and other) times that 'expr' used ..
  ##	Modelled after S`s  "unix.time"; to be used with R (rel. 0.4 & later)
  ## -------------------------------------------------------------------------
  ## Arguments: expr: 'any' valid R expression
  ## -------------------------------------------------------------------------
  if(!exists("proc.time", mode = "function", inherits=TRUE))
    stop(paste("proc.time  must be enabled at configuration / compile time\n",
	       "	[add '-DProctime' to SYSTEM in src/Systems/<YOURSYS>]"))

  loc.frame <- sys.parent(1)

##-S   if(loc.frame == 1)
##-S    loc.frame <- F
  on.exit(cat("Timing stopped at:", proc.time() - time, "\n"))
  expr <- substitute(expr)
  time <- proc.time()
  eval(expr, envir = loc.frame) #<-- 'R'
  new.time <- proc.time()
  on.exit()
  if(length(new.time) == 3)    new.time <- c(new.time, 0, 0)
  if(length(time) == 3)        time     <- c(time, 0, 0)
  new.time - time
}
