.packageName <- "svMisc"
"Require" <-
function(package, bundle = NULL, quietly = FALSE, warn.conflicts = TRUE,
    keep.source = getOption("keep.source.pkgs"), character.only = FALSE,
    version, save = TRUE, gui=getOption("guiRequire")) {
	if (character.only == FALSE)
        packageName <- as.character(substitute(package))
    else
        packageName <- package
    # Check if the usual require() works
    res <- require(packageName, quietly, warn.conflicts, keep.source,
        character.only = TRUE, version, save)
	if (res) return(res)    # If TRUE, everything is fine!
    #if (packageName %in% installed.packages()[,"Package"] || packageName %in% .packages()) {
    #    return(require(packageName, quietly, warn.conflicts, keep.source,
    #        character.only = TRUE, version, save))
    #}
    if (is.null(gui)) gui <- FALSE
    if (!gui || .Platform$OS.type != "windows") {
        return(res) # We do nothing more
    }
    # Not needed any more with R 2.0.0 (use Depends: utils) require(utils) # for winDialog, file.choose, etc...
    libPaths <- .libPaths()
    libPathsString <- "''"
    if (length(libPaths) == 1)
        libPathsString <- .libPaths()
    if (length(libPaths) > 1)
        libPathsString <- paste("\"", paste(.libPaths(), collapse = "; "), "\"", sep = "")
    if (.Platform$OS.type == "windows")
        libPathsString <- gsub("/", "\\\\", libPathsString)
        
    if (!is.null(bundle)) packageName <- bundle # If the package is part of a bundle, we are better to look for the latter one!
	yesno <- winDialog(type = "yesno", message = paste("Package or bundle '", packageName, "' was not found in ",
        libPathsString, ".  Would you like to install it now?", sep = ""))
    if (yesno == "NO") {
        warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
        return(FALSE)
    }

    validRepositoryOrFileChosen <- FALSE
    while (validRepositoryOrFileChosen == FALSE) {
        choicelist <- c("CRAN", "Bioconductor", "SciViews", "Local Repository", "Local Zip File")
        choice <- select.list(choicelist)
        ## check for cancel button
        if (choice == "") {
            warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
            return(FALSE)
        }
        if (choice == "CRAN")
            Contrib <- contrib.url(getOption("CRAN"))
        else if (choice == "Bioconductor")
            Contrib <- contrib.url(getOption("BIOC"))
		else if (choice == "SciViews")
            Contrib <- "http://www.sciviews.org/SciViews-R"
        else if (choice == "Local Repository") {
            # Ask to select the repository "PACKAGES" description file
            pack <- choose.files(caption = "Select the directory PACKAGES description file",
                multi = FALSE, filters = c("Packages description", "PACKAGES"))
            if (length(pack) == 0) { # The user pressed Cancel
                warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
                return(FALSE)
            }
            pack <- gsub("\\\\", "/", pack)
            Contrib <- sub("PACKAGES", "", paste("file:", pack, sep = ""))
        }
        validRepositoryOrFileChosen <- TRUE
        CRANpackages <- ""
        if (choice != "Local Zip File" &&
            inherits(try(suppressWarnings(CRANpackages <- CRAN.packages(contriburl = Contrib)[ , "Package"]), TRUE), "try-error")) {
            if (validRepositoryOrFileChosen == TRUE) { # until now, that is!
                yesno <- winDialog(type = "yesno", message = paste("The repository '", Contrib,
                     "' does not appear to be a valid repository.",
                     " Would you like to try another repository?", sep = ""))
                if (yesno == "NO") {
                    warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
                    return(FALSE)
                }
                validRepositoryOrFileChosen <- FALSE
            }
        }
        if (CRANpackages[1] != "" || length(CRANpackages) > 1)
            if (choice != "Local Zip File" && !(packageName %in% CRANpackages)) {
                if (validRepositoryOrFileChosen == TRUE) { # until now, that is!
                    yesno <- winDialog(type = "yesno", message = paste("The package '", packageName,
                          "' was not found in the selected repository (", choice, ").",
                          " Would you like to try another repository?", sep = ""))
                    if (yesno == "NO") {
                        warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
                        return(FALSE)
                    }
                    validRepositoryOrFileChosen <- FALSE
                }
        }
    }

    if (choice == "Local Zip File") {
        invalidFileName <- TRUE
        while (invalidFileName) { # Or unknown file name the first time through the while loop.
            filename <- choose.files('', filters = Filters[c('zip', 'All'), ], multi = FALSE)
            if (filename == "") { # The user pressed Cancel
                warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
                return(FALSE)
            }
            yesnocancel <- "no"
            if (length(grep(paste(packageName, sep = ""), filename)) == 0)
                yesnocancel <- winDialog(type = "yesnocancel", message = paste("The selected file name does not contain the package name '",
                    packageName, "'. Would you like to select a different file instead?", sep = ""))
            else if (length(grep("\\.zip$", filename)) == 0)
                yesnocancel <- winDialog(type = "yesnocancel", message = paste("The selected file name does not end with '.zip'.",
                    " Would you like to select a different file instead?", sep = ""))
            if (yesnocancel == "CANCEL") {
                warning(paste("Missing package or bundle '", packageName, "' was neither installed nor loaded", sep = ""))
                return(FALSE)
            }
            if (yesnocancel == "YES") invalidFileName <- TRUE
            if (yesnocancel == "NO") invalidFileName <- FALSE
        }
        install.packages(filename, .libPaths()[1], CRAN = NULL)
        return(require(packageName, character.only = TRUE))
    }
        
    if (choice != "Local Zip File") {
        if (packageName %in% CRANpackages) {
            install.packages(packageName, contriburl = Contrib)
            return(require(packageName, character.only = TRUE))
        } else {
            cat(paste("The package or bundle was not found on", choice, "\n"))
            return(FALSE)
        }
    }
}
"TempEnv" <-
function() {
    pos <-  match("TempEnv", search())
    if (is.na(pos)) { # Must create it
        TempEnv <- list()
        attach(TempEnv, pos = length(search()) - 1)
        rm(TempEnv)
        pos <- match("TempEnv", search())
    }
    return(pos.to.env(pos))
}
"assignTemp" <-
function(x, value, replace.existing = TRUE)
    if (replace.existing || !exists(x, envir = TempEnv(), mode = "any", inherits = FALSE))
        assign(x, value, envir = TempEnv())
