source <-
function(file, local=FALSE, echo = debug, print.eval=echo, debug=FALSE,
	 max.deparse.length=150)
{
 envir <- if (local) sys.frame(sys.parent()) else .GlobalEnv
 if(debug) { cat("'envir' chosen:"); print(envir) }
 Ne <- length(exprs <- parse(n = -1, file = file))
 if(debug)
	cat("--> parsed", Ne, "expressions; now eval(.)ing them:\n")
 if (Ne == 0) return(invisible())
 ass1 <- expression(y <- x)[[1]][[1]] #-- ass1 :  the  '<-' symbol/name
 for (i in 1:Ne) {
	if(debug)
	  cat("\n>>>> eval(expression_nr.",i,")\n\t  =================\n")
	ei <- exprs[i]
	if(echo) {
		dep <- paste(deparse(ei), collapse="\n")
		if(nchar(dep) > max.deparse.length)
			dep <- paste(substr(dep, 1, max.deparse.length),
				     " .... [TRUNCATED] ")
		cat("\n> ", dep, "\n", sep="")
	}
	yy <- eval(ei, envir)
	i.symbol <- mode(ei[[1]]) == "name"
	if(!i.symbol) {
		curr.fun <- ei[[1]][[1]]## ei[[1]] : the function "<-" or other
		if(debug) { cat('curr.fun:'); str(curr.fun) }
	}
	if(debug >= 2) {
	  cat(".... mode(ei[[1]])=", mode(ei[[1]]),"; paste(curr.fun)=");
	  str(paste(curr.fun))
	}
	if(print.eval &&
	   (i.symbol|| (length(pf <- paste(curr.fun))==1 &&
			all(paste(curr.fun) != c("<-","cat", "str", "print")))))
		print(yy)
	if(debug) cat(" .. after `", deparse(ei), "'\n", sep="")
 }
 invisible(yy)
}

sys.source <- function (file)
{
	exprs <- parse(n = -1, file = file)
	if (length(exprs) == 0) return(invisible())
	for (i in exprs) {
		yy <- eval(i, NULL)
	}
	invisible(yy)
}

demo <- function(topic, device = x11, directory.sep = "/")
{
 Topics <-cbind(graphics = c("graphics","graphics",	"G"),
		image	 = c("graphics","image",	"G"),
		lm.glm	 = c("models",	"lm+glm",	"G"),
		glm.vr	 = c("models",	"glm-v+r",	""),
		nlm	 = c("nlm",	"valley",	""),
		recursion= c("language","recursion",	"G"),
		scoping	 = c("language","scoping",	"")
		)
 dimnames(Topics)[[1]] <- c("dir", "file", "flag")
 topic.names <- dimnames(Topics)[[2]]
 demo.help <- function() {
	cat("Use ``demo(topic)'' where choices for argument `topic' are:\n")
	cbind(topics = topic.names)
 }
 if(missing(topic)) return(demo.help())
 topic <- substitute(topic)
 if (!is.character(topic)) topic <- deparse(topic)[1]
 i.top <- pmatch(topic, topic.names)
 if (is.na(i.top) || i.top == 0) {
	cat("unimplemented `topic' in demo.\n")
	print(demo.help())
	stop()
 } else {
	topic <- topic.names[i.top]
	cat("\n\n\tdemo(",topic,")\n\t---- ",rep("~",nchar(topic)),
	    "\n\nType  <Return>  to start : ",sep="")
	readline()
	if((!exists(".Device") || is.null(.Device)) &&
	   Topics["flag",i.top] == "G")
		device()
	source(paste(getenv("RHOME"),
		     "demos",
		     Topics["dir",  i.top],
		     Topics["file", i.top], sep= directory.sep),
	       echo = TRUE, max.deparse.length=10000)
 }
}

