diff --git a/R/guides-.R b/R/guides-.R index fa50f5a79d..711c7bc225 100644 --- a/R/guides-.R +++ b/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() } diff --git a/R/scale-type.R b/R/scale-type.R index e9f3b8cc9b..e20a9b8eb8 100644 --- a/R/scale-type.R +++ b/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 diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index a47fba746b..e7c02b78e0 100644 --- a/tests/testthat/_snaps/guides.md +++ b/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 diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index ae1bfe85bd..a75a46ebb1 100644 --- a/tests/testthat/test-guides.R +++ b/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)) diff --git a/tests/testthat/test-scale-type.R b/tests/testthat/test-scale-type.R index 3ca1f06637..c894a51e82 100644 --- a/tests/testthat/test-scale-type.R +++ b/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") +})