"compareRVersion" <-
function(version) {
    # This is similar to compareVersion, but works for R version comparison
    compareVersion(paste(R.Version()$major, R.Version()$minor, sep = "."), version)
}
"existsTemp" <-
function(x, mode = "any")
    exists(x, envir = TempEnv(), mode = mode, inherits = FALSE)
"findhtmlhelp" <-
function (topic, package = .packages(), lib.loc = NULL,
	verbose = getOption("verbose")) {
	# Determine if there is a HTML help file for a given topic
	# If yes return the filename, else return ""
	if (!missing(package))
		if (is.name(y <- substitute(package)))
			package <- as.character(y)
	if (!missing(topic)) {
		topic <- substitute(topic)
		if (is.name(topic)) topic <- as.character(topic)
		else if (!is.character(topic)) stop("Unimplemented help feature")
		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 <- "Extract"
		else if (!is.na(match(topic, c("&", "&&", "|", "||", "!"))))
			topic <- "Logic"
		else if (!is.na(match(topic, c("%*%"))))
			topic <- "matmult"
	}
	INDICES <- .find.package(package, lib.loc, verbose = verbose)
	file <- index.search(topic, INDICES, "AnIndex", "html")
	if (length(file) && file != "") {
		file <- chartr("/", "\\", file)
		if (file.exists(file))
			return(file)
	} else return("")
}
"getEnvironment" <-
function(pos) {
	# Retrieve an environment from a position in search(), or from its name
	# if pos = -1, returns the parent environment of the calling function
	# if the environment is "package:base", return NULL
	envir <- if (pos == -1) parent.frame(2) else as.environment(pos)
	return(envir)
}
"getTemp" <-
function(x, default = NULL, mode="any") {
    if  (exists(x, envir = TempEnv(), mode = mode, inherits = FALSE)) {
        return(get(x, envir = TempEnv(), mode = mode, inherits = FALSE))
    } else { # Variable not found, return the default value
        return(default)
    }
}
"guiCmd" <-
function(command) {
    # This function sends a command to the GUI client
    # The actual code is a custom function named .guiCmd (usually in TempEnv)
	#require(svMisc)
	CmdFun <- getTemp(".guiCmd", mode = "function")
    if (!is.null(CmdFun)) {
		CmdFun(command)
		return(TRUE)
	} else {
     	# Should not happen => better for debugging purpose!
        cat("Impossible to send the command:", command, "\n")
		return(command)
	}
}

