.packageName <- "svIDE"
"Args" <-
function(name, only.args = FALSE){
	# A better args() function using formals()
	#### TO DO: handle primitives and S3/S4 methods for generic functions
	res <- formals(name)
	if (length(res) < 1){
		if (only.args) res <- " " else res <- paste(name, "()", sep = "")
	} else {
		res1 <- names(res)
		for (i in 1:length(res1))
			if (deparse(res[[res1[i]]])[1] != "") 
				res1[i] <- paste(res1[i], "=", deparse(res[[res1[i]]]))
		res <- paste(res1, collapse = ", ")
		if (!only.args)
            res <- paste(name, "(", res, ")", sep = "")
	}
	res
}
"CallTip" <-
function(code, only.args = FALSE, location = FALSE) {
	# Get a call tip, given a part of the code
	# Extract the last variable name, given it is either at the end, or terminated by '('
	code <- sub(" *\\($", "", code[1])
	pos <- regexpr("[a-zA-Z0-9_\\.]+$", code, useBytes = TRUE)
	code <- substring(code, pos)

	# Get the corresponding Call Tip
	ctip <- "" # Default value, in case the function does not exist
	if (code != "" && exists(code, where = 1, mode = "function"))
        ctip <- Args(code, only.args = only.args)
	# Do we need to append an indication of where this function is located?
	if (location == TRUE) {
 		pkg <- sub("^package:", "", find(code, mode = "function"))
	    if (length(pkg) > 0 && pkg != ".GlobalEnv") ctip <- paste(ctip, " [", pkg, "]", sep = "")
	}
	return(ctip)
}
"Complete" <-
function(code, givetype = FALSE, fieldsep = "|") {
	# Get a completion list, given a part of the code

    # This code gets the (partial) name of a variable at the end of a string
    getName <- function(code) {
        if (length(grep("[a-zA-Z0-9_\\.]$", code)) == 0) return("")
        pos <- regexpr("[a-zA-Z0-9_\\.]+$", code, useBytes = TRUE)
	    name <- substring(code, pos)
	    return(name)
    }
    # get the type of object
    getType <- function(name, fieldsep = "|") {
		Obj <- get(name)
		ObjClass <- class(Obj)[1]
		if (ObjClass == "function") {
			if (class(getS3method(name, "default", optional = TRUE)) == "function")
				ObjClass <- "method"
		} else if (is.vector(Obj)) {
			ObjClass <- "vector"
		} else if (!(ObjClass %in%  c("data.frame", "matrix", "array", "table", "list"))) {
			ObjClass <- "other"
		}
		res <- paste(name, ObjClass, sep = fieldsep)
		return(res)
	}

    # Determine what is asked according to last chars in code
    name <- NULL

    # 1) If code ends by '$' or '[[', then try to subset a list or data.frame
    if (length(grep("\\$$", code)) != 0)
        name <- getName(sub("\\$$", "", code))
    if (length(grep("\\[\\[$", code)) != 0)
        name <- getName(sub("\\[\\[$", "", code))
    if (!is.null(name)) {
        if (!exists(name, where = 1)) return("")
		obj <- get(name, pos = 1)
		if (!(inherits(obj, "list") || inherits(obj, "data.frame"))) return("")
        # Get names of this list
        res <- names(obj)
        # Eliminate items without names
		res <- res[res != ""]
        if (length(res) == 0) return("")
        # possibly append the type "subset"
		if (givetype) res <- paste(res, "subset", sep = fieldsep)
		return(paste(res, collapse = "\n"))
    }
    
    # 2) If code ends by '@', then try to get slots of an S4 object
    if (length(grep("@$", code)) != 0)
        name <- getName(sub("@$", "", code))
    if (!is.null(name)) {
        if (!exists(name, where = 1)) return("")
		obj <- get(name, pos = 1)
        slots <- getSlots(class(obj))
        if (length(slots) == 0) return("")
        slotnames <- names(slots)
        if (givetype) {
            return(paste(slotnames, slots, sep = fieldsep, collapse = "\n"))
        } else {
            return(paste(slotnames, collapse = "\n"))
        }
    }
    
    # 3) If code ends by A-Za-z0-9._, we must be writing a keyword => look for a list of matching keywords
    #    else, just return the list of variables in .GlobalEnv
    name <- getName(code)
	if (name == "") { # Just list items in .GlobalEnv
		res <- ls(pos = 1)
		if (length(res) == 0) return("")
	} else {
		res <- apropos(paste("^", gsub("\\.", "\\\\.", name), sep = ""))
		if (length(res) == 0) return("")
	}
	# Get more info about these items
	if (givetype) res <- sapply(res, getType, fieldsep = fieldsep)
	names(res) <- NULL
    return(paste(res, collapse = "\n"))
}
# last modified 22 February 2005 by Ph. Grosjean

