R/initutils.R

## options(stringsAsFactors = FALSE)

## `::` = function(pkg, name) {
##     suppressMessages({forceload()})
##     pkg <- as.character(substitute(pkg))
##     name <- as.character(substitute(name))
##     out = getExportedValue(pkg, name)
##     suppressMessages({forceload()})
##     return(out)
## }

## `:::` = function(pkg, name) {
##     suppressMessages({forceload()})
##     pkg <- as.character(substitute(pkg))
##     name <- as.character(substitute(name))
##     out = get(name, envir = asNamespace(pkg), inherits = FALSE)
##     suppressMessages({forceload()})
##     return(out)
## }

## require = function (package, lib.loc = NULL, quietly = FALSE, warn.conflicts, 
##     character.only = FALSE, mask.ok, exclude, include.only, attach.required = missing(include.only)) 
## {
##     suppressMessages({forceload()})
##     if (!character.only) 
##         package <- as.character(substitute(package))
##     loaded <- paste0("package:", package) %in% search()
##     if (!loaded) {
##         if (!quietly) 
##             packageStartupMessage(gettextf("Loading required package: %s", 
##                 package), domain = NA)
##         value <- tryCatch(library(package, lib.loc = lib.loc, 
##             character.only = TRUE, logical.return = TRUE, warn.conflicts = warn.conflicts, 
##             quietly = quietly, mask.ok = mask.ok, exclude = exclude, 
##             include.only = include.only, attach.required = attach.required), 
##             error = function(e) e)
##         suppressMessages({forceload()})
##         if (inherits(value, "error")) {
##             if (!quietly) {
##                 msg <- conditionMessage(value)
##                 cat("Failed with error:  ", sQuote(msg), "\n", 
##                   file = stderr(), sep = "")
##                 .Internal(printDeferredWarnings())
##             }
##             return(invisible(FALSE))
##         }
##         if (!value) 
##             return(invisible(FALSE))
##     }
##     else value <- TRUE
##     invisible(value)
## }

