#  File src/library/utils/R/write.table.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2012 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

write.table <-
function (x, file = "", append = FALSE, quote = TRUE, sep = " ",
          eol = "\n", na = "NA", dec = ".", row.names = TRUE,
          col.names = TRUE, qmethod = c("escape", "double"),
          fileEncoding = "")
{
    qmethod <- match.arg(qmethod)
    if(is.logical(quote) && (length(quote) != 1L || is.na(quote)))
        stop("'quote' must be 'TRUE', 'FALSE' or numeric")
    ## quote column names unless quote == FALSE (see help).
    quoteC <- if(is.logical(quote)) quote else TRUE
    qset <- is.logical(quote) && quote

    if(!is.data.frame(x) && !is.matrix(x)) x <- data.frame(x)

    makeRownames <- isTRUE(row.names)
    ## need col names if col.names is TRUE or NA
    makeColnames <- is.logical(col.names) && !identical(FALSE, col.names)
    if(is.matrix(x)) {
        ## fix up dimnames as as.data.frame would
        p <- ncol(x)
        d <- dimnames(x)
        if(is.null(d)) d <- list(NULL, NULL)
        if(is.null(d[[1L]]) && makeRownames) d[[1L]] <- seq_len(nrow(x))
        if(is.null(d[[2L]]) && makeColnames && p > 0L)
            d[[2L]] <- paste0("V", 1L:p)
        if(qset)
            quote <- if(is.character(x)) seq_len(p) else numeric()
    } else { ## data.frame
        if(qset)
            quote <- if(length(x))
                which(unlist(lapply(x, function(x)
                                    is.character(x) || is.factor(x))))
            else numeric()
        ## fix up embedded matrix columns into separate cols:
        if(any(vapply(x,
                      function(z)
                          length(dim(z)) == 2 && dim(z)[2L] > 1,
                      NA))) {
            c1 <- names(x)
	    x <- as.matrix(x, rownames.force = makeRownames)
	    d <- dimnames(x)
	    if(qset) {
		ord <- match(c1, d[[2L]], 0L)
		quote <- ord[quote]; quote <- quote[quote > 0L]
	    }
        }
        else
            d <- list(if(makeRownames) row.names(x),
                      if(makeColnames) names(x))
        p <- ncol(x)
    }
    nocols <- p == 0L

    if(is.logical(quote)) # must be false
	quote <- NULL
    else if(is.numeric(quote)) {
	if(any(quote < 1L | quote > p))
	    stop("invalid numbers in 'quote'")
    } else
	stop("invalid 'quote' specification")

    rn <- FALSE
    rnames <- NULL
    if(is.logical(row.names)) {
	if(row.names) {rnames <- as.character(d[[1L]]); rn <- TRUE}
    } else {
	rnames <- as.character(row.names)
        rn <- TRUE
	if(length(rnames) != nrow(x))
            stop("invalid 'row.names' specification")
    }
    if(!is.null(quote) && rn) # quote the row names
	quote <- c(0, quote)

    if(is.logical(col.names)) {
        if(!rn && is.na(col.names))
            stop("'col.names = NA' makes no sense when 'row.names = FALSE'")
        col.names <- if(is.na(col.names) && rn) c("", d[[2L]])
        else if(col.names) d[[2L]] else NULL
    } else {
	col.names <- as.character(col.names)
	if(length(col.names) != p)
	    stop("invalid 'col.names' specification")
    }

    if(file == "") file <- stdout()
    else if(is.character(file)) {
        file <- if(nzchar(fileEncoding))
            file(file, ifelse(append, "a", "w"), encoding = fileEncoding)
            else file(file, ifelse(append, "a", "w"))
        on.exit(close(file))
    } else if(!isOpen(file, "w")) {
        open(file, "w")
        on.exit(close(file))
    }
    if(!inherits(file, "connection"))
        stop("'file' must be a character string or connection")

    qstring <-                          # quoted embedded quote string
        switch(qmethod,
               "escape" = '\\\\"',
               "double" = '""')
    if(!is.null(col.names)) {
	if(append)
	    warning("appending column names to file")
	if(quoteC)
	    col.names <- paste0("\"", gsub('"', qstring, col.names),
                                "\"")
        writeLines(paste(col.names, collapse = sep), file, sep = eol)
    }

    if (nrow(x) == 0L) return(invisible())
    if (nocols && !rn) return(cat(rep.int(eol, NROW(x)), file=file, sep=""))

    ## convert list matrices to character - maybe not much use?
    if(is.matrix(x) && !is.atomic(x)) mode(x) <- "character"
    if(is.data.frame(x)) {
        ## convert columns we can't handle in C code
        x[] <- lapply(x, function(z) {
            if(is.object(z) && !is.factor(z)) as.character(z) else z
        })
    }

    invisible(.External2(C_writetable, x, file, nrow(x), p, rnames, sep, eol,
                         na, dec, as.integer(quote), qmethod != "double"))
}

write.csv <- function(...)
{
    Call <- match.call(expand.dots = TRUE)
    for(argname in c("append", "col.names", "sep", "dec", "qmethod"))
        if(!is.null(Call[[argname]]))
            warning(gettextf("attempt to set '%s' ignored", argname),
                    domain = NA)
    rn <- eval.parent(Call$row.names)
    Call$append <- NULL
    Call$col.names <- if(is.logical(rn) && !rn) TRUE else NA
    Call$sep <- ","
    Call$dec <- "."
    Call$qmethod <- "double"
    Call[[1L]] <- as.name("write.table")
    eval.parent(Call)
}

write.csv2 <- function(...)
{
    Call <- match.call(expand.dots = TRUE)
    for(argname in c("append", "col.names", "sep", "dec", "qmethod"))
        if(!is.null(Call[[argname]]))
            warning(gettextf("attempt to set '%s' ignored", argname),
                    domain = NA)
    rn <- eval.parent(Call$row.names)
    Call$append <- NULL
    Call$col.names <- if(is.logical(rn) && !rn) TRUE else NA
    Call$sep <- ";"
    Call$dec <- ","
    Call$qmethod <- "double"
    Call[[1L]] <- as.name("write.table")
    eval.parent(Call)
}