Repository navigation
Expand file tree
/
Copy pathdev-topic.R
More file actions
136 lines (109 loc) · 3.3 KB
/
Copy pathdev-topic.R
File metadata and controls
136 lines (109 loc) · 3.3 KB
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
# Tools for indexing package documentation by alias, and for finding
# the rd file for a given topic (alias).
rd_files <- function(path) {
path <- pkg_path(path)
path_man <- package_file("man", path = path)
files <- dir(path_man, pattern = "\\.[Rr]d$", full.names = TRUE)
names(files) <- basename(files)
sort_ci(files)
}
#' @rdname dev_help
#' @export
dev_topic_find <- function(topic, dev_packages = NULL) {
topic <- dev_topic_parse(topic, dev_packages)
for (pkg_name in topic$pkg_names) {
path <- dev_topic_path(topic$topic, path = ns_path(pkg_name))
if (!is.null(path)) {
return(list(path = path, pkg = pkg_name))
}
}
NULL
}
dev_topic_parse <- function(topic, packages = NULL) {
stopifnot(is_string(topic))
# Only treat `::`/`:::` as a namespace qualifier when preceded by a valid
# package name at the start. Otherwise `::` may appear inside an S7 method
# alias like `fn,pkg::Class-method`.
m <- regmatches(topic, regexec("^([a-zA-Z][a-zA-Z0-9.]*):::?(.+)$", topic))[[
1
]]
if (length(m) == 3) {
pkgs <- m[[2]]
topic <- m[[3]]
} else {
pkgs <- packages %||% dev_packages()
}
list(
topic = topic,
pkg_names = pkgs
)
}
dev_topic_path <- function(topic, path = ".") {
# Don't interpret the division operator as a path (#198)
if (is_string(topic, "/")) {
return(NULL)
}
path <- pkg_path(path)
# First see if a man file of that name exists
man <- package_file("man", topic, path = path)
if (file.exists(man)) {
return(man)
}
# Next, look in index
index <- dev_topic_index(path)
if (topic %in% names(index)) {
return(package_file("man", last(index[[topic]]), path = path))
}
# Finally, try adding .Rd to name
man_rd <- package_file("man", paste0(topic, ".Rd"), path = path)
if (file.exists(man_rd)) {
return(man_rd)
}
NULL
}
# Cache -------------------------------------------------------------------
dev_topic_indices <- new.env(parent = emptyenv())
#' @rdname dev_help
#' @param path Path to package.
#' @export
dev_topic_index <- function(path = ".") {
path <- pkg_path(path)
package <- pkg_name(path)
if (!exists(pkg_name(path), dev_topic_indices)) {
dev_topic_indices[[package]] <- build_topic_index(path)
}
dev_topic_indices[[package]]
}
#' @rdname dev_help
#' @param pkg_name Name of package.
#' @export
dev_topic_index_reset <- function(pkg_name) {
if (exists(pkg_name, dev_topic_indices)) {
rm(list = pkg_name, envir = dev_topic_indices)
}
invisible(TRUE)
}
# Topic index -------------------------------------------------------------
build_topic_index <- function(path = ".") {
path <- pkg_path(path)
macros <- load_rd_macros(path)
rds <- rd_files(path)
# Pass `permissive = TRUE` to suppress warnings about unknown
# macros (#119). It is unlikely that a macro generates `name` or
# `alias` commands, so we shouldn't be missing any topics from
# unknown macros.
aliases <- function(path) {
parsed <- tools::parse_Rd(path, macros = macros, permissive = TRUE)
tags <- vapply(parsed, function(x) attr(x, "Rd_tag")[[1]], character(1))
unlist(parsed[tags == "\\alias"])
}
invert(lapply(rds, aliases))
}
invert <- function(L) {
if (length(L) == 0) {
return(L)
}
t1 <- unlist(L)
names(t1) <- rep(names(L), lapply(L, length))
tapply(names(t1), t1, c)
}