-
Notifications
You must be signed in to change notification settings - Fork 207
/
zzz.R
88 lines (78 loc) · 3.23 KB
/
zzz.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
# nocov start
.onLoad <- function(libname, pkgname) {
## CCTZ needs zoneinfo. On windows we set it to R's own zoneinfo. On unix like
## it's in "/usr/share/zoneinfo" where CCTZ looks by default. On some systems
## (solaris, osx) it might be in a different location. So, help ourselves by
## setting the TZDIR env var, but only if it's not already set.
if (Sys.getenv("TZDIR") == "") {
## adapted from OlsonNames function
tzdir <-
if (.Platform$OS.type == "windows") {
file.path(R.home("share"), "zoneinfo")
} else if (!file.exists("/usr/share/zoneinfo")) {
tzdirs <- c(file.path(R.home("share"), "zoneinfo"),
"/usr/share/lib/zoneinfo", "/usr/lib/zoneinfo",
"/usr/local/etc/zoneinfo", "/etc/zoneinfo",
"/usr/etc/zoneinfo")
tzdirs <- tzdirs[file.exists(tzdirs)]
if (length(tzdirs)) tzdirs[[1]]
else NULL
}
if (!is.null(tzdir)) {
Sys.setenv(TZDIR = tzdir)
}
}
on_package_load("vctrs", {
register_s3_method("vctrs", "vec_proxy", "Period")
register_s3_method("vctrs", "vec_proxy_compare", "Period")
register_s3_method("vctrs", "vec_proxy_equal", "Period")
register_s3_method("vctrs", "vec_restore", "Period")
register_s3_method("vctrs", "vec_ptype2", "Period.Period")
register_s3_method("vctrs", "vec_cast", "Period.Period")
register_s3_method("vctrs", "vec_proxy", "Duration")
register_s3_method("vctrs", "vec_proxy_compare", "Duration")
register_s3_method("vctrs", "vec_proxy_equal", "Duration")
register_s3_method("vctrs", "vec_restore", "Duration")
register_s3_method("vctrs", "vec_ptype2", "Duration.Duration")
register_s3_method("vctrs", "vec_ptype2", "Duration.difftime")
register_s3_method("vctrs", "vec_ptype2", "difftime.Duration")
register_s3_method("vctrs", "vec_cast", "Duration.Duration")
register_s3_method("vctrs", "vec_cast", "Duration.difftime")
register_s3_method("vctrs", "vec_cast", "difftime.Duration")
register_s3_method("vctrs", "vec_proxy", "Interval")
register_s3_method("vctrs", "vec_proxy_compare", "Interval")
register_s3_method("vctrs", "vec_proxy_equal", "Interval")
register_s3_method("vctrs", "vec_restore", "Interval")
register_s3_method("vctrs", "vec_ptype2", "Interval.Interval")
register_s3_method("vctrs", "vec_cast", "Interval.Interval")
})
}
register_s3_method <- function(pkg, generic, class, fun = NULL) {
stopifnot(is.character(pkg), length(pkg) == 1)
stopifnot(is.character(generic), length(generic) == 1)
stopifnot(is.character(class), length(class) == 1)
if (is.null(fun)) {
fun <- get(paste0(generic, ".", class), envir = parent.frame())
} else {
stopifnot(is.function(fun))
}
if (pkg %in% loadedNamespaces()) {
registerS3method(generic, class, fun, envir = asNamespace(pkg))
}
# Always register hook in case package is later unloaded & reloaded
setHook(
packageEvent(pkg, "onLoad"),
function(...) {
registerS3method(generic, class, fun, envir = asNamespace(pkg))
}
)
}
on_package_load <- function(pkg, expr) {
if (isNamespaceLoaded(pkg)) {
expr
} else {
thunk <- function(...) expr
setHook(packageEvent(pkg, "onLoad"), thunk)
}
}
#nocov end