".onLoad" <-
function(lib, pkg) {
    # Starting the DDE server automatically if under Windows and option use.DDE == TRUE 
    use.DDE <- getOption("use.DDE")
    if (.Platform$OS.type == "windows" && !is.null(use.DDE) && use.DDE) guiDDEInstall()
    
    # If an IDE is defined, start it now
    IDE <- getOption("IDE")
    if (!is.null(IDE) && file.exists(IDE))
        system(paste("\"", IDE, "\"", sep = ""), wait = FALSE)
}

# Specific functions for Tinn-R (adapted by J.-C. Faria from function in svGUI
# made by Ph. Grosjean)

"trObjSearch" <-
function (path = NULL, compare = TRUE) {
	Search <- as.matrix(data.frame(Workspace = search()))
	if (is.null(path)) return(Search)
	file <- file.path(path, "Search.txt")
	if (compare) {
		oldSearch <- getTemp(".guiObjSearchCache", default = "")
		if (!(all.equal(Search, oldSearch)[1] == TRUE)) {
			assignTemp(".guiObjSearchCache", Search)
			Changed <- TRUE
		} else Changed <- FALSE
	} else Changed <- TRUE
    write.table(Search, file = file, row.names = FALSE, quote = FALSE, sep = "\t")
}

"trObjList" <-
function(id = "default", env.name = NULL, pos = 1, all.names = FALSE,
pattern = "", group = "", path = NULL, compare = TRUE) {
	oWidth <- getOption("width")
	options(width = 100)
	on.exit(options(width = oWidth))

	"describe" <- function(name, pos = 1) {
		Obj <- get(name, pos = pos)
		ObjDetails <- ""
		ObjGroup <- "other"
		ObjClass <- class(Obj)[1]
		if (inherits(Obj, "function")) {
			ObjGroup <- "function"
		} else if (inherits(Obj, "data.frame")){
			ObjDetails <- paste(dim(Obj), collapse = "x")
			ObjGroup <- "data.frame"
		} else if (inherits(Obj, "matrix")) {
			ObjDetails <- paste(dim(Obj), collapse = "x")
			ObjGroup <- "matrix"
		} else if (inherits(Obj, "array")) {
			ObjDetails <- paste(dim(Obj), collapse = "x")
			ObjGroup <- "array"
		} else if (inherits(Obj, "table")) {
			ObjDetails <- paste(dim(Obj), collapse = "x")
			ObjGroup <- "table"
		} else if (inherits(Obj, "list")) {
			ObjDetails <- as.character(length(Obj))
			ObjGroup <- "list"
		} else if (inherits(Obj, "vector")) {
			ObjDetails <- as.character(length(Obj))
			ObjGroup <- "vector"
		} else if (is.vector(Obj)) {
			ObjDetails <- as.character(length(Obj))
			ObjGroup <- "vector"
		}
		res <- c(name, ObjDetails, ObjGroup, ObjClass)
		return(res)
	}

	# Make sure that id is character
	id <- as.character(id)
	if (id == "") id <- "default"

	# Get pos if env.name is provided
	if (!is.null(env.name)) {
		pos <- match(env.name, search())
		if (is.na(pos)) pos <- 1	# Default value when no match (go back to .GlobalEnv)
	}

	# Get the list
	RawList <- ls(pos = pos, all.names = all.names, pattern = pattern)
	if (length(RawList) > 0) {
		List <- t(sapply(RawList, describe, pos = pos))
		if (nchar(group) > 0)
			if (group == "data") {	# Special treatment, everything that is not a function
				List <- List[List[, 3] != "function"]
			} else List <- List[List[, 3] == group, ]
		List <- matrix(List, ncol = 4)
		if (length(List) < 1) List <- matrix(c("","","",""), nrow = 1)
	} else List <- matrix(c("", "", "", ""), nrow = 1)
	colnames(List) <- c("Name", "Dims", "Group", "Class")

	if (!is.null(path)) {  # Write to files in this path
		# Create file names
		ListFile <- file.path(path, paste("List_", id, ".txt", sep=""))
		ParsFile <- file.path(path, paste("Pars_", id, ".txt", sep=""))
		# Determine if it is required to refresh these files
		if (compare) {
			allList <- getTemp(".guiObjListCache", default = list())
			if (length(allList) >= id) oldList <- allList[[id]] else oldList <- ""
			if (is.null(oldList)) oldList <- ""
			# Compare both versions
			if (!(all.equal(List, oldList)[1] == TRUE)) {
				allList[[id]] <- List
				# Keep a copy of the last version in TempEnv
				assignTemp(".guiObjListCache", allList)
				Changed <- TRUE
			} else Changed <- FALSE
		} else Changed <- TRUE
		if (Changed) {
			write.table(List, file = ListFile, row.names = FALSE, quote = FALSE, sep = "\t")
			# Write also in the Pars_<id>.txt file in the same directory
			cat("pos=", pos, "\n", sep = "", file = ParsFile)
			cat("envir=", search()[pos], "\n", sep = "", file = ParsFile, append = TRUE)
			cat("all.names=", all.names, "\n", sep = "", file = ParsFile, append = TRUE)
			cat("pattern=", pattern, "\n", sep = "", file = ParsFile, append = TRUE)
			cat("group=", group, "\n", sep = "", file = ParsFile, append = TRUE)
		}
	} else return(List) # If no path is specified, just return the matrix
}
"createCallTipFile" <-
function(file = "Rcalltips.txt", pos = 2:length(search()), field.sep = "=",
    only.args = FALSE, return.location = FALSE) {
	# Create a .txt file containing calltips for R functions.
	
	# Create the beginning of the file
	cat("", file = file) # Currently, needs nothing...
	
	# Get the list of keywords
	keys <- getKeywords(pos = pos)
	
	# For each keyword, write a line in the file with keyword=calltip
    for (i in 1:length(keys)) {
        ctip <- CallTip(keys[i], only.args = only.args)
        if (ctip != "") {
            if (return.location == TRUE) {
				# Get the package from where it is located and append it
				pkg <- sub("^package:", "", find(keys[i], mode = "function"))
				if (length(pkg) > 0 && pkg != ".GlobalEnv") pkg <- paste(" [", pkg, "]", sep = "") else pkg <- " []"
            } else pkg <- ""
            cat(keys[i], field.sep, ctip, pkg, "\n", sep = "", file = file, append = TRUE)
		}
    }
}
"createSyntaxFile" <-
function(svlfile = "R.svl", pos = 2:length(search())) {
	# Create an .svl syntax file for R.
	# Note: use only main keywords for keywords2, because it is limited
	# to a little bit less than 32k (2.000 to 2.500 keywords)
	
	# Create the beginning of the file
	cat(";This is a config file internally used by SciViews.\n",
		file = svlfile)
	cat(";Do not change it manually, except if you exactly know what you are doing!\n\n",
		file = svlfile, append = TRUE)
	cat(";If several items, use a comma-separated list (a, b, ...)\n",
		file = svlfile, append = TRUE)
	cat(";for Options\AutoIndent: 0=Off, 1=follow language scoping and 2=copy from previous line\n",
		file = svlfile, append = TRUE)
	cat(";Keywords1 are reserved keywords, or preprocessor keywords\n",
		file = svlfile, append = TRUE)
	cat(";for Keywords2, use only the most important ones (you are limited to a total of a little bit less than 32k)!\n\n",
		file = svlfile, append = TRUE)
	cat(";This file is automatically generated from R using createSyntaxFile()\n\n",
		file = svlfile, append = TRUE)
	
	cat("[General]\n", file = svlfile, append = TRUE)
	cat("Description=Syntax definition for R\n",
		file = svlfile, append = TRUE)
	cat(paste("Version=", R.version$major, ".", R.version$minor, "\n",
		sep = ""), file = svlfile, append = TRUE)
	cat("FileExtensions=*.R\n\n", file = svlfile, append = TRUE)
	
	cat("[Syntax]\n", file = svlfile, append = TRUE)
	cat("CaseSensitive=1\n", file = svlfile, append = TRUE)
	cat("SingleLineComment=#\n", file = svlfile, append = TRUE)
	cat("ScopeKeywords1={,(,[,[[,$,@,\n", file = svlfile, append = TRUE)
	cat("ScopeKeywords2=},),],]],$,@,\n", file = svlfile, append = TRUE)
	cat("StringDelimiters=\",',`\n", file = svlfile, append = TRUE)
	cat("EscapeChar=\\\n\n", file = svlfile, append = TRUE)
	
	cat("[Options]\n", file = svlfile, append = TRUE)
	cat("FixupKeywordCase=0\n", file = svlfile, append = TRUE)
	cat("AutoIndent=1\n", file = svlfile, append = TRUE)
	cat("Tabs=4\n", file = svlfile, append = TRUE)
	cat("ConvertTabsToSpaces=0\n", file = svlfile, append = TRUE)
	cat("ColumnSel=0\n", file = svlfile, append = TRUE)
	cat("HSplitter=0\n", file = svlfile, append = TRUE)
	cat("VSplitter=1\n\n", file = svlfile, append = TRUE)
	
	cat("[Operators]\n", file = svlfile, append = TRUE)
	cat("-\n!\n!=\n%\n%%\n%*%\n%/%\n%in%\n%o%\n%x%\n&\n&&\n*\n,\n/\n:\n::\n:::\n?\n^\n|\n||\n~\n+\n<\n<-\n<<-\n<=\n=\n==\n>\n->\n>=\n->>\n\n",
		file = svlfile, append = TRUE)
	
	cat("[Keywords1]\n", file = svlfile, append = TRUE)
	cat("...\n..1\n..2\n..3\n..4\n..5\n..6\n..7\n..8\n..9\nbreak\nelse\nFALSE\nfor\nfunction\nif\nin\nInf\nNA\nNaN\nnext\nNULL\nrepeat\nTRUE\nwhile\n\n",
		file = svlfile, append = TRUE)
	
	cat("[Keywords2]\n", file = svlfile, append = TRUE)
	write.table(getKeywords(pos = pos), file = svlfile, append = TRUE, quote = FALSE,
		row.names = FALSE, col.names = FALSE)
}
"getFunctions" <-
function(pos) {
	# Get a list of all R functions in a certain position
	lst <- objects(pos = pos, all.names = TRUE)
	l <- length(lst)
	if (l == 0) return(NULL) else {
		isFun <- rep(FALSE, l)
		for (i in 1:l)
			if (exists(lst[i], where = pos, mode = "function", inherits = FALSE))
				isFun[i] <- TRUE
		# Keep only functions
		lst <- lst[isFun]
		return(lst)
	}
}
"getKeywords" <-
function(pos = 2:length(search())){
	# Get a sorted list of unique function names for libraries loaded
	# in positions startpos to endpos
	res <- NULL
	for (i in pos) {
		if (search()[i] == "package:base")  # Use builtins() instead
			res <- c(res, builtins()) else
			res <- c(res, as.character(getFunctions(i)))
	}
	# Sort res and return only unique names
	res <- sort(res[!duplicated(res)])
	# Eliminate items containing <-, __, -, !, $, %, &, |, *, +, /, :, [ or =
	searchit <- c("<-", "__", "-", "!", "[$]", "[%]", "[&]", "[|]", "[*]", "[+]", "[/]", ":", "[[]", "=")
	for (i in 1:length(searchit)) {
		elim <- grep(searchit[i], res, useBytes = TRUE)
		if (length(elim) > 0) res <- res[-elim]
	}
	# Eliminate some other items (reserved keywords already introduced in keyword1 list, and other stuff)
	reserved <- c("break", "else", "FALSE", "for", "function", "if", "in", "Inf", "NA", "NaN", "next", "NULL", "repeat", "TRUE", "while", "(", "?", "@", "^", "{", "~", "<", ">")
	for (i in 1:length(reserved))
		res <- res[res != reserved[i]]
	res
}
"guiCallTip" <-
function(code, file = NULL, onlyargs = FALSE, maxwidth = 60, location = FALSE) {
    # This is an interface to CallTip for external programs
    # Clear ::SciViewsR_CallTip
    .Tcl("set ::SciViewsR_CallTip {}")

    # Using a callback, all args are strings => convert
    if (length(file) == 0 || file == "" || file == "NULL") file <- NULL
    only.args <- as.logical(onlyargs[1])
    max.width <- as.integer(maxwidth[1])
    
    # Get the call tip
	ctip <- CallTip(code, only.args = only.args, location = location)

    # Possibly break long lines at reasonables widths
    if (only.args) Exdent <- 0 else Exdent <- 4
    if (!is.null(max.width) && !max.width < 1)
	   ctip <- paste(strwrap(ctip, width = max.width, exdent = Exdent), collapse = "\n")

	# Copy the result to a Tcl variable
    .Tcl(paste("set ::SciViewsR_CallTip {", ctip, "}", sep = ""))

    if (!is.null(file)) { # Copy it also to the clipboard or a file
        # if file = clipboard and this is Windows, copy it to the clipboard
        if (file == "clipboard") {
            if (.Platform$OS.type == "windows") {
                writeClipboard(ctip)
            } else {
                stop("'clipboard' not supported yet on platforms different than Windows!")
            }
        } else { # copy the call tip to the file
            cat(ctip, file = file)
        }
    }
	invisible(ctip)
}

