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
|
# 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, dev_packages = NULL) {
stopifnot(is_string(topic))
pieces <- strsplit(topic, ":::?")[[1]]
if (length(pieces) == 1) {
if (is.null(dev_packages)) {
pkgs <- dev_packages()
} else {
pkgs <- dev_packages
}
} else {
pkgs <- pieces[1]
topic <- pieces[2]
}
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)
}
|
