# copied from vctrs: https://github.com/r-lib/vctrs/blob/master/R/register-s3.R
#' Register an s3 method
#'
#' This is a reimplementation of `vctrs::s3_register()`, implemented here
#' to avoid having to take a dependency on vctrs.
#'
#' @param generic Name of the generic in the form `pkg::generic`.
#' @param class Name of the class
#' @param method Optionally, the implementation of the method. By default,
#' this will be found by looking for a function called `generic.class`
#' in the package environment.
#'
#' Note that providing `method` can be dangerous if you use
#' devtools. When the namespace of the method is reloaded by
#' `devtools::load_all()`, the function will keep inheriting from
#' the old namespace. This might cause crashes because of dangling
#' `.Call()` pointers.
#'
#' @return Invisible `NULL`, called for side effects.
#'
#' @export
#' @keywords internal
#'
s3_register <- function(generic, class, method = NULL) {
stopifnot(is.character(generic), length(generic) == 1)
stopifnot(is.character(class), length(class) == 1)
pieces <- strsplit(generic, "::")[[1]]
stopifnot(length(pieces) == 2)
package <- pieces[[1]]
generic <- pieces[[2]]
caller <- parent.frame()
get_method_env <- function() {
top <- topenv(caller)
if (isNamespace(top)) {
asNamespace(environmentName(top))
} else {
caller
}
}
get_method <- function(method, env) {
if (is.null(method)) {
get(paste0(generic, ".", class), envir = get_method_env())
} else {
method
}
}
register <- function(...) {
envir <- asNamespace(package)
# Refresh the method each time, it might have been updated by
# `devtools::load_all()`
method_fn <- get_method(method)
stopifnot(is.function(method_fn))
# Only register if generic can be accessed
if (exists(generic, envir)) {
registerS3method(generic, class, method_fn, envir = envir)
} else if (identical(Sys.getenv("NOT_CRAN"), "true")) {
warning(sprintf(
"Can't find generic `%s` in package %s to register S3 method.",
generic,
package
))
}
}
# Always register hook in case package is later unloaded & reloaded
setHook(packageEvent(package, "onLoad"), register)
# Avoid registration failures during loading (pkgload or regular)
if (isNamespaceLoaded(package)) {
register()
}
invisible()
}
# keep track of which widget (e.g. "vl5", "vl4") we are using
vw_env <- rlang::env(rlang::empty_env())
.onLoad <- function(...) {
s3_register("knitr::knit_print", "vegaspec")
vw_env$widget = .widget_default # set default
vw_env$is_locked = FALSE
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.