Merge branch 'refactor'

DESCRIPTION

@@ -56,7 +56,6 @@ Collate:
     'with.r'
     'install-bitbucket.r'
     'path.r'
-    'namespace.r'
     'reload-devtools.r'
     'run-loadhooks.r'
     'env-utils.r'
@@ -68,3 +67,5 @@ Collate:
     'compile.r'
     'load-dll.r'
     'utils.r'
+    'imports-env.r'
+    'namespace-env.r'

R/imports-env.r

@@ -0,0 +1,86 @@
+#' Return imports environment for a package
+#'
+#' Contains objects imported from other packages. Is the parent of the
+#' package namespace environment, and is a child of <namespace:base>,
+#' which is a child of R_GlobalEnv.
+#' @keywords programming
+#' @seealso \code{\link{ns_env}} for the namespace environment that
+#'   all the objects (exported and not exported).
+#' @seealso \code{\link{pkg_env}} for the attached environment that contains
+#'   the exported objects.
+#' @export
+imports_env <- function(pkg = NULL) {
+  pkg <- as.package(pkg)
+
+  if (!is_loaded(pkg)) {
+    stop("Namespace environment must be created before accessing imports environment.")
+  }
+
+  env <- parent.env(ns_env(pkg))
+
+  if (attr(env, 'name') != imports_env_name(pkg)) {
+    stop("Imports environment does not have attribute 'name' with value ",
+      imports_env_name(pkg),
+      ". This probably means that the namespace environment was not created correctly.")
+  }
+
+  env
+}
+
+
+# Generate name of package imports environment
+# Contains exported objects
+imports_env_name <- function(pkg = NULL) {
+  pkg <- as.package(pkg)
+  paste("imports:", pkg$package, sep = "")
+}
+
+
+#' Load all of the imports for a package
+#'
+#' The imported objects are copied to the imports environment, and are not
+#' visible from R_GlobalEnv. This will automatically load (but not attach)
+#' the dependency packages.
+#'
+#' @keywords internal
+load_imports <- function(pkg = NULL, deps = c("depends", "imports")) {
+  pkg <- as.package(pkg)
+
+  # Get data frame of dependency names and versions
+  deps <- lapply(pkg[deps], parse_deps)
+  deps <- Reduce(rbind, deps)
+
+  if (is.null(deps) || nrow(deps) == 0) return(invisible())
+
+  # If we've already loaded imports, don't load again (until load_all
+  # is run with reset=TRUE). This is to avoid warnings when running
+  # process_imports()
+  if (length(ls(imports_env(pkg))) > 0) return(invisible(deps))
+
+  mapply(check_dep_version, deps$name, deps$version, deps$compare)
+
+  process_imports(pkg)
+
+  invisible(deps)
+}
+
+
+# Load imported objects
+# The code in this function is taken from base::loadNamespace
+process_imports <- function(pkg) {
+  nsInfo <- parse_ns_file(pkg)
+  ns <- ns_env(pkg)
+  lib.loc <- NULL
+
+  ## process imports
+  for (i in nsInfo$imports) {
+    if (is.character(i))
+      namespaceImport(ns, loadNamespace(i))
+    else
+      namespaceImportFrom(ns, loadNamespace(i[[1L]]), i[[2L]])
+  }
+  for(imp in nsInfo$importClasses)
+    namespaceImportClasses(ns, loadNamespace(imp[[1L]]), imp[[2L]])
+  for(imp in nsInfo$importMethods)
+    namespaceImportMethods(ns, loadNamespace(imp[[1L]]), imp[[2L]])
+}

R/load.r

@@ -85,7 +85,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE,
   }
 
   # If installed version of package loaded, unload it
-  if (is.loaded_ns(pkg) && is.null(dev_meta(pkg$package))) {
+  if (is_loaded(pkg) && is.null(dev_meta(pkg$package))) {
     unload(pkg)
   }
 
@@ -94,7 +94,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE,
 
   if (reset) {
     clear_cache()
-    clear_pkg_env(pkg)
+    if (is_loaded(pkg)) unload(pkg)
   }
 
   if (recompile) clean_dll(pkg)
@@ -104,9 +104,11 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE,
 
 
   # Set up the namespace environment ----------------------------------
-  nsenv <- ns_env(pkg, create = TRUE)
+  # This mimics the procedure in loadNamespace
 
-  out <- list(env = nsenv)
+  if (!is_loaded(pkg)) create_ns_env(pkg)
+
+  out <- list(env = ns_env(pkg))
 
   # Load dependencies into the imports environment
   load_imports(pkg)
@@ -118,21 +120,18 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE,
 
   # Set up the exports in the namespace metadata (this must happen after
   # the objects are loaded)
-  setup_ns_exports(pkg)
+  setup_ns_exports(pkg, export_all)
 
   run_onload(pkg)
 
   # Set up the package environment ------------------------------------
-  # Create the package environment and copy over objects from the
-  # namespace environment.
-  attach_ns(pkg, export_all)
+  # Create the package environment if needed
+  if (!is_attached(pkg)) attach_ns(pkg)
+
+  # Copy over objects from the namespace environment
+  export_ns(pkg)
 
   run_onattach(pkg)
 
   invisible(out)  
 }