"guiSource" <-
function(file, out.form = getOption("R.output.format"), local = FALSE, echo = FALSE, print.eval = TRUE,
    verbose = getOption("verbose"), prompt.echo = getOption("prompt"),
    max.deparse.length = 150, chdir = FALSE) {

    # This is a reworked version of .Rsource from RpadUtils (Tom Short)
	# but this version uses source() itself
	
	if (is.null(out.form)) out.form <- "text"
	# We capture output from source() with default args slightly modified
	res <- capture.output(source(file = file, echo = echo, print.eval = print.eval,
		verbose = verbose, prompt.echo = prompt.echo,
		max.deparse.length = max.deparse.length, chdir = chdir))
    if (out.form == "html") {
		require(R2HTML)
		res <- HTML(res, file = "")
    } else if (out.form != "none")
        res <- paste(paste(res, collapse="\n"), "\n")
    invisible(res)
}

"help.search.web" <-
function(apropos, type = c("google", "archive", "wiki")) {
	#acknowledge Barry Rowland code in r-help Fri, 08 Oct 2004 12:03:04

	type <- type[1]
	RSearchURL <- switch(type,
		"google"= paste("http://www.google.com/search?sitesearch=r-project.org&q=", apropos, sep = ''),
		"archive"= paste("http://www.google.com/u/newcastlemaths?q=", apropos, sep = ''),
		"wiki"= paste("http://fawn.unibw-hamburg.de/cgi-bin/Rwiki.pl?search=", apropos, sep = ''),
		stop("'type' could be only 'google', 'archive' or 'wiki', currently!"))
	browseURL(RSearchURL)
	return(invisible(0))
}

