Use namespace prefixes in find_scale()/validate_guide()

R/guides-.R

@@ -915,8 +915,19 @@ include_layer_in_guide <- function(layer, matched) {
 validate_guide <- function(guide) {
   # if guide is specified by character, then find the corresponding guide
   if (is.character(guide)) {
-    fun <- find_global(paste0("guide_", guide), env = global_env(),
-                       mode = "function")
+    check_string(guide, allow_empty = FALSE)
+    search_env <- list(global_env())
+    if (isTRUE(grepl("::", guide))) {
+      # Append prefix as namespaces to search environments
+      prefix <- sub("::.*", "", guide)
+      search_env <- c(search_env, list(as_namespace(prefix)))
+      # Remove prefix from guide name
+      guide <- sub(".*::", "", guide)
+    }
+    fun <- find_global(
+      paste0("guide_", guide),
+      env = search_env, mode = "function"
+    )
     if (is.function(fun)) {
       guide <- fun()
     }

R/scale-type.R

@@ -7,10 +7,18 @@ find_scale <- function(aes, x, env = parent.frame()) {
   }
 
   type <- scale_type(x)
-  candidates <- paste("scale", aes, type, sep = "_")
 
-  for (scale in candidates) {
-    scale_f <- find_global(scale, env, mode = "function")
+  for (scale in type) {
+    search_env <- list(env)
+    if (isTRUE(grepl("::", scale))) {
+      # Append prefix as namepaces to search environments
+      prefix <- sub("::.*", "", scale)
+      search_env <- c(search_env, list(as_namespace(prefix)))
+      # Remove prefix from scale name
+      scale <- sub(".*::", "", scale)
+    }
+    scale <- paste("scale", aes, scale, sep = "_")
+    scale_f <- find_global(scale, search_env, mode = "function")
     if (!is.null(scale_f)) {
       sc <- scale_f()
       sc$call <- parse_expr(paste0(scale, "()"))
@@ -29,18 +37,28 @@ find_scale <- function(aes, x, env = parent.frame()) {
 # ggplot2 namespace environment.  This makes it possible to override default
 # scales by setting them in the parent environment.
 find_global <- function(name, env, mode = "any") {
-  if (exists(name, envir = env, mode = mode)) {
-    return(get(name, envir = env, mode = mode))
+
+  if (!is.list(env)) {
+    env <- list(env)
   }
+  env <- c(env, list(as_namespace("ggplot2")))
 
-  nsenv <- asNamespace("ggplot2")
-  if (exists(name, envir = nsenv, mode = mode)) {
-    return(get(name, envir = nsenv, mode = mode))
+  for (e in env) {
+    if (exists(name, envir = e, mode = mode)) {
+      return(get(name, envir = e, mode = mode))
+    }
   }
 
   NULL
 }
 
+# This exists for testing purposes (mocking) only
+as_namespace <- function(...) NULL
+on_load({
+  as_namespace <- base::asNamespace
+})
+
+
 #' Determine default scale type
 #'
 #' You will need to define a method for this method if you want to extend

tests/testthat/_snaps/guides.md

@@ -37,6 +37,10 @@
 
     `nrow` * `ncol` needs to be larger than the number of breaks (5).
 
+# validate_guide finds guides with namespace prefixes
+
+    Unknown guide: bar
+
 # get_guide_data retrieves keys appropriately
 
     Code

tests/testthat/test-guides.R

@@ -51,6 +51,34 @@ test_that("guide specifications are properly checked", {
   expect_snapshot_error(ggplotGrob(p))
 })
 
+
+test_that("validate_guide finds guides with namespace prefixes", {
+
+  # Mock foo::bar as namespace
+  fake_namespace <- new_environment()
+  env_bind(
+    fake_namespace,
+    guide_bar = function(...) guide_legend(title = "bar", ...)
+  )
+
+  local_mocked_bindings(
+    as_namespace = function(ns, ...) {
+      if (identical(ns, "foo")) {
+        return(fake_namespace)
+      } else {
+        base::asNamespace(ns, ...)
+      }
+    }
+  )
+
+  # Without prefix, we don't know here to look for guide_bar
+  expect_snapshot_error(validate_guide("bar"))
+  # With prefix, we know the namespace where to look for guide_bar
+  g <- validate_guide("foo::bar")
+  expect_true(is_guide(g))
+  expect_equal(g$params$title, "bar")
+})
+
 test_that("guide_coloursteps and guide_bins return ordered breaks", {
   scale <- scale_colour_viridis_c(breaks = c(2, 3, 1))
   scale$train(c(0, 4))

tests/testthat/test-scale-type.R

@@ -24,3 +24,41 @@ test_that("find_scale gives sensible calls to scales", {
     quote(scale_colour_discrete())
   )
 })
+
+test_that("find_scale finds scales with namespace prefixes", {
+
+  # Mock foo::bar as namespace
+  fake_namespace <- new_environment()
+  env_bind(
+    fake_namespace,
+    scale_x_bar = function(...) scale_x_continuous(name = "barname")
+  )
+
+  local_mocked_bindings(
+    as_namespace = function(ns, ...) {
+      if (identical(ns, "foo")) {
+        return(fake_namespace)
+      } else {
+        base::asNamespace(ns, ...)
+      }
+    }
+  )
+
+  # No loaded namespace has a scale_x_bar
+  registerS3method(
+    "scale_type", "bar",
+    method = function(x) "bar"
+  )
+
+  sc <- find_scale("x", structure(1, class = "bar"))
+  expect_null(sc)
+
+  # With prefix, we know the namespace where to look for scale_x_bar
+  registerS3method(
+    "scale_type", "bar",
+    method = function(x) "foo::bar"
+  )
+
+  sc <- find_scale("x", structure(1, class = "bar"))
+  expect_equal(sc$name, "barname")
+})