-
-
-is.locked <- function(pkg = NULL) {
-  environmentIsLocked(as.environment(env_pkg_name(pkg)))
-}

R/metadata.r

@@ -3,8 +3,6 @@
 #' If the package was not loaded with devtools, returns \code{NULL}.
 #'
 #' @param name The name of a loaded package
-#' @param create If the metadata environment does not exist, create it?
-#'   For internal use only.
 #' @examples
 #' dev_meta("stats") # NULL
 #'
@@ -19,19 +17,30 @@
 #' # Clean up.
 #' unload(devtest("load-hooks"))
 #' @export
-dev_meta <- function(name, create = FALSE) {
+dev_meta <- function(name) {
   ns <- .Internal(getRegisteredNamespace(as.name(name)))
   if (is.null(ns)) {
     stop("Namespace not found for ", name, ". Is it loaded?")
   }
 
   if (is.null(ns$.__DEVTOOLS__)) {
-    if (create) {
-      ns$.__DEVTOOLS__ <- new.env(parent = ns)
-    } else {
-      return(NULL)
-    }
+    return(NULL)
   }
 
   ns$.__DEVTOOLS__
 }
+
+
+# Create the devtools metadata environment for a package.
+# This should be run when packages are loaded by devtools.
+create_dev_meta <- function(name) {
+  ns <- .Internal(getRegisteredNamespace(as.name(name)))
+
+  if (!is.null(ns$.__DEVTOOLS__)) {
+    stop("devtools metadata for package ", name, " already exists.")
+  }
+
+  ns$.__DEVTOOLS__ <- new.env(parent = ns)
+
+  ns$.__DEVTOOLS__
+}

R/namespace.r → R/namespace-env.r

@@ -1,3 +1,48 @@
+#' Return the namespace environment for a package.
+#'
+#' Contains all (exported and non-exported) objects, and is a descendent of
+#' \code{R_GlobalEnv}. The hieararchy is \code{<namespace:pkg>}, 
+#' \code{<imports:pkg>}, \code{<namespace:base>}, and then
+#' \code{R_GlobalEnv}.
+#'
+#' If the package is not loaded, this function returns \code{NULL}.
+#'
+#' @param pkg package description, can be path or package name.  See
+#'   \code{\link{as.package}} for more information
+#' @keywords programming
+#' @seealso \code{\link{pkg_env}} for the attached environment that
+#'   contains the exported objects.
+#' @seealso \code{\link{imports_env}} for the environment that contains
+#'   imported objects for the package.
+#' @export
+ns_env <- function(pkg = NULL) {
+  pkg <- as.package(pkg)
+
+  if (!is_loaded(pkg)) return(NULL)
+
+  asNamespace(pkg$package)
+}
+
+
+# Create the namespace environment for a package
+create_ns_env <- function(pkg = NULL) {
+  pkg <- as.package(pkg)
+
+  if (is_loaded(pkg)) {
+    stop("Namespace for ", pkg$package, " already exists.")
+  }
+
+  env <- makeNamespace(pkg$package)
+  setPackageName(pkg$package, env)
+  # Create devtools metadata in namespace
+  create_dev_meta(pkg$package)
+
+  setNamespaceInfo(env, "path", pkg$path)
+  setup_ns_imports(pkg)
+
+  env
+}
+
 # This is taken directly from base::loadNamespace() in R 2.15.1
 makeNamespace <- function(name, version = NULL, lib = NULL) {
   impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE)
@@ -33,14 +78,26 @@ setup_ns_imports <- function(pkg) {
 # Read the NAMESPACE file and set up the exports metdata. This must be
 # run after all the objects are loaded into the namespace because
 # namespaceExport throw errors if the objects are not present.
-setup_ns_exports <- function(pkg) {
+setup_ns_exports <- function(pkg, export_all = FALSE) {
   nsInfo <- parse_ns_file(pkg)
 
-  # This code is from base::loadNamespace
-  exports <- nsInfo$exports
-  for (p in nsInfo$exportPatterns)
-    exports <- c(ls(env, pattern = p, all.names = TRUE), exports)
+  if (export_all) {
+    exports <- ls(ns_env(pkg), all.names = TRUE)
 
+    # List of things to ignore is from loadNamespace. There are also a
+    # couple things to ignore from devtools.
+    ignoreidx <- exports %in% c( ".__NAMESPACE__.",
+      ".__S3MethodsTable__.", ".packageName", ".First.lib", ".onLoad",
+      ".onAttach", ".conflicts.OK", ".noGenerics",
+      ".__DEVTOOLS__", ".cache")
+    exports <- exports[!ignoreidx]
+
+  } else {
+    # This code is from base::loadNamespace
+    exports <- nsInfo$exports
+    for (p in nsInfo$exportPatterns)
+      exports <- c(ls(env, pattern = p, all.names = TRUE), exports)
+  }
   # Update the exports metadata for the namespace with base::namespaceExport
   # It will throw warnings if objects are already listed in the exports
   # metadata, so catch those warnings and ignore them.
@@ -65,33 +122,19 @@ parse_ns_file <- function(pkg) {
 }
 
 
-# Create the package environment and copy over objects from the
-# namespace environment
-attach_ns <- function(pkg, export_all = TRUE) {
-  pkg <- as.package(pkg)
-  nsenv <- ns_env(pkg)
-  pkgenv <- pkg_env(pkg, create = TRUE)
-
-  if (export_all) {
-    # Copy all the objects from namespace env to package env, so that they
-    # are visible in global env.
-    copy_env(nsenv, pkgenv,
-      ignore = c(".__NAMESPACE__.", ".__S3MethodsTable__.",
-        ".packageName", ".First.lib", ".onLoad", ".onAttach",
-        ".conflicts.OK", ".noGenerics"))
-
-  } else {
-    # Export only the objects specified in NAMESPACE
-    # This code from base::attachNamespace
-    exports <- getNamespaceExports(nsenv)
-    importIntoEnv(pkgenv, exports, nsenv, exports)
-  }
-}
-
+# Register the S3 methods for this package
 register_s3 <- function(pkg) {
   pkg <- as.package(pkg)
   nsInfo <- parse_ns_file(pkg)
 
   # Adapted from loadNamespace
   registerS3methods(nsInfo$S3methods, pkg$package, ns_env(pkg))
 }
+
+
+# Reports whether a package is loaded into a namespace. It may be
+# attached or not attached.
+is_loaded <- function(pkg = NULL) {
+  pkg <- as.package(pkg)
+  pkg$package %in% loadedNamespaces()
+}

R/package-deps.r

@@ -35,33 +35,6 @@ parse_deps <- function(string) {
   deps[names != "R", ]
 }
 
-#' Load all of the imports for a package
-#'
-#' The imported objects are copied to the imports environment, and are not
-#' visible from R_GlobalEnv. This will automatically load (but not attach)
-#' the dependency packages.
-#'
-#' @keywords internal
-load_imports <- function(pkg = NULL, deps = c("depends", "imports")) {
-  pkg <- as.package(pkg)
-
-  # Get data frame of dependency names and versions
-  deps <- lapply(pkg[deps], parse_deps)
-  deps <- Reduce(rbind, deps)
-
-  if (is.null(deps) || nrow(deps) == 0) return(invisible())
-
-  # If we've already loaded imports, don't load again (until load_all
-  # is run with reset=TRUE). This is to avoid warnings when running
-  # process_imports()
-  if (length(ls(imports_env(pkg))) > 0) return(invisible(deps))
-
-  mapply(check_dep_version, deps$name, deps$version, deps$compare)
-
-  process_imports(pkg)
-
-  invisible(deps)
-}
 
 #' Check that the version of an imported package satisfies the requirements
 #'
@@ -91,25 +64,3 @@ check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) {
   }
   return(TRUE)
 }
-
-
-
-# Load imported objects
-# The code in this function is taken from base::loadNamespace
-process_imports <- function(pkg) {
-  nsInfo <- parse_ns_file(pkg)
-  ns <- ns_env(pkg)
-  lib.loc <- NULL
-
-  ## process imports
-  for (i in nsInfo$imports) {
-    if (is.character(i))
-      namespaceImport(ns, loadNamespace(i))
-    else
-      namespaceImportFrom(ns, loadNamespace(i[[1L]]), i[[2L]])
-  }
-  for(imp in nsInfo$importClasses)
-    namespaceImportClasses(ns, loadNamespace(imp[[1L]]), imp[[2L]])
-  for(imp in nsInfo$importMethods)
-    namespaceImportMethods(ns, loadNamespace(imp[[1L]]), imp[[2L]])
-}