## library = function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE, 
##     logical.return = FALSE, warn.conflicts, quietly = FALSE, 
##     verbose = getOption("verbose"), mask.ok, exclude, include.only, 
##     attach.required = missing(include.only)) 
## {
##     suppressMessages({forceload()})
##     on.exit({suppressMessages({forceload()})})
##     conf.ctrl <- getOption("conflicts.policy")
##     if (is.character(conf.ctrl)) 
##         conf.ctrl <- switch(conf.ctrl, strict = list(error = TRUE, 
##             warn = FALSE), depends.ok = list(error = TRUE, generics.ok = TRUE, 
##             can.mask = c("base", "methods", "utils", "grDevices", 
##                 "graphics", "stats"), depends.ok = TRUE), warning(gettextf("unknown conflict policy: %s", 
##             sQuote(conf.ctrl)), call. = FALSE, domain = NA))
##     if (!is.list(conf.ctrl)) 
##         conf.ctrl <- NULL
##     stopOnConflict <- isTRUE(conf.ctrl$error)
##     if (missing(warn.conflicts)) 
##         warn.conflicts <- if (isFALSE(conf.ctrl$warn)) 
##             FALSE
##         else TRUE
##     if ((!missing(include.only)) && (!missing(exclude))) 
##         stop(gettext("only one of 'include.only' and 'exclude' can be used"), 
##             call. = FALSE, domain = NA)
##     testRversion <- function(pkgInfo, pkgname, pkgpath) {
##         if (is.null(built <- pkgInfo$Built)) 
##             stop(gettextf("package %s has not been installed properly\n", 
##                 sQuote(pkgname)), call. = FALSE, domain = NA)
##         R_version_built_under <- as.numeric_version(built$R)
##         if (R_version_built_under < "3.0.0") 
##             stop(gettextf("package %s was built before R 3.0.0: please re-install it", 
##                 sQuote(pkgname)), call. = FALSE, domain = NA)
##         current <- getRversion()
##         if (length(Rdeps <- pkgInfo$Rdepends2)) {
##             for (dep in Rdeps) if (length(dep) > 1L) {
##                 target <- dep$version
##                 res <- if (is.character(target)) {
##                   do.call(dep$op, list(as.numeric(R.version[["svn rev"]]), 
##                     as.numeric(sub("^r", "", dep$version))))
##                 }
##                 else {
##                   do.call(dep$op, list(current, as.numeric_version(target)))
##                 }
##                 if (!res) 
##                   stop(gettextf("This is R %s, package %s needs %s %s", 
##                     current, sQuote(pkgname), dep$op, target), 
##                     call. = FALSE, domain = NA)
##             }
##         }
##         if (R_version_built_under > current) 
##             warning(gettextf("package %s was built under R version %s", 
##                 sQuote(pkgname), as.character(built$R)), call. = FALSE, 
##                 domain = NA)
##         platform <- built$Platform
##         r_arch <- .Platform$r_arch
##         if (.Platform$OS.type == "unix") {
##         }
##         else {
##             if (nzchar(platform) && !grepl("mingw", platform)) 
##                 stop(gettextf("package %s was built for %s", 
##                   sQuote(pkgname), platform), call. = FALSE, 
##                   domain = NA)
##         }
##         if (nzchar(r_arch) && file.exists(file.path(pkgpath, 
##             "libs")) && !file.exists(file.path(pkgpath, "libs", 
##             r_arch))) 
##             stop(gettextf("package %s is not installed for 'arch = %s'", 
##                 sQuote(pkgname), r_arch), call. = FALSE, domain = NA)
##     }
##     checkNoGenerics <- function(env, pkg) {
##         nenv <- env
##         ns <- .getNamespace(as.name(pkg))
##         if (!is.null(ns)) 
##             nenv <- asNamespace(ns)
##         if (exists(".noGenerics", envir = nenv, inherits = FALSE)) 
##             TRUE
##         else {
##             !any(startsWith(names(env), ".__T"))
##         }
##     }
##     checkConflicts <- function(package, pkgname, pkgpath, nogenerics, 
##         env) {
##         dont.mind <- c("last.dump", "last.warning", ".Last.value", 
##             ".Random.seed", ".Last.lib", ".onDetach", ".packageName", 
##             ".noGenerics", ".required", ".no_S3_generics", ".Depends", 
##             ".requireCachedGenerics")
##         sp <- search()
##         lib.pos <- which(sp == pkgname)
##         ob <- names(as.environment(lib.pos))
##         if (!nogenerics) {
##             these <- ob[startsWith(ob, ".__T__")]
##             gen <- gsub(".__T__(.*):([^:]+)", "\\1", these)
##             from <- gsub(".__T__(.*):([^:]+)", "\\2", these)
##             gen <- gen[from != package]
##             ob <- ob[!(ob %in% gen)]
##         }
##         ipos <- seq_along(sp)[-c(lib.pos, match(c("Autoloads", 
##             "CheckExEnv"), sp, 0L))]
##         cpos <- NULL
##         conflicts <- vector("list", 0)
##         for (i in ipos) {
##             obj.same <- match(names(as.environment(i)), ob, nomatch = 0L)
##             if (any(obj.same > 0)) {
##                 same <- ob[obj.same]
##                 same <- same[!(same %in% dont.mind)]
##                 Classobjs <- which(startsWith(same, ".__"))
##                 if (length(Classobjs)) 
##                   same <- same[-Classobjs]
##                 same.isFn <- function(where) vapply(same, exists, 
##                   NA, where = where, mode = "function", inherits = FALSE)
##                 same <- same[same.isFn(i) == same.isFn(lib.pos)]
##                 not.Ident <- function(ch, TRAFO = identity, ...) vapply(ch, 
##                   function(.) !identical(TRAFO(get(., i)), TRAFO(get(., 
##                     lib.pos)), ...), NA)
##                 if (length(same)) 
##                   same <- same[not.Ident(same)]
##                 if (length(same) && identical(sp[i], "package:base")) 
##                   same <- same[not.Ident(same, ignore.environment = TRUE)]
##                 if (length(same)) {
##                   conflicts[[sp[i]]] <- same
##                   cpos[sp[i]] <- i
##                 }
##             }
##         }
##         if (length(conflicts)) {
##             if (stopOnConflict) {
##                 emsg <- ""
##                 pkg <- names(conflicts)
##                 notOK <- vector("list", 0)
##                 for (i in seq_along(conflicts)) {
##                   pkgname <- sub("^package:", "", pkg[i])
##                   if (pkgname %in% canMaskEnv$canMask) 
##                     next
##                   same <- conflicts[[i]]
##                   if (is.list(mask.ok)) 
##                     myMaskOK <- mask.ok[[pkgname]]
##                   else myMaskOK <- mask.ok
##                   if (isTRUE(myMaskOK)) 
##                     same <- NULL
##                   else if (is.character(myMaskOK)) 
##                     same <- setdiff(same, myMaskOK)
##                   if (length(same)) {
##                     notOK[[pkg[i]]] <- same
##                     msg <- .maskedMsg(sort(same), pkg = sQuote(pkg[i]), 
##                       by = cpos[i] < lib.pos)
##                     emsg <- paste(emsg, msg, sep = "\n")
##                   }
##                 }
##                 if (length(notOK)) {
##                   msg <- gettextf("Conflicts attaching package %s:\n%s", 
##                     sQuote(package), emsg)
##                   stop(errorCondition(msg, package = package, 
##                     conflicts = conflicts, class = "packageConflictError"))
##                 }
##             }
##             if (warn.conflicts) {
##                 packageStartupMessage(gettextf("\nAttaching package: %s\n", 
##                   sQuote(package)), domain = NA)
##                 pkg <- names(conflicts)
##                 for (i in seq_along(conflicts)) {
##                   msg <- .maskedMsg(sort(conflicts[[i]]), pkg = sQuote(pkg[i]), 
##                     by = cpos[i] < lib.pos)
##                   packageStartupMessage(msg, domain = NA)
##                 }
##             }
##         }
##     }
##     if (verbose && quietly) 
##         message("'verbose' and 'quietly' are both true; being verbose then ..")
##     if (!missing(package)) {
##         if (is.null(lib.loc)) 
##             lib.loc <- .libPaths()
##         lib.loc <- lib.loc[dir.exists(lib.loc)]
##         if (!character.only) 
##             package <- as.character(substitute(package))
##         if (length(package) != 1L) 
##             stop("'package' must be of length 1")
##         if (is.na(package) || (package == "")) 
##             stop("invalid package name")
##         pkgname <- paste0("package:", package)
##         newpackage <- is.na(match(pkgname, search()))
##         if (newpackage) {
##             pkgpath <- find.package(package, lib.loc, quiet = TRUE, 
##                 verbose = verbose)
##             if (length(pkgpath) == 0L) {
##                 if (length(lib.loc) && !logical.return) 
##                   stop(packageNotFoundError(package, lib.loc, 
##                     sys.call()))
##                 txt <- if (length(lib.loc)) 
##                   gettextf("there is no package called %s", sQuote(package))
##                 else gettext("no library trees found in 'lib.loc'")
##                 if (logical.return) {
##                   warning(txt, domain = NA)
##                   return(FALSE)
##                 }
##                 else stop(txt, domain = NA)
##             }
##             which.lib.loc <- normalizePath(dirname(pkgpath), 
##                 "/", TRUE)
##             pfile <- system.file("Meta", "package.rds", package = package, 
##                 lib.loc = which.lib.loc)
##             if (!nzchar(pfile)) 
##                 stop(gettextf("%s is not a valid installed package", 
##                   sQuote(package)), domain = NA)
##             pkgInfo <- readRDS(pfile)
##             testRversion(pkgInfo, package, pkgpath)
##             if (is.character(pos)) {
##                 npos <- match(pos, search())
##                 if (is.na(npos)) {
##                   warning(gettextf("%s not found on search path, using pos = 2", 
##                     sQuote(pos)), domain = NA)
##                   pos <- 2
##                 }
##                 else pos <- npos
##             }
##             deps <- unique(names(pkgInfo$Depends))
##             depsOK <- isTRUE(conf.ctrl$depends.ok)
##             if (depsOK) {
##                 canMaskEnv <- dynGet("__library_can_mask__", 
##                   NULL)
##                 if (is.null(canMaskEnv)) {
##                   canMaskEnv <- new.env()
##                   canMaskEnv$canMask <- union("base", conf.ctrl$can.mask)
##                   "__library_can_mask__" <- canMaskEnv
##                 }
##                 canMaskEnv$canMask <- unique(c(package, deps, 
##                   canMaskEnv$canMask))
##             }
##             else canMaskEnv <- NULL
##             if (attach.required) 
##                 .getRequiredPackages2(pkgInfo, quietly = quietly)
##             cr <- conflictRules(package)
##             if (missing(mask.ok)) 
##                 mask.ok <- cr$mask.ok
##             if (missing(exclude)) 
##                 exclude <- cr$exclude
##             if (packageHasNamespace(package, which.lib.loc)) {
##                 if (isNamespaceLoaded(package)) {
##                   newversion <- as.numeric_version(pkgInfo$DESCRIPTION["Version"])
##                   oldversion <- as.numeric_version(getNamespaceVersion(package))
##                   if (newversion != oldversion) {
##                     tryCatch(unloadNamespace(package), error = function(e) {
##                       P <- if (!is.null(cc <- conditionCall(e))) 
##                         paste("Error in", deparse(cc)[1L], ": ")
##                       else "Error : "
##                       stop(gettextf("Package %s version %s cannot be unloaded:\n %s", 
##                         sQuote(package), oldversion, paste0(P, 
##                           conditionMessage(e), "\n")), domain = NA)
##                     })
##                   }
##                 }
##                 tt <- tryCatch({
##                   attr(package, "LibPath") <- which.lib.loc
##                   ns <- loadNamespace(package, lib.loc)
##                   env <- attachNamespace(ns, pos = pos, deps, 
##                     exclude, include.only)
##                 }, error = function(e) {
##                   P <- if (!is.null(cc <- conditionCall(e))) 
##                     paste(" in", deparse(cc)[1L])
##                   else ""
##                   msg <- gettextf("package or namespace load failed for %s%s:\n %s", 
##                     sQuote(package), P, conditionMessage(e))
##                   if (logical.return) 
##                     message(paste("Error:", msg), domain = NA)
##                   else stop(msg, call. = FALSE, domain = NA)
##                 })
##                 if (logical.return && is.null(tt)) 
##                   return(FALSE)
##                 attr(package, "LibPath") <- NULL
##                 {
##                   on.exit(detach(pos = pos))
##                   nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, 
##                     package)
##                   if (isFALSE(conf.ctrl$generics.ok) || (stopOnConflict && 
##                     !isTRUE(conf.ctrl$generics.ok))) 
##                     nogenerics <- TRUE
##                   if (stopOnConflict || (warn.conflicts && !exists(".conflicts.OK", 
##                     envir = env, inherits = FALSE))) 
##                     checkConflicts(package, pkgname, pkgpath, 
##                       nogenerics, ns)
##                   on.exit()
##                   if (logical.return) 
##                     return(TRUE)
##                   else return(invisible(.packages()))
##                 }
##             }
##             else stop(gettextf("package %s does not have a namespace and should be re-installed", 
##                 sQuote(package)), domain = NA)
##         }
##         if (verbose && !newpackage) 
##             warning(gettextf("package %s already present in search()", 
##                 sQuote(package)), domain = NA)
##     }
##     else if (!missing(help)) {
##         if (!character.only) 
##             help <- as.character(substitute(help))
##         pkgName <- help[1L]
##         pkgPath <- find.package(pkgName, lib.loc, verbose = verbose)
##         docFiles <- c(file.path(pkgPath, "Meta", "package.rds"), 
##             file.path(pkgPath, "INDEX"))
##         if (file.exists(vignetteIndexRDS <- file.path(pkgPath, 
##             "Meta", "vignette.rds"))) 
##             docFiles <- c(docFiles, vignetteIndexRDS)
##         pkgInfo <- vector("list", 3L)
##         readDocFile <- function(f) {
##             if (basename(f) %in% "package.rds") {
##                 txt <- readRDS(f)$DESCRIPTION
##                 if ("Encoding" %in% names(txt)) {
##                   to <- if (Sys.getlocale("LC_CTYPE") == "C") 
##                     "ASCII//TRANSLIT"
##                   else ""
##                   tmp <- try(iconv(txt, from = txt["Encoding"], 
##                     to = to))
##                   if (!inherits(tmp, "try-error")) 
##                     txt <- tmp
##                   else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
##                     call. = FALSE)
##                 }
##                 nm <- paste0(names(txt), ":")
##                 formatDL(nm, txt, indent = max(nchar(nm, "w")) + 
##                   3L)
##             }
##             else if (basename(f) %in% "vignette.rds") {
##                 txt <- readRDS(f)
##                 if (is.data.frame(txt) && nrow(txt)) 
##                   cbind(basename(gsub("\\.[[:alpha:]]+$", "", 
##                     txt$File)), paste(txt$Title, paste0(rep.int("(source", 
##                     NROW(txt)), ifelse(nzchar(txt$PDF), ", pdf", 
##                     ""), ")")))
##                 else NULL
##             }
##             else readLines(f)
##         }
##         for (i in which(file.exists(docFiles))) pkgInfo[[i]] <- readDocFile(docFiles[i])
##         y <- list(name = pkgName, path = pkgPath, info = pkgInfo)
##         class(y) <- "packageInfo"
##         return(y)
##     }
##     else {
##         if (is.null(lib.loc)) 
##             lib.loc <- .libPaths()
##         db <- matrix(character(), nrow = 0L, ncol = 3L)
##         nopkgs <- character()
##         for (lib in lib.loc) {
##             a <- .packages(all.available = TRUE, lib.loc = lib)
##             for (i in sort(a)) {
##                 file <- system.file("Meta", "package.rds", package = i, 
##                   lib.loc = lib)
##                 title <- if (nzchar(file)) {
##                   txt <- readRDS(file)
##                   if (is.list(txt)) 
##                     txt <- txt$DESCRIPTION
##                   if ("Encoding" %in% names(txt)) {
##                     to <- if (Sys.getlocale("LC_CTYPE") == "C") 
##                       "ASCII//TRANSLIT"
##                     else ""
##                     tmp <- try(iconv(txt, txt["Encoding"], to, 
##                       "?"))
##                     if (!inherits(tmp, "try-error")) 
##                       txt <- tmp
##                     else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
##                       call. = FALSE)
##                   }
##                   txt["Title"]
##                 }
##                 else NA
##                 if (is.na(title)) 
##                   title <- " ** No title available ** "
##                 db <- rbind(db, cbind(i, lib, title))
##             }
##             if (length(a) == 0L) 
##                 nopkgs <- c(nopkgs, lib)
##         }
##         dimnames(db) <- list(NULL, c("Package", "LibPath", "Title"))
##         if (length(nopkgs) && !missing(lib.loc)) {
##             pkglist <- paste(sQuote(nopkgs), collapse = ", ")
##             msg <- sprintf(ngettext(length(nopkgs), "library %s contains no packages", 
##                 "libraries %s contain no packages"), pkglist)
##             warning(msg, domain = NA)
##         }
##         y <- list(header = NULL, results = db, footer = NULL)
##         class(y) <- "libraryIQR"
##         return(y)
##     }
##     if (logical.return) 
##         TRUE
##     else invisible(.packages())
## }

