Permalink
Cannot retrieve contributors at this time
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
1155 lines (1032 sloc)
43.1 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # File src/library/tools/R/admin.R | |
| # Part of the R package, https://www.R-project.org | |
| # | |
| # Copyright (C) 1995-2021 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/ | |
| ### * .install_package_description | |
| ## called from basepkg.mk and .install_packages | |
| .install_package_description <- | |
| function(dir, outDir, builtStamp=character()) | |
| { | |
| ## Function for taking the DESCRIPTION package meta-information, | |
| ## checking/validating it, and installing it with the 'Built:' | |
| ## field added. Note that from 1.7.0 on, packages without | |
| ## compiled code are not marked as being from any platform. | |
| ## Check first. Note that this also calls .read_description(), but | |
| ## .check_package_description() currently really needs to know the | |
| ## path to the DESCRIPTION file, and returns an object with check | |
| ## results and not the package metadata ... | |
| ok <- .check_package_description(file.path(dir, "DESCRIPTION")) | |
| if(any(as.integer(lengths(ok)) > 0L)) { | |
| stop(paste(gettext("Invalid DESCRIPTION file") , | |
| paste(format(ok), collapse = "\n\n"), | |
| sep = "\n\n"), | |
| domain = NA, | |
| call. = FALSE) | |
| } | |
| ## This reads (in C locale) byte-by-byte, declares latin1 or UTF-8 | |
| ## Maybe it would be better to re-encode others (there are none at | |
| ## present, at least in a UTF-8 locale? | |
| db <- .read_description(file.path(dir, "DESCRIPTION")) | |
| ## should not have a Built: field, so ignore it if it is there | |
| nm <- names(db) | |
| if("Built" %in% nm) { | |
| db <- db[-match("Built", nm)] | |
| warning(gettextf("*** someone has corrupted the Built field in package '%s' ***", | |
| db["Package"]), | |
| domain = NA, | |
| call. = FALSE) | |
| } | |
| OStype <- R.version$platform | |
| if (grepl("-apple-darwin", OStype) && nzchar(Sys.getenv("R_ARCH"))) | |
| OStype <- sub(".*-apple-darwin", "universal-apple-darwin", OStype) | |
| ## Some build systems want to supply a package-build timestamp for | |
| ## reproducibility | |
| if (length(builtStamp) == 0L) { | |
| ## Prefer date in ISO 8601 format, UTC, avoid sub-seconds. | |
| builtStamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S", | |
| tz = "UTC", usetz = TRUE) | |
| } | |
| Built <- | |
| paste0("R ", | |
| paste(R.version[c("major", "minor")], collapse = "."), | |
| "; ", | |
| if(dir.exists(file.path(dir, "src"))) OStype else "", | |
| "; ", | |
| builtStamp, | |
| "; ", | |
| .OStype()) | |
| ## At some point of time, we had: | |
| ## We must not split the Built: field across lines. | |
| ## Not sure if this is still true. If not, the following could be | |
| ## simplified to | |
| ## db["Built"] <- Built | |
| ## write.dcf(rbind(db), file.path(outDir, "DESCRIPTION")) | |
| ## But in any case, it is true for fields obtained from expanding R | |
| ## fields (Authors@R): these should not be reformatted. | |
| db <- c(db, | |
| .expand_package_description_db_R_fields(db), | |
| Built = Built) | |
| ## <FIXME> | |
| ## This should no longer be necessary? | |
| ## <COMMENT> | |
| ## ## This cannot be done in a MBCS: write.dcf fails | |
| ## ctype <- Sys.getlocale("LC_CTYPE") | |
| ## Sys.setlocale("LC_CTYPE", "C") | |
| ## on.exit(Sys.setlocale("LC_CTYPE", ctype)) | |
| ## </COMMENT> | |
| ## </FIXME> | |
| .write_description(db, file.path(outDir, "DESCRIPTION")) | |
| outMetaDir <- file.path(outDir, "Meta") | |
| if(!dir.exists(outMetaDir) && !dir.create(outMetaDir)) | |
| stop(gettextf("cannot open directory '%s'", | |
| outMetaDir), | |
| domain = NA) | |
| saveInfo <- .split_description(db) | |
| saveRDS(saveInfo, file.path(outMetaDir, "package.rds")) | |
| features <- list(internalsID = .Internal(internalsID())) | |
| saveRDS(features, file.path(outMetaDir, "features.rds")) | |
| invisible() | |
| } | |
| ### * .split_description | |
| ## also used in .getRequiredPackages | |
| .split_description <- | |
| function(db, verbose = FALSE) | |
| { | |
| if(!is.na(Built <- db["Built"])) { | |
| Built <- as.list(strsplit(Built, "; ")[[1L]]) | |
| if(length(Built) != 4L) { | |
| warning(gettextf("*** someone has corrupted the Built field in package '%s' ***", | |
| db["Package"]), | |
| domain = NA, | |
| call. = FALSE) | |
| Built <- NULL | |
| } else { | |
| names(Built) <- c("R", "Platform", "Date", "OStype") | |
| Built[["R"]] <- R_system_version(sub("^R ([0-9.]+)", "\\1", | |
| Built[["R"]])) | |
| } | |
| } else Built <- NULL | |
| ## might perhaps have multiple entries | |
| Depends <- .split_dependencies(db[names(db) %in% "Depends"]) | |
| ## several packages 'Depends' on base! | |
| ind <- match("base", names(Depends), 0L) | |
| if(ind) Depends <- Depends[-ind] | |
| ## We only need Rdepends for R < 2.7.0, but we still need to be | |
| ## able to check that someone is not trying to load this into a | |
| ## very old version of R. | |
| if("R" %in% names(Depends)) { | |
| Rdeps2 <- Depends["R" == names(Depends)] | |
| names(Rdeps2) <- NULL | |
| Rdeps <- Depends[["R", exact = TRUE]] # the first one | |
| Depends <- Depends[names(Depends) != "R"] | |
| ## several packages have 'Depends: R', which is a noop. | |
| if(verbose && length(Rdeps) == 1L) | |
| message("WARNING: omitting pointless dependence on 'R' without a version requirement") | |
| if(length(Rdeps) <= 1L) | |
| Rdeps2 <- Rdeps <- NULL | |
| } else Rdeps2 <- Rdeps <- NULL | |
| Rdeps <- as.vector(Rdeps) | |
| Suggests <- .split_dependencies(db[names(db) %in% "Suggests"]) | |
| Imports <- .split_dependencies(db[names(db) %in% "Imports"]) | |
| LinkingTo <- .split_dependencies(db[names(db) %in% "LinkingTo"]) | |
| structure(list(DESCRIPTION = db, Built = Built, | |
| Rdepends = Rdeps, Rdepends2 = Rdeps2, | |
| Depends = Depends, Suggests = Suggests, | |
| Imports = Imports, LinkingTo = LinkingTo), | |
| class = "packageDescription2") | |
| } | |
| ### * .vinstall_package_descriptions_as_RDS | |
| ## called from src/library/Makefile | |
| .vinstall_package_descriptions_as_RDS <- | |
| function(dir, packages) | |
| { | |
| ## For the given packages installed in @file{dir}, install their | |
| ## DESCRIPTION package metadata as R metadata. | |
| ## Really only useful for base packages under Unix. | |
| ## See @file{src/library/Makefile.in}. | |
| for(p in unlist(strsplit(packages, "[[:space:]]+"))) { | |
| meta_dir <- file.path(dir, p, "Meta") | |
| if(!dir.exists(meta_dir) && !dir.create(meta_dir)) | |
| stop(gettextf("cannot open directory '%s'", meta_dir)) | |
| package_info_dcf_file <- file.path(dir, p, "DESCRIPTION") | |
| package_info_rds_file <- file.path(meta_dir, "package.rds") | |
| if(file_test("-nt", | |
| package_info_rds_file, | |
| package_info_dcf_file)) | |
| next | |
| saveRDS(.split_description(.read_description(package_info_dcf_file)), | |
| package_info_rds_file) | |
| } | |
| invisible() | |
| } | |
| ### * .update_package_rds | |
| ## not used | |
| .update_package_rds <- | |
| function(lib.loc = NULL) | |
| { | |
| ## rebuild the dumped package descriptions for all packages in lib.loc | |
| if (is.null(lib.loc)) lib.loc <- .libPaths() | |
| lib.loc <- lib.loc[file.exists(lib.loc)] | |
| for (lib in lib.loc) { | |
| a <- list.files(lib, all.files = FALSE, full.names = TRUE) | |
| for (nam in a) { | |
| dfile <- file.path(nam, "DESCRIPTION") | |
| if (file.exists(dfile)) { | |
| print(nam) | |
| .install_package_description(nam, nam) | |
| } | |
| } | |
| } | |
| } | |
| ### * .install_package_code_files | |
| .install_package_code_files <- | |
| function(dir, outDir) | |
| { | |
| if(!dir.exists(dir)) | |
| stop(gettextf("directory '%s' does not exist", dir), | |
| domain = NA) | |
| dir <- file_path_as_absolute(dir) | |
| ## Attempt to set the LC_COLLATE locale to 'C' to turn off locale | |
| ## specific sorting. | |
| curLocale <- Sys.getlocale("LC_COLLATE") | |
| on.exit(Sys.setlocale("LC_COLLATE", curLocale), add = TRUE) | |
| ## (Guaranteed to work as per the Sys.setlocale() docs.) | |
| lccollate <- "C" | |
| if(Sys.setlocale("LC_COLLATE", lccollate) != lccollate) { | |
| ## <NOTE> | |
| ## I don't think we can give an error here. | |
| ## It may be the case that Sys.setlocale() fails because the "OS | |
| ## reports request cannot be honored" (src/main/platform.c), in | |
| ## which case we should still proceed ... | |
| warning("cannot turn off locale-specific sorting via LC_COLLATE") | |
| ## </NOTE> | |
| } | |
| ## We definitely need a valid DESCRIPTION file. | |
| db <- .read_description(file.path(dir, "DESCRIPTION")) | |
| codeDir <- file.path(dir, "R") | |
| if(!dir.exists(codeDir)) return(invisible()) | |
| codeFiles <- list_files_with_type(codeDir, "code", full.names = FALSE) | |
| collationField <- | |
| c(paste0("Collate.", .OStype()), "Collate") | |
| if(any(i <- collationField %in% names(db))) { | |
| collationField <- collationField[i][1L] | |
| codeFilesInCspec <- .read_collate_field(db[collationField]) | |
| ## Duplicated entries in the collation spec? | |
| badFiles <- | |
| unique(codeFilesInCspec[duplicated(codeFilesInCspec)]) | |
| if(length(badFiles)) { | |
| out <- gettextf("\nduplicated files in '%s' field:", | |
| collationField) | |
| out <- paste(out, | |
| paste0(" ", badFiles, collapse = "\n"), | |
| sep = "\n") | |
| stop(out, domain = NA) | |
| } | |
| ## See which files are listed in the collation spec but don't | |
| ## exist. | |
| badFiles <- setdiff(codeFilesInCspec, codeFiles) | |
| if(length(badFiles)) { | |
| out <- gettextf("\nfiles in '%s' field missing from '%s':", | |
| collationField, | |
| codeDir) | |
| out <- paste(out, | |
| paste0(" ", badFiles, collapse = "\n"), | |
| sep = "\n") | |
| stop(out, domain = NA) | |
| } | |
| ## See which files exist but are missing from the collation | |
| ## spec. Note that we do not want the collation spec to use | |
| ## only a subset of the available code files. | |
| badFiles <- setdiff(codeFiles, codeFilesInCspec) | |
| if(length(badFiles)) { | |
| out <- gettextf("\nfiles in '%s' missing from '%s' field:", | |
| codeDir, | |
| collationField) | |
| out <- paste(out, | |
| paste0(" ", badFiles, collapse = "\n"), | |
| sep = "\n") | |
| stop(out, domain = NA) | |
| } | |
| ## Everything's groovy ... | |
| codeFiles <- codeFilesInCspec | |
| } | |
| codeFiles <- file.path(codeDir, codeFiles) | |
| if(!dir.exists(outDir) && !dir.create(outDir)) | |
| stop(gettextf("cannot open directory '%s'", outDir), | |
| domain = NA) | |
| outCodeDir <- file.path(outDir, "R") | |
| if(!dir.exists(outCodeDir) && !dir.create(outCodeDir)) | |
| stop(gettextf("cannot open directory '%s'", outCodeDir), | |
| domain = NA) | |
| outFile <- file.path(outCodeDir, db["Package"]) | |
| if(!file.create(outFile)) | |
| stop(gettextf("unable to create '%s'", outFile), domain = NA) | |
| writeLines(paste0(".packageName <- \"", db["Package"], "\""), | |
| outFile) | |
| enc <- as.vector(db["Encoding"]) | |
| need_enc <- !is.na(enc) # Encoding was specified | |
| ## assume that if locale is 'C' we can used 8-bit encodings unchanged. | |
| if(need_enc && (Sys.getlocale("LC_CTYPE") %notin% c("C", "POSIX"))) { | |
| con <- file(outFile, "a") | |
| on.exit(close(con)) # Windows does not like files left open | |
| for(f in codeFiles) { | |
| lines <- readLines(f, warn = FALSE) | |
| tmp <- iconv(lines, from = enc, to = "") | |
| bad <- which(is.na(tmp)) | |
| if(length(bad)) | |
| tmp <- iconv(lines, from = enc, to = "", sub = "byte") | |
| ## do not report purely comment lines, | |
| ## nor trailing comments not after quotes | |
| comm <- grep("^[^#'\"]*#", lines[bad], | |
| invert = TRUE, useBytes = TRUE) | |
| bad2 <- bad[comm] | |
| if(length(bad2)) { | |
| warning(sprintf(ngettext(length(bad2), | |
| "unable to re-encode %s line %s", | |
| "unable to re-encode %s lines %s"), | |
| sQuote(basename(f)), | |
| paste(bad2, collapse = ", ")), | |
| domain = NA, call. = FALSE) | |
| } | |
| writeLines(paste0("#line 1 \"", f, "\""), con) | |
| writeLines(tmp, con) | |
| } | |
| close(con); on.exit() | |
| } else { | |
| ## <NOTE> | |
| ## It may be safer to do | |
| ## writeLines(sapply(codeFiles, readLines), outFile) | |
| ## instead, but this would be much slower ... | |
| ## use fast version of file.append that ensures LF between files | |
| if(!all(.file_append_ensuring_LFs(outFile, codeFiles))) | |
| stop("unable to write code files") | |
| ## </NOTE> | |
| } | |
| ## A syntax check here, so that we do not install a broken package. | |
| ## FIXME: this is only needed if we don't lazy load, as the lazy loader | |
| ## would detect the error. | |
| op <- options(showErrorCalls=FALSE) | |
| on.exit(options(op)) | |
| parse(outFile) | |
| invisible() | |
| } | |
| ### * .install_package_indices | |
| ## called from R CMD INSTALL | |
| .install_package_indices <- | |
| function(dir, outDir) | |
| { | |
| options(warn = 1) # to ensure warnings get seen | |
| if(!dir.exists(dir)) | |
| stop(gettextf("directory '%s' does not exist", dir), | |
| domain = NA) | |
| if(!dir.exists(outDir)) | |
| stop(gettextf("directory '%s' does not exist", outDir), | |
| domain = NA) | |
| ## If there is an @file{INDEX} file in the package sources, we | |
| ## install this, and do not build it. | |
| if(file_test("-f", file.path(dir, "INDEX"))) | |
| if(!file.copy(file.path(dir, "INDEX"), | |
| file.path(outDir, "INDEX"), | |
| overwrite = TRUE)) | |
| stop(gettextf("unable to copy INDEX to '%s'", | |
| file.path(outDir, "INDEX")), | |
| domain = NA) | |
| outMetaDir <- file.path(outDir, "Meta") | |
| if(!dir.exists(outMetaDir) && !dir.create(outMetaDir)) | |
| stop(gettextf("cannot open directory '%s'", outMetaDir), | |
| domain = NA) | |
| .install_package_Rd_indices(dir, outDir) | |
| .install_package_demo_index(dir, outDir) | |
| invisible() | |
| } | |
| ### * .install_package_Rd_indices | |
| .install_package_Rd_indices <- | |
| function(dir, outDir) | |
| { | |
| dir <- file_path_as_absolute(dir) | |
| docsDir <- file.path(dir, "man") | |
| dataDir <- file.path(outDir, "data") | |
| outDir <- file_path_as_absolute(outDir) | |
| ## <FIXME> | |
| ## Not clear whether we should use the basename of the directory we | |
| ## install to, or the package name as obtained from the DESCRIPTION | |
| ## file in the directory we install from (different for versioned | |
| ## installs). We definitely do not want the basename of the dir we | |
| ## install from. | |
| packageName <- basename(outDir) | |
| ## </FIXME> | |
| allRd <- if(dir.exists(docsDir)) | |
| list_files_with_type(docsDir, "docs") else character() | |
| ## some people have man dirs without any valid .Rd files | |
| if(length(allRd)) { | |
| ## we want the date of the newest .Rd file we will install | |
| newestRd <- max(file.mtime(allRd)) | |
| ## these files need not exist, which gives NA. | |
| indices <- c(file.path("Meta", "Rd.rds"), | |
| file.path("Meta", "hsearch.rds"), | |
| file.path("Meta", "links.rds"), | |
| "INDEX") | |
| upToDate <- file.mtime(file.path(outDir, indices)) >= newestRd | |
| if(dir.exists(dataDir) | |
| && length(dataFiles <- list.files(dataDir))) { | |
| ## Note that the data index is computed from both the package's | |
| ## Rd files and the data sets actually available. | |
| newestData <- max(file.mtime(dataFiles)) | |
| upToDate <- c(upToDate, | |
| file.mtime(file.path(outDir, "Meta", "data.rds")) >= | |
| max(newestRd, newestData)) | |
| } | |
| ## Note that this is not quite good enough: an Rd file or data file | |
| ## might have been removed since the indices were made. | |
| RdsFile <- file.path("Meta", "Rd.rds") | |
| if(file.exists(RdsFile)) { ## for Rd files | |
| ## this has file names without path | |
| files <- readRDS(RdsFile)$File | |
| if(!identical(basename(allRd), files)) upToDate <- FALSE | |
| } | |
| ## we want to proceed if any is NA. | |
| if(all(upToDate %in% TRUE)) return(invisible()) | |
| ## Rd objects should already have been installed. | |
| db <- tryCatch(Rd_db(basename(outDir), lib.loc = dirname(outDir)), | |
| error = function(e) NULL) | |
| ## If not, we build the Rd db from the sources: | |
| if(is.null(db)) db <- .build_Rd_db(dir, allRd) | |
| contents <- Rd_contents(db) | |
| .write_Rd_contents_as_RDS(contents, | |
| file.path(outDir, "Meta", "Rd.rds")) | |
| defaultEncoding <- as.vector(readRDS(file.path(outDir, "Meta", "package.rds"))$DESCRIPTION["Encoding"]) | |
| if(is.na(defaultEncoding)) defaultEncoding <- NULL | |
| saveRDS(.build_hsearch_index(contents, packageName, defaultEncoding), | |
| file.path(outDir, "Meta", "hsearch.rds")) | |
| saveRDS(.build_links_index(contents, packageName), | |
| file.path(outDir, "Meta", "links.rds")) | |
| ## If there is no @file{INDEX} file in the package sources, we | |
| ## build one. | |
| ## <NOTE> | |
| ## We currently do not also save this in RDS format, as we can | |
| ## always do | |
| ## .build_Rd_index(readRDS(file.path(outDir, "Meta", "Rd.rds")) | |
| if(!file_test("-f", file.path(dir, "INDEX"))) | |
| writeLines(formatDL(.build_Rd_index(contents)), | |
| file.path(outDir, "INDEX")) | |
| ## </NOTE> | |
| } else { | |
| contents <- NULL | |
| saveRDS(.build_hsearch_index(contents, packageName, defaultEncoding), | |
| file.path(outDir, "Meta", "hsearch.rds")) | |
| saveRDS(.build_links_index(contents, packageName), | |
| file.path(outDir, "Meta", "links.rds")) | |
| } | |
| if(dir.exists(dataDir)) | |
| saveRDS(.build_data_index(outDir, contents), | |
| file.path(outDir, "Meta", "data.rds")) | |
| invisible() | |
| } | |
| ### * .install_package_vignettes2 | |
| ## called from R CMD INSTALL for pre 3.0.2-built tarballs | |
| ## and for installation from package sources (missing build/vignette.rds), | |
| ## including for the temporary package installation during R CMD build, | |
| ## and when building base packages (where we need to tangle vignettes) | |
| .install_package_vignettes2 <- | |
| function(dir, outDir, encoding = "", tangle = FALSE) | |
| { | |
| dir <- file_path_as_absolute(dir) | |
| subdirs <- c("vignettes", file.path("inst", "doc")) | |
| ok <- dir.exists(file.path(dir, subdirs)) | |
| ## Create a vignette index only if the vignette dir exists. | |
| if (!any(ok)) | |
| return(invisible()) | |
| subdir <- subdirs[ok][1L] | |
| vignetteDir <- file.path(dir, subdir) | |
| outDir <- file_path_as_absolute(outDir) | |
| packageName <- basename(outDir) | |
| outVignetteDir <- file.path(outDir, "doc") | |
| ## --no-inst installs do not have a outVignetteDir. | |
| if(!dir.exists(outVignetteDir)) return(invisible()) | |
| ## If there is an HTML index in the @file{inst/doc} subdirectory of | |
| ## the package source directory (@code{dir}), we do not overwrite it | |
| ## (similar to top-level @file{INDEX} files). Installation already | |
| ## copied this over. | |
| hasHtmlIndex <- file_test("-f", file.path(vignetteDir, "index.html")) | |
| htmlIndex <- file.path(outDir, "doc", "index.html") | |
| vigns <- pkgVignettes(dir = dir, subdirs = subdir, check = TRUE) | |
| ## Write dummy HTML index if no vignettes are found and exit. | |
| if(length(vigns$docs) == 0L) { | |
| ## we don't want to write an index if the directory is in fact empty | |
| files <- list.files(vignetteDir, all.files = TRUE, no.. = TRUE) | |
| if((length(files) > 0L) && !hasHtmlIndex) | |
| .writeVignetteHtmlIndex(packageName, htmlIndex) | |
| return(invisible()) | |
| } | |
| if (subdir == "vignettes") { | |
| ## copy vignette sources over. | |
| file.copy(vigns$docs, outVignetteDir) | |
| } | |
| vigns <- tryCatch({ | |
| pkgVignettes(dir=outDir, subdirs="doc", output=TRUE, source=TRUE) | |
| }, error = function(ex) { | |
| pkgVignettes(dir=outDir, subdirs="doc") | |
| }) | |
| vignetteIndex <- .build_vignette_index(vigns) | |
| if(tangle && NROW(vignetteIndex) > 0L) { | |
| cwd <- getwd() | |
| if (is.null(cwd)) | |
| stop("current working directory cannot be ascertained") | |
| setwd(outVignetteDir) | |
| loadVignetteBuilder(dir, mustwork = FALSE) | |
| ## install tangled versions of Sweave vignettes. | |
| for(i in seq_along(vigns$docs)) { | |
| file <- vigns$docs[i] | |
| if (!is.null(vigns$sources) && !is.null(vigns$sources[file][[1]])) | |
| next | |
| file <- basename(file) | |
| enc <- vigns$encodings[i] | |
| cat(" ", sQuote(basename(file)), | |
| if(nzchar(enc)) paste("using", sQuote(enc)), "\n") | |
| engine <- try(vignetteEngine(vigns$engines[i]), silent = TRUE) | |
| ## tangling in outVignetteDir would fail if the vignette relied | |
| ## on SweaveInput/child documents (not copied over), | |
| ## but base packages currently don't do that | |
| if (!inherits(engine, "try-error")) | |
| engine$tangle(file, quiet = TRUE, encoding = enc) | |
| setwd(outVignetteDir) # just in case some strange tangle function changed it | |
| } | |
| setwd(cwd) | |
| # Update - now from the output directory | |
| vigns <- pkgVignettes(dir=outDir, subdirs="doc", source=TRUE) | |
| ## remove any files with no R code (they will have header comments). | |
| ## if not correctly declared they might not be in the current encoding | |
| sources <- unlist(vigns$sources) | |
| for(i in seq_along(sources)) { | |
| file <- sources[i] | |
| if (!file_test("-f", file)) next | |
| bfr <- readLines(file, warn = FALSE) | |
| if(all(grepl("(^###|^[[:space:]]*$)", bfr, useBytes = TRUE))) | |
| unlink(file) | |
| } | |
| # Update | |
| vigns <- pkgVignettes(dir=outDir, subdirs="doc", source=TRUE) | |
| # Add tangle source files (*.R) to the vignette index | |
| # Only the "main" R file, because tangle may also split | |
| # output into multiple files | |
| sources <- character(length(vigns$docs)) | |
| for (i in seq_along(vigns$docs)) { | |
| name <- vigns$names[i] | |
| source <- find_vignette_product(name, by = "tangle", main = TRUE, dir = vigns$dir, engine = engine) | |
| if (length(source) > 0L) | |
| sources[i] <- basename(source) | |
| } | |
| vignetteIndex$R <- sources | |
| } | |
| if(!hasHtmlIndex) | |
| .writeVignetteHtmlIndex(packageName, htmlIndex, vignetteIndex) | |
| saveRDS(vignetteIndex, | |
| file = file.path(outDir, "Meta", "vignette.rds")) | |
| invisible() | |
| } | |
| ### * .install_package_vignettes3 | |
| ## called from R CMD INSTALL for 3.0.2 or later tarballs | |
| .install_package_vignettes3 <- | |
| function(dir, outDir, encoding = "") | |
| { | |
| packageName <- basename(outDir) | |
| dir <- file_path_as_absolute(dir) | |
| indexname <- file.path(dir, "build", "vignette.rds") | |
| ok <- file_test("-f", indexname) | |
| ## Create a vignette index only if the vignette dir exists. | |
| if (!ok) | |
| return(invisible()) | |
| ## Copy the index to Meta | |
| file.copy(indexname, file.path(outDir, "Meta")) | |
| ## If there is an HTML index in the @file{inst/doc} subdirectory of | |
| ## the package source directory (@code{dir}), we do not overwrite it | |
| ## (similar to top-level @file{INDEX} files). Installation already | |
| ## copied this over. | |
| vignetteDir <- file.path(outDir, "doc") | |
| hasHtmlIndex <- file_test("-f", file.path(vignetteDir, "index.html")) | |
| htmlIndex <- file.path(outDir, "doc", "index.html") | |
| vignetteIndex <- readRDS(indexname) | |
| if(!hasHtmlIndex) | |
| .writeVignetteHtmlIndex(packageName, htmlIndex, vignetteIndex) | |
| invisible() | |
| } | |
| ### * .install_package_demo_index | |
| .install_package_demo_index <- | |
| function(dir, outDir) | |
| { | |
| demoDir <- file.path(dir, "demo") | |
| if(!dir.exists(demoDir)) return(invisible()) | |
| demoIndex <- .build_demo_index(demoDir) | |
| saveRDS(demoIndex, | |
| file = file.path(outDir, "Meta", "demo.rds")) | |
| invisible() | |
| } | |
| ### * .vinstall_package_indices | |
| ## called from src/library/Makefile | |
| .vinstall_package_indices <- | |
| function(src_dir, out_dir, packages) | |
| { | |
| ## For the given packages with sources rooted at @file{src_dir} and | |
| ## installations rooted at @file{out_dir}, install the package | |
| ## indices. | |
| ## Really only useful for base packages under Unix. | |
| ## See @file{src/library/Makefile.in}. | |
| for(p in unlist(strsplit(packages, "[[:space:]]+"))) | |
| .install_package_indices(file.path(src_dir, p), file.path(out_dir, p)) | |
| utils::make.packages.html(.Library, verbose = FALSE) | |
| invisible() | |
| } | |
| ### * .install_package_vignettes | |
| ## called from src/library/Makefile[.win] | |
| ## this is only used when building R | |
| .install_package_vignettes <- | |
| function(dir, outDir, keep.source = TRUE) | |
| { | |
| dir <- file_path_as_absolute(dir) | |
| vigns <- pkgVignettes(dir = dir) | |
| if(is.null(vigns) || !length(vigns$docs)) return(invisible()) | |
| outDir <- file_path_as_absolute(outDir) | |
| outVignetteDir <- file.path(outDir, "doc") | |
| if(!dir.exists(outVignetteDir) && !dir.create(outVignetteDir)) | |
| stop(gettextf("cannot open directory '%s'", outVignetteDir), | |
| domain = NA) | |
| ## We have to be careful to avoid repeated rebuilding. | |
| vignettePDFs <- | |
| file.path(outVignetteDir, | |
| sub("$", ".pdf", | |
| basename(file_path_sans_ext(vigns$docs)))) | |
| upToDate <- file_test("-nt", vignettePDFs, vigns$docs) | |
| ## The primary use of this function is to build and install PDF | |
| ## vignettes in base packages. | |
| ## Hence, we build in a subdir of the current directory rather | |
| ## than a temp dir: this allows inspection of problems and | |
| ## automatic cleanup via Make. | |
| cwd <- getwd() | |
| if (is.null(cwd)) | |
| stop("current working directory cannot be ascertained") | |
| buildDir <- file.path(cwd, ".vignettes") | |
| if(!dir.exists(buildDir) && !dir.create(buildDir)) | |
| stop(gettextf("cannot create directory '%s'", buildDir), domain = NA) | |
| on.exit(setwd(cwd)) | |
| setwd(buildDir) | |
| loadVignetteBuilder(vigns$pkgdir) | |
| for(i in seq_along(vigns$docs)[!upToDate]) { | |
| file <- vigns$docs[i] | |
| name <- vigns$names[i] | |
| engine <- vignetteEngine(vigns$engines[i]) | |
| message(gettextf("processing %s", sQuote(basename(file))), | |
| domain = NA) | |
| ## Note that contrary to all other weave/tangle calls, here | |
| ## 'file' is not a file in the current directory [hence no | |
| ## file <- basename(file) above]. However, weave should/must | |
| ## always create a file ('output') in the current directory. | |
| output <- tryCatch({ | |
| engine$weave(file, pdf = TRUE, eps = FALSE, quiet = TRUE, | |
| keep.source = keep.source, stylepath = FALSE) | |
| setwd(buildDir) | |
| find_vignette_product(name, by = "weave", engine = engine) | |
| }, error = function(e) { | |
| stop(gettextf("running %s on vignette '%s' failed with message:\n%s", | |
| engine[["name"]], file, conditionMessage(e)), | |
| domain = NA, call. = FALSE) | |
| }) | |
| ## In case of an error, do not clean up: should we point to | |
| ## buildDir for possible inspection of results/problems? | |
| ## We need to ensure that vignetteDir is in TEXINPUTS and BIBINPUTS. | |
| if (vignette_is_tex(output)) { | |
| ## <FIXME> | |
| ## What if this fails? | |
| ## Now gives a more informative error texi2pdf fails | |
| ## or if it does not produce a <name>.pdf. | |
| tryCatch({ | |
| texi2pdf(file = output, quiet = TRUE, texinputs = vigns$dir) | |
| output <- find_vignette_product(name, by = "texi2pdf", engine = engine) | |
| }, error = function(e) { | |
| stop(gettextf("compiling TeX file %s failed with message:\n%s", | |
| sQuote(output), conditionMessage(e)), | |
| domain = NA, call. = FALSE) | |
| }) | |
| ## </FIXME> | |
| } | |
| if(!file.copy(output, outVignetteDir, overwrite = TRUE)) | |
| stop(gettextf("cannot copy '%s' to '%s'", | |
| output, | |
| outVignetteDir), | |
| domain = NA) | |
| } | |
| ## Need to change out of this dir before we delete it, | |
| ## at least on Windows. | |
| setwd(cwd) | |
| unlink(buildDir, recursive = TRUE) | |
| ## Now you need to update the HTML index! | |
| ## This also creates the .R files | |
| .install_package_vignettes2(dir, outDir, tangle = TRUE) | |
| invisible() | |
| } | |
| ### * .install_package_namespace_info | |
| .install_package_namespace_info <- | |
| function(dir, outDir) | |
| { | |
| dir <- file_path_as_absolute(dir) | |
| nsFile <- file.path(dir, "NAMESPACE") | |
| if(!file_test("-f", nsFile)) return(invisible()) | |
| nsInfoFilePath <- file.path(outDir, "Meta", "nsInfo.rds") | |
| if(file_test("-nt", nsInfoFilePath, nsFile)) return(invisible()) | |
| nsInfo <- parseNamespaceFile(basename(dir), dirname(dir)) | |
| outMetaDir <- file.path(outDir, "Meta") | |
| if(!dir.exists(outMetaDir) && !dir.create(outMetaDir)) | |
| stop(gettextf("cannot open directory '%s'", outMetaDir), | |
| domain = NA) | |
| saveRDS(nsInfo, nsInfoFilePath) | |
| invisible() | |
| } | |
| ### * .vinstall_package_namespaces_as_RDS | |
| ## called from src/library/Makefile | |
| .vinstall_package_namespaces_as_RDS <- | |
| function(dir, packages) | |
| { | |
| ## For the given packages installed in @file{dir} which have a | |
| ## NAMESPACE file, install the namespace info as R metadata. | |
| ## Really only useful for base packages under Unix. | |
| ## See @file{src/library/Makefile.in}. | |
| for(p in unlist(strsplit(packages, "[[:space:]]+"))) | |
| .install_package_namespace_info(file.path(dir, p), | |
| file.path(dir, p)) | |
| invisible() | |
| } | |
| ### * .install_package_Rd_objects | |
| ## called from src/library/Makefile | |
| .install_package_Rd_objects <- | |
| function(dir, outDir, encoding = "unknown") | |
| { | |
| dir <- file_path_as_absolute(dir) | |
| mandir <- file.path(dir, "man") | |
| manfiles <- if(!dir.exists(mandir)) character() | |
| else list_files_with_type(mandir, "docs") | |
| manOutDir <- file.path(outDir, "help") | |
| dir.create(manOutDir, FALSE) | |
| db_file <- file.path(manOutDir, | |
| paste0(basename(outDir), ".rdx")) | |
| built_file <- file.path(dir, "build", "partial.rdb") | |
| macro_files <- list.files(file.path(dir, "man", "macros"), pattern = "\\.Rd$", full.names = TRUE) | |
| if (length(macro_files)) { | |
| macroDir <- file.path(manOutDir, "macros") | |
| dir.create(macroDir, FALSE) | |
| file.copy(macro_files, macroDir, overwrite = TRUE) | |
| } | |
| ## Avoid (costly) rebuilding if not needed. | |
| ## Actually, it seems no more costly than these tests, which it also does | |
| pathsFile <- file.path(manOutDir, "paths.rds") | |
| if(!file_test("-f", db_file) || !file.exists(pathsFile) || | |
| !identical(sort(manfiles), sort(readRDS(pathsFile))) || | |
| !all(file_test("-nt", db_file, manfiles))) { | |
| db <- .build_Rd_db(dir, manfiles, db_file = db_file, | |
| encoding = encoding, built_file = built_file) | |
| nm <- as.character(names(db)) # Might be NULL | |
| saveRDS(structure(nm, | |
| first = nchar(file.path(mandir)) + 2L), | |
| pathsFile) | |
| names(db) <- sub("\\.[Rr]d$", "", basename(nm)) | |
| makeLazyLoadDB(db, file.path(manOutDir, basename(outDir))) | |
| } | |
| invisible() | |
| } | |
| ### * .install_package_demos | |
| ## called from basepkg.mk and .install_packages | |
| .install_package_demos <- | |
| function(dir, outDir) | |
| { | |
| ## NB: we no longer install 00Index | |
| demodir <- file.path(dir, "demo") | |
| if(!dir.exists(demodir)) return() | |
| demofiles <- list_files_with_type(demodir, "demo", full.names = FALSE) | |
| if(!length(demofiles)) return() | |
| demoOutDir <- file.path(outDir, "demo") | |
| if(!dir.exists(demoOutDir)) dir.create(demoOutDir) | |
| file.copy(file.path(demodir, demofiles), demoOutDir, | |
| overwrite = TRUE) | |
| } | |
| ### * .find_cinclude_paths | |
| .find_cinclude_paths <- | |
| function(pkgs, lib.loc = NULL, file = NULL) | |
| { | |
| ## given a character string of comma-separated package names, | |
| ## find where the packages are installed and generate | |
| ## -I"/path/to/package/include" ... | |
| if(!is.null(file)) { | |
| tmp <- read.dcf(file, "LinkingTo")[1L, 1L] | |
| if(is.na(tmp)) return(invisible()) | |
| pkgs <- tmp | |
| } | |
| pkgs <- strsplit(pkgs[1L], ",[[:blank:]]*")[[1L]] | |
| paths <- find.package(pkgs, lib.loc, quiet=TRUE) | |
| if(length(paths)) | |
| cat(paste(paste0('-I"', paths, '/include"'), collapse=" ")) | |
| return(invisible()) | |
| } | |
| ### * .Rtest_package_depends_R_version | |
| .Rtest_package_depends_R_version <- | |
| function(dir) | |
| { | |
| if(missing(dir)) dir <- "." | |
| meta <- .read_description(file.path(dir, "DESCRIPTION")) | |
| deps <- .split_description(meta, verbose = TRUE)$Rdepends2 | |
| status <- 0 | |
| current <- getRversion() | |
| for(depends in deps) { | |
| ## .split_description will have ensured that this is NULL or | |
| ## of length 3. | |
| if(length(depends) > 1L) { | |
| ## .check_package_description will insist on these operators | |
| if(depends$op %notin% c("<=", ">=", "<", ">", "==", "!=")) | |
| message("WARNING: malformed 'Depends' field in 'DESCRIPTION'") | |
| else { | |
| status <- if(inherits(depends$version, "numeric_version")) | |
| !do.call(depends$op, list(current, depends$version)) | |
| else { | |
| ver <- R.version | |
| if (ver$status %in% c("", "Patched")) FALSE | |
| else !do.call(depends$op, | |
| list(ver[["svn rev"]], | |
| as.numeric(sub("^r", "", depends$version)))) | |
| } | |
| } | |
| if(status != 0) { | |
| package <- Sys.getenv("R_PACKAGE_NAME") | |
| if(!nzchar(package)) | |
| package <- meta["Package"] | |
| msg <- if(nzchar(package)) | |
| gettextf("ERROR: this R is version %s, package '%s' requires R %s %s", | |
| current, package, | |
| depends$op, depends$version) | |
| else | |
| gettextf("ERROR: this R is version %s, required is R %s %s", | |
| current, depends$op, depends$version) | |
| message(strwrap(msg, exdent = 2L)) | |
| break | |
| } | |
| } | |
| } | |
| status | |
| } | |
| ## no longer used | |
| .test_package_depends_R_version <- | |
| function(dir) | |
| q(status = .Rtest_package_depends_R_version(dir)) | |
| ### * .test_load_package | |
| .test_load_package <- function(pkg_name, lib) | |
| { | |
| options(warn = 1) | |
| res <- try(suppressPackageStartupMessages( | |
| library(pkg_name, lib.loc = lib, character.only = TRUE, logical.return = TRUE))) | |
| if (inherits(res, "try-error") || !res) | |
| stop("loading failed", call. = FALSE) | |
| } | |
| ### * checkRdaFiles | |
| checkRdaFiles <- function(paths) | |
| { | |
| if(length(paths) == 1L && dir.exists(paths)) { | |
| paths <- Sys.glob(c(file.path(paths, "*.rda"), | |
| file.path(paths, "*.RData"))) | |
| ## Exclude .RData, which this may or may not match | |
| paths <- paths[!endsWith(paths, "/.RData")] | |
| } | |
| res <- data.frame(size = NA_real_, ASCII = NA, | |
| compress = NA_character_, version = NA_integer_, | |
| stringsAsFactors = FALSE) | |
| res <- res[rep_len(1L, length(paths)), ] | |
| row.names(res) <- paths | |
| keep <- file.exists(paths) | |
| res$size[keep] <- file.size(paths)[keep] | |
| for(p in paths[keep]) { | |
| magic <- readBin(p, "raw", n = 5) | |
| res[p, "compress"] <- if(all(magic[1:2] == c(0x1f, 0x8b))) "gzip" | |
| else if(rawToChar(magic[1:3]) == "BZh") "bzip2" | |
| else if(magic[1L] == 0xFD && rawToChar(magic[2:5]) == "7zXZ") "xz" | |
| else if(grepl("RD[ABX][1-9]", rawToChar(magic), useBytes = TRUE)) "none" | |
| else "unknown" | |
| con <- gzfile(p) | |
| magic <- readChar(con, 5L, useBytes = TRUE) | |
| close(con) | |
| if (grepl("RD[ABX][1-9]", magic, useBytes = TRUE)) { | |
| res[p, "ASCII"] <- substr(magic, 3, 3) == "A" | |
| ver <- sub("(RD[ABX])([1-9])", "\\2", magic, useBytes = TRUE) | |
| res[p, "version"] <- as.integer(ver) | |
| } | |
| } | |
| res | |
| } | |
| ### * resaveRdaFiles | |
| resaveRdaFiles <- function(paths, | |
| compress = c("auto", "gzip", "bzip2", "xz"), | |
| compression_level, version = NULL) | |
| { | |
| if(length(paths) == 1L && dir.exists(paths)) | |
| paths <- Sys.glob(c(file.path(paths, "*.rda"), | |
| file.path(paths, "*.RData"))) | |
| compress <- match.arg(compress) | |
| if (missing(compression_level)) | |
| compression_level <- switch(compress, "gzip" = 6L, 9L) | |
| getVerLoad <- function(file) | |
| { | |
| con <- gzfile(file, "rb"); on.exit(close(con)) | |
| ## The .Internal gives an errror on version-1 files | |
| tryCatch(.Internal(loadInfoFromConn2(con))$version, | |
| error = function(e) 1L) | |
| } | |
| if(is.null(version)) version <- 2L # for maximal back-compatibility | |
| for(p in paths) { | |
| ver <- max(version, getVerLoad(p)) # to avoid losing features | |
| env <- new.env(hash = TRUE) # probably small, need not be | |
| suppressPackageStartupMessages(load(p, envir = env)) | |
| if(compress == "auto") { | |
| f1 <- tempfile() | |
| save(file = f1, list = ls(env, all.names = TRUE), envir = env, | |
| version = ver) | |
| f2 <- tempfile() | |
| save(file = f2, list = ls(env, all.names = TRUE), envir = env, | |
| compress = "bzip2", version = ver) | |
| ss <- file.size(c(f1, f2)) * c(0.9, 1.0) | |
| names(ss) <- c(f1, f2) | |
| if(ss[1L] > 10240) { | |
| f3 <- tempfile() | |
| save(file = f3, list = ls(env, all.names = TRUE), envir = env, | |
| compress = "xz", version = ver) | |
| ss <- c(ss, file.size(f3)) | |
| names(ss) <- c(f1, f2, f3) | |
| } | |
| nm <- names(ss) | |
| ind <- which.min(ss) | |
| file.copy(nm[ind], p, overwrite = TRUE) | |
| unlink(nm) | |
| } else | |
| save(file = p, list = ls(env, all.names = TRUE), envir = env, | |
| compress = compress, compression_level = compression_level, | |
| version = ver) | |
| } | |
| } | |
| ### * compactPDF | |
| compactPDF <- | |
| function(paths, qpdf = Sys.which(Sys.getenv("R_QPDF", "qpdf")), | |
| gs_cmd = Sys.getenv("R_GSCMD", ""), | |
| gs_quality = Sys.getenv("GS_QUALITY", "none"), | |
| gs_extras = character()) | |
| { | |
| use_qpdf <- nzchar(qpdf) | |
| qpdf_flags <- "--object-streams=generate" | |
| if(use_qpdf) { | |
| ## <NOTE> | |
| ## Before 2018-09, we passed | |
| ## --stream-data=compress | |
| ## to qpdf: but this is now deprecated, corresponds to | |
| ## the default since at least qpdf 6.0.0, and it at | |
| ## least one case made less compression when given. | |
| ## OTOH, people were using versions as old as 2.2.2. | |
| ## </NOTE> | |
| ver <- system2(qpdf, "--version", TRUE)[1L] | |
| ver <- as.numeric_version(sub("qpdf version ", "", ver, fixed=TRUE)) | |
| if(!is.na(ver) && ver < "6.0.0") | |
| qpdf_flags <- c("--stream-data=compress", qpdf_flags) | |
| } | |
| gs_quality <- match.arg(gs_quality, c("none", "printer", "ebook", "screen")) | |
| use_gs <- if(gs_quality != "none") nzchar(gs_cmd <- find_gs_cmd(gs_cmd)) else FALSE | |
| if (!use_gs && !use_qpdf) return() | |
| if(length(paths) == 1L && dir.exists(paths)) | |
| paths <- Sys.glob(file.path(paths, "*.pdf")) | |
| dummy <- rep.int(NA_real_, length(paths)) | |
| ans <- data.frame(old = dummy, new = dummy, row.names = paths) | |
| ## These should not have spaces, but quote below to be safe. | |
| tf <- tempfile("pdf"); tf2 <- tempfile("pdf") | |
| for (p in paths) { | |
| res <- 0 | |
| if (use_gs) { | |
| res <- system2(gs_cmd, | |
| c("-q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite", | |
| sprintf("-dPDFSETTINGS=/%s", gs_quality), | |
| "-dCompatibilityLevel=1.5", | |
| "-dAutoRotatePages=/None", | |
| "-dPrinted=false", | |
| sprintf("-sOutputFile=%s", shQuote(tf)), | |
| gs_extras, shQuote(p)), FALSE, FALSE) | |
| if(!res && use_qpdf) { | |
| unlink(tf2) # precaution | |
| file.rename(tf, tf2) | |
| res <- system2(qpdf, c(qpdf_flags, shQuote(tf2), shQuote(tf)), | |
| FALSE, FALSE) | |
| unlink(tf2) | |
| } | |
| } else if(use_qpdf) { | |
| res <- system2(qpdf, c(qpdf_flags, shQuote(p), shQuote(tf)), | |
| FALSE, FALSE) | |
| } | |
| if(!res && file.exists(tf)) { | |
| old <- file.size(p); new <- file.size(tf) | |
| if(new/old < 0.9 && new < old - 1e4) { | |
| file.copy(tf, p, overwrite = TRUE) | |
| ans[p, ] <- c(old, new) | |
| } | |
| } | |
| unlink(tf) | |
| } | |
| structure(stats::na.omit(ans), class = c("compactPDF", "data.frame")) | |
| } | |
| find_gs_cmd <- function(gs_cmd = "") | |
| { | |
| if(!nzchar(gs_cmd)) { | |
| if(.Platform$OS.type == "windows") { | |
| gsexe <- Sys.getenv("R_GSCMD") | |
| if (!nzchar(gsexe)) gsexe <- Sys.getenv("GSC") | |
| gs_cmd <- Sys.which(gsexe) | |
| if (!nzchar(gs_cmd)) gs_cmd <- Sys.which("gswin64c") | |
| if (!nzchar(gs_cmd)) gs_cmd <- Sys.which("gswin32c") | |
| gs_cmd | |
| } else Sys.which(Sys.getenv("R_GSCMD", "gs")) | |
| } else Sys.which(gs_cmd) | |
| } | |
| format.compactPDF <- function(x, ratio = 0.9, diff = 1e4, ...) | |
| { | |
| if(!nrow(x)) return(character()) | |
| z <- y <- x[with(x, new/old < ratio & new < old - diff), ] | |
| if(!nrow(z)) return(character()) | |
| z[] <- lapply(y, function(x) sprintf("%.0fKb", x/1024)) | |
| large <- y$new >= 1024^2 | |
| z[large, ] <- lapply(y[large, ], function(x) sprintf("%.1fMb", x/1024^2)) | |
| paste(' compacted', sQuote(basename(row.names(y))), | |
| 'from', z[, 1L], 'to', z[, 2L]) | |
| } | |
| ### * add_datalist | |
| add_datalist <- function(pkgpath, force = FALSE, small.size = 1024^2) | |
| { | |
| dlist <- file.path(pkgpath, "data", "datalist") | |
| if (!force && file.exists(dlist)) return() | |
| size <- sum(file.size(Sys.glob(file.path(pkgpath, "data", "*")))) | |
| if(size <= small.size) return() | |
| z <- list_data_in_pkg(dir = pkgpath, use_datalist = FALSE) | |
| if(!length(z)) return() | |
| con <- file(dlist, "w") | |
| for (nm in names(z)) { | |
| zz <- z[[nm]] | |
| if (length(zz) == 1L && zz == nm) writeLines(nm, con) | |
| else cat(nm, ": ", paste(zz, collapse = " "), "\n", | |
| sep = "", file = con) | |
| } | |
| close(con) | |
| invisible() | |
| } | |
| ### Local variables: *** | |
| ### mode: outline-minor *** | |
| ### outline-regexp: "### [*]+" *** | |
| ### End: *** |