"isRgui" <-
function() (.Platform$GUI[1] == "Rgui")
"isSDI" <-
function() {
	# This function is specific to Windows, but it is defined everywhere
	# so that we don't have to test the platform before use!
	# Check if Rgui was started in SDI mode (needed by some GUI clients)
	# TO DO: use new features of R 2.0.0dev!
	# I found nothing indicating this in R, so, I have to look myself
	# in the right Rconsole file
	# rem: if this file is modified after start => I would got wrong value!

	# 1) First is it Rgui?
	if (!.Platform$GUI[1] == "Rgui")
        return(FALSE)    # This is not Rgui

    # The code is much simpler, starting form R 2.0.0
    if (compareRVersion("2.0") == 1) { # R >= 2.0.0
        # RGui SDI mode: returns "R Console", in MDI mode: returns "RGui"
        if (getIdentification() == "R Console") return(TRUE) else return(FALSE)
    }

    # Rem: this code will never run, because svMisc is compiled only for R >= 2.0.0
    # It is left there just in case one would like to make svMisc backward compatible!
    # 2) Check parameters
	if (any(commandArgs() == "--sdi"))
		return(TRUE)

	# 3) Look for Rconsole file
	UserDir <- Sys.getenv("R_USER")
	if (UserDir == "") UserDir <- Sys.getenv("HOME")
	if (UserDir == "") UserDir <- paste(Sys.getenv("HOMEDRIVE"),
		Sys.getenv("HOMEPATH"), sep="")
	if (UserDir == "") ConfFile <- "" else
		ConfFile <- paste(UserDir, "Rconsole", sep=.Platform$file.sep)
	# Does it exists
    if (!file.exists(ConfFile)) { # Look for a possible system-wide config file
        ConfFile <- paste(Sys.getenv("R_HOME"), "/etc/Rconsole", sep="")
        if (!file.exists(ConfFile))
			return(FALSE)	# No config file found => default behavious: MDI
	}
	
	# 4) Read the Rconsole file
	Conf <- read.table(ConfFile, sep="------", header = FALSE)
	# Look for a line starting with 'MDI'
	MDIpos <- grep("^MDI", as.vector(Conf[, 1]))
	if (length(MDIpos) == 0)
	    return(FALSE)   # Argument not found => default value (MDI)?
	MDIarg <- as.character(Conf[MDIpos[1], 1])
	MDIvalue <- strsplit(MDIarg, "=")[[1]][2]
	MDIvalue <-  gsub(" ", "", tolower(MDIvalue))
	# If contains "yes" or "1", it is MDI mode, otherwise SDI mode (?)
	if (MDIvalue == "yes") return(FALSE)
	if (MDIvalue == "1") return(FALSE)
	# Should be SDI mode?
	return(TRUE)
}
"isWin" <-
function() (.Platform$OS.type == "windows")
"listCustoms" <-
function(method, class) {
	# List all custom functions for a method and for a given class
	# For instance, a custom view is a function as 'view.class..<customview>'
	Pat <- paste("^", method, ".", class, "..", sep="")
	List <- sub(Pat, "", apropos(Pat, mode = "function"))
	return(List)
}
"listMethods" <-
function(f, S3 = TRUE, S4 = TRUE) {
	# Given a function, if it is generic then return a list of its methods
	
	## Check argument
	if (!inherits(f, "character"))
		stop("'f' must ba a character string!")
	# Keep only first item if a vector is provided
	f <- f[1]
	# Does this function exists?
	if (!exists(f, where = 1, mode = "function", inherits = TRUE))
		stop("'f' is not an existing function!")
	
	res <- NULL
		
	## S3 version
	if (S3) {
		# Get the list of functions that look like S3 methods for f
		S3met <- unclass(methods(f))	# It return a "MethodsFunction" object
		# Eliminate fun. in front of the methods' name
		S3met <- sub(paste(f, ".", sep = ""), "", S3met)
		L <- length(S3met)
		if (L > 0) { # Test all these possible candidates
			S3OK <- NULL
			for (i in 1:L) {
				test <- try(getS3method(f, S3met[i]), silent = TRUE)
				S3OK[1] <- (!inherits(test, "try-error"))	
			}
			# Keep only those candidates that succeed in the test
			S3met <- S3met[S3OK]
			attr(S3met, "info") <- attr(S3met, "info")[S3OK, ]
		}
		res$S3 <- S3met
	}
	
	## S4 version
	if (S4) {
		S4met <- character(0)
		if (isGeneric(f, where = .GlobalEnv)) {
			allS4met <- getMethods(f, where = .GlobalEnv)@allMethods
			if (!is.null(allS4met))
				S4met <- names(allS4met)
		}
		res$S4 <- S4met
	}
	
	res
}
"progress" <-
function(value, max.value = NULL) {
	# A progress indicator in the R console
	if (!is.numeric(value))
		stop("`value' must be numeric!")
	if (is.null(max.value)) {
		max.value <- 100
		percent <- TRUE
	} else percent <- FALSE
	if (!is.numeric(max.value))
		stop("`max.value' must be numeric or NULL!")
	# If value is higher than max.value, we erase the message
	erase.only <- (value > max.value)
	# Now that everything is OK, we can proceed
	# We work only with integer part of the values
	# and transform them into strings of same length
	max.value <- as.character(round(max.value))
	l <- nchar(max.value)
	value <- formatC(round(value), width = l)
	# Treatment is different if it is 'x%' or 'x on y' display type
	if (percent) {
		backspaces <- paste(rep("\8", l + 14), collapse = "")
		if (erase.only) message <- "" else
			message <- paste("Progress: ", value, "%  ", sep = "")
		cat(backspaces, message, sep = "")
	} else {
		backspaces <- paste(rep("\8", 2 * l + 16), collapse = "")
		if (erase.only) message <- "" else
			message <- paste("Progress: ", value, " on ", max.value, "  ", sep = "")
		cat(backspaces, message, sep = "")	
	}
	# Under Windows, make sure the message is actualized
	if (.Platform$OS.type == "windows") flush.console()	
	invisible(NULL)
}
"rmTemp" <-
function(x) {
    if (!is.character(x))
        stop("'x' must be a character string, or vector of strings!")
    for (i in 1:length(x))
        try(if (exists(x[i], env = TempEnv())) rm(list = x[i], envir = TempEnv()), silent = TRUE)
}
"tempdirWin" <-
function() {
	if (!isWin()) stop("This function is for Windows only!")
	### TO DO: a platform-independent version!
	
	# Get the Windows temp dir (useful to communicate with other programs)
	# It is assumed to be the parent of the R session temp dir
	return(sub("\\\\Rtmp[0-9]+$", "", tempdir()))
}
"tempvar" <- function(pattern = ".var") {
	# Similar to tempfile() but for temporary variables
	repeat {
		var <- paste(pattern, as.integer(runif(1) * 100000), sep = "")
		if (!exists(var, where = 1, inherits = TRUE)) break()
	}
	var
}
"userdir" <-
function() {
	# Return the user directory ("My Documents" under Windows)
	return(Sys.getenv("R_User"))
}