## names2 = function(x) {
##     nm = names(x)
##     if (is.null(nm))
##         return(rep_len("", length(x)))
##     else
##         return(nm)
## }

## `names2<-` = function(x, value, useempty = FALSE) {
##     names(x) = if (!is.null(value))
##                    rep_len(value, length(x))
##                else {
##                    if (useempty)
##                        rep_len("", length(x))
##                }
##     return(x)
## }

## forceload = function(envir = globalenv()) {
##     force = function(x) x
##     pkgs = gsub("package:", "", grep('package:', search(), value = TRUE))
##     pkgs = c(pkgs, names(sessionInfo()$loadedOnly))
##     for (pkg in pkgs) {
##         tryCatch( {
##             message("force loading ", pkg)
##             invisible(eval(as.list((asNamespace(pkg))), envir = envir))
##             invisible(eval(eapply(asNamespace(pkg), force, all.names = TRUE), envir = envir))
##         }, error = function(e) message("could not force load ", pkg))
##     }
## }

## forcefun = function(envir = globalenv(), evalenvir = globalenv()) {
##     funnames = as.character(lsf.str(envir = envir))
##     for (fun in funnames) {
##         tryCatch( {
##             message("force loading ", fun)
##             eval(force(get(fun, envir = envir)), envir = evalenvir)
##         }, error = function(e) message("could not force load ", fun))
##     }
## }



