R/writeNamespaceImports.R

Defines functions writeNamespaceImports

Documented in writeNamespaceImports

writeNamespaceImports <-
    function(package, file = "", append = TRUE, quote = FALSE,
             width = 0.9 * getOption("width"))
{
    writeImports <- function(x, prefix, file, width) {
        Rkeywords <-
          c("NULL", "NA", "TRUE", "FALSE", "Inf", "NaN", "NA_integer_",
            "NA_real_", "NA_character_", "NA_complex_", "function", "while",
            "repeat", "for", "if", "in", "else", "next", "break", "...")
        for (i in which(!(names(x) %in% ignoredPackages))) {
            if (quote) {
                qstring1 <- "\""
                qstring2 <- "\""
            } else {
                qstring1 <- ""
                qstring2 <- ifelse(x[[i]] %in% Rkeywords, "\"", "")
                qstring2[grep("(<-|\\[|%)", x[[i]])] <- "\""
            }
            txt <- paste0(prefix, "(", qstring1, names(x[i]), qstring1, ", ",
                          paste0(qstring2, x[[i]], qstring2, collapse = ", "),
                          ")")
            cat(strwrap(txt, width = width, exdent = nchar(prefix) + 1),
                file = file, sep = "\n")
            cat("\n", file = file)
        }
    }
    ignoredPackages <- c("base", "Autoloads")
    if (file == "")
        file <- stdout()
    else if (is.character(file)) {
        file <- 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")

    allDeps <- findExternalDeps(package)
    allDepNames <- sort(unique(ulapply(allDeps, names)))
    allDepNames <- allDepNames[!(allDepNames %in% ignoredPackages)]
    if (length(allDepNames) > 0) {
        hasNamespace <- vapply(allDepNames, function(x)
            !identical(FALSE, tryCatch(getNamespace(x), error = function(e) FALSE)), NA)
        dependsNames <- allDepNames[!hasNamespace]
        importsNames <- allDepNames[hasNamespace]
        ignoredPackages <- c(ignoredPackages, dependsNames)
        cat("#Generated by codetoolsBioC version ",
            packageDescription("codetoolsBioC")[["Version"]], "\n",
            file = file, sep = "")
        cat("#Timestamp: ", date(), "\n\n", file = file, sep = "")
        if (length(dependsNames) > 0) {
            txt <- paste0("Depends: ", paste(dependsNames, collapse = ", "))
            cat(strwrap(txt, width = width, exdent = 9, prefix = "#"),
                file = file, sep = "\n")
            cat("\n", file = file)
        }
        if (length(importsNames) > 0) {
            txt <- paste0("Imports: ", paste(importsNames, collapse = ", "))
            cat(strwrap(txt, width = width, exdent = 9, prefix = "#"),
                file = file, sep = "\n")
            cat("\n", file = file)
        }
        writeImports(allDeps[["S4Classes"]], "importClassesFrom", file, width)
        writeImports(allDeps[["S4Methods"]], "importMethodsFrom", file, width)
        writeImports(allDeps[["functions"]], "importFrom", file, width)
        writeImports(allDeps[["variables"]], "importFrom", file, width)
    }
}
Bioconductor/codetoolsBioC documentation built on April 25, 2023, 11:05 a.m.