"guiComplete" <-
function(code, file = NULL, givetype = FALSE, fieldsep = "|") {
    # This is an interfacte to CallTip for external programs
    # Clear ::SciViewsR_Complete
    .Tcl("set ::SciViewsR_Complete {}")
    
    # Using a callback, all args are strings => convert
    if (length(file) == 0 || file == "" || file == "NULL") file <- NULL
    givetype <- as.logical(givetype[1])
    fieldsep = fieldsep[1]

    # Get the completion list
	clist <- Complete(code, givetype = givetype, fieldsep = fieldsep)

	# Copy the result to a Tcl variable
    .Tcl(paste("set ::SciViewsR_Complete {", clist, "}", sep = ""))

    if (!is.null(file)) { # Copy it also to the clipboard or a file
        # if file = clipboard and this is Windows, copy it to the clipboard
        if (file == "clipboard") {
            if (.Platform$OS.type == "windows") {
                writeClipboard(clist)
            } else {
                stop("'clipboard' not supported yet on platforms different than Windows!")
            }
        } else { # copy the completion list to the file
            cat(clist, file = file)
        }
    }
	invisible(clist)
}

"guiDDEInstall" <-
function() {
    # Register a dde server for R and install callbacks for serveur functions

    # Make sure tcl/tk dde is operational
    if (.Platform$OS.type != "windows") return("DDE not installed: this is not Windows!")
	if (!capabilities("tcltk")) return("DDE not installed: this version of R cannot use Tcl/Tk!")
    if (!require(tcltk)) return("DDE not installed: impossible to load tcltk package!")
	tclRequire("dde", warn = TRUE)	# Should be installed by default with the tcltk package under Windows

    # Register a "SciViewsR" server
    topic <- "SciViewsR"
    # Verify if I am not already registered under this topic
    if (!tclvalue(.Tcl("dde servername {}")) == topic) {
        # Check that this server name does not exist yet
        if (length(grep(paste("[{]TclEval ", topic, "[}]", sep = ""), tclvalue(.Tcl("dde services TclEval {}")), useBytes = TRUE)) > 0)
            invisible("DDE not installed: server name already in use (by another R instance?)!")
        # Register me as a dde server with this topic name
        .Tcl(paste("dde servername", topic))
        # Check that the server is set correctly (if not, return an error)
        if (!tclvalue(.Tcl("dde servername {}")) == topic)
            invisible("DDE not installed: an unknown error occurred while registering the server!")
    }

    # Install callbacks for guiXXXX functions, so that DDE clients can access them
    # guiCallTip()... Take care: this must be adapted if you change guiCallTip()!
    res <- .Tcl.callback(guiCallTip)
    .Tcl(paste("proc guiCallTip {code {file \"\"} {onlyargs FALSE} {maxwidth 60} {location FALSE} } {", gsub("%", "$", res), "}", sep = ""))
    
    # guiComplete()... Take care: this must be adapted if you change guiComplete()!
    res <- .Tcl.callback(guiComplete)
    .Tcl(paste("proc guiComplete {code {file \"\"} {givetype FALSE} {fieldsep |} } {", gsub("%", "$", res), "}", sep = ""))
    
    # Done
    invisible("") # OK!
}