## relib2 = function(lib = 'Flow', force = TRUE, unload = TRUE)
## {
##     suppressMessages(forceload())
##     if (sprintf("package:%s", lib) %in% search())
##     {
##         expr = sprintf("detach(package:%s, force = force, unload = unload)", lib)
##         eval(parse(text = expr))
##         ## tryCatch(unload(lib), error = function(e) NULL) ## DO NOT use this line...
##         ## it will break re-librarying
##     }
##     txt = sprintf("library2(%s)", lib)
##     eval(parse(text = txt))
##     suppressMessages(forceload())
## }

## relib3 = function(..., force = TRUE, unload = TRUE)
## {
##     suppressMessages(forceload())
##     names2 = function(x) {
##         nm = names(x)
##         if (is.null(nm))
##             return(rep_len("", length(x)))
##         else
##             return(nm)
##     }
##     lst.arg = as.list(match.call(expand.dots = F))$`...`
##     nm = names2(lst.arg)
##     otherarg = lst.arg[nzchar(nm)]
##     pkgarg = lst.arg[!nzchar(nm)]
##     pkgarg = pkgarg[sapply(pkgarg, function(x) is.call(x) || is.character(x))]
##     charvec = as.character(all.vars(match.call()))
##     if (length(charvec)) {
##         notfound= { set.seed(10); paste0("notfound_", round(runif(1) * 1e9)); }
##         vars = mget(charvec, ifnotfound=notfound, mode = "character", inherits = T)
##         ## charvec = unlist(strsplit(toString(vars[[1]]), ", "))
##         charvec = unique(c(names2(vars[vars == notfound]), unlist(vars[vars != notfound]))) 
##     }
##     charvec = c(charvec, unlist(as.vector(sapply(pkgarg,
##                                                  function(x) tryCatch(eval(x), error = function(e) NULL)))))
##     for (lib in charvec) {
##          if (sprintf("package:%s", lib) %in% search())
##          {
##              expr = sprintf("detach(package:%s, force = force, unload = unload)", lib)
##              eval(parse(text = expr))
##              ## tryCatch(unload(lib), error = function(e) NULL) ## DO NOT use this line...
##              ## it will break re-librarying
##          }
##          library(lib, character.only = T)
##     }
##     suppressMessages(forceload())
## }

