Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

92 lines (74 sloc) 2.276 kB
# Tools for indexing package documentation by alias, and for finding
# the rd file for a given topic (alias).
# @return path to rd file within package
find_pkg_topic <- function(pkg = ".", topic) {
pkg <- as.package(pkg)
# First see if a man file of that name exists
man <- file.path(pkg$path, "man", topic)
if (file.exists(man)) return(basename(man))
# Next, look in index
index <- topic_index(pkg)
if (topic %in% names(index)) return(index[[topic]])
# Finally, try adding .Rd to name
man_rd <- file.path(pkg$path, "man", paste0(topic, ".Rd"))
if (file.exists(man_rd)) return(basename(man_rd))
NULL
}
#' Find the rd file that documents a topic.
#'
#' Only packages loaded by devtools are searched.
#'
#' @param topic The topic, a string.
#' @return A named string. The values gives the path to file; the name gives
#' the path to package.
#' @export
#' @keywords internal
#' @examples
#' find_topic("help")
find_topic <- function(topic) {
if (is.null(topic) || topic == "") return(NULL)
pieces <- strsplit(topic, "::")[[1]]
if (length(pieces) == 1) {
pkgs <- dev_packages()
} else {
pkgs <- pieces[1]
topic <- pieces[2]
}
for (pkg in pkgs) {
path <- getNamespaceInfo(pkg, "path")
rd <- find_pkg_topic(path, topic)
if (!is.null(rd)) return(stats::setNames(file.path(path, "man", rd), path))
}
NULL
}
topic_indices <- new.env(parent = emptyenv())
topic_index <- function(pkg = ".") {
pkg <- as.package(pkg)
if (!exists(pkg$package, topic_indices)) {
topic_indices[[pkg$package]] <- build_topic_index(pkg)
}
topic_indices[[pkg$package]]
}
clear_topic_index <- function(pkg = ".") {
pkg <- as.package(pkg)
if (exists(pkg$package, topic_indices)) {
rm(list = pkg$package, envir = topic_indices)
}
invisible(TRUE)
}
build_topic_index <- function(pkg = ".") {
pkg <- as.package(pkg)
rds <- rd_files(pkg)
aliases <- function(path) {
parsed <- tools::parse_Rd(path)
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)
}
Jump to Line
Something went wrong with that request. Please try again.