## detach2 = function(lib = "Flow", force = TRUE, unload = TRUE) {
##     suppressMessages(forceload())
##     if (sprintf("package:%s", lib) %in% search())
##     {
##         expr = sprintf("detach(package:%s, force = force, unload = unload)", lib)
##         suppressMessages(eval(parse(text = expr)))
##         tryCatch(unload(lib), error = function(e) NULL)
##     }
##     suppressMessages(forceload())
## }

## library2 = function(x, ...) {
##     suppressMessages(forceload())
##     arg = as.list(match.call())[["x"]]
##     if (is.symbol(arg)) {
##         lib = tryCatch(as.character(eval(arg)), error = function(e) arg)
##         if (!is.character(lib)) {
##             lib = toString(lib)
##         }
##     } else {
##         lib = x
##     }
##     library(lib, character.only = T, ...)
##     suppressMessages(forceload())
## }

## library3 = function (...) 
## {
##     suppressMessages(forceload())
##     names2 = function(x) {
##         nm = names(x)
##         if (is.null(nm))
##             return(rep_len("", length(x)))
##         else
##             return(nm)
##     }
##     suppressMessages(forceload())
##     lst.arg = as.list(match.call(expand.dots = F))$`...`
##     nm = names2(lst.arg)
##     otherarg = lst.arg[nzchar(nm)]
##     pkgarg = lst.arg[!nzchar(nm)]
##     pkgarg = pkgarg[sapply(pkgarg, function(x) is.call(x) || is.character(x))]
##     charvec = as.character(all.vars(match.call()))
##     if (length(charvec)) {
##         notfound= { set.seed(10); paste0("notfound_", round(runif(1) * 1e9)); }
##         vars = mget(charvec, ifnotfound=notfound, mode = "character", inherits = T)
##         ## charvec = unlist(strsplit(toString(vars[[1]]), ", "))
##         charvec = unique(c(names2(vars[vars == notfound]), unlist(vars[vars != notfound]))) 
##     }
##     charvec = c(charvec, unlist(as.vector(sapply(pkgarg,
##                                                  function(x) tryCatch(eval(x), error = function(e) NULL)))))
##     for (lib in charvec) {
##         do.call(library, c(alist(package = lib, character.only = T),
##                            otherarg))
##     }
##     suppressMessages(forceload())
## }


## force2 = function(x)
##     tryCatch(x, error = function(e) NULL)


## forceall = function(invisible = TRUE, envir = parent.frame(), evalenvir = parent.frame()) {
##     if (invisible)  {
##         invisible(eval(as.list(envir), envir = evalenvir))
##         invisible(eval(eapply(envir, force, all.names = TRUE), envir = evalenvir))
##     } else {
##         print(eval(as.list(envir), envir = evalenvir))
##         print(eval(eapply(envir, force, all.names = TRUE), envir = evalenvir))
##     }
## }    
kevinmhadi/khtools documentation built on Jan. 16, 2025, 4:18 p.m.