/
parseRd.R
80 lines (77 loc) · 1.97 KB
/
parseRd.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
#' Parse R documentation
#'
#' Modified version of `tools:::.Rd_get_metadata()` that keeps whitespace and
#' returns `character` instead of `matrix`.
#'
#' @export
#' @note Updated 2023-09-25.
#'
#' @param object `Rd`.
#' R documentation, returned from `tools::Rd_db()`.
#'
#' @param tag `character(1)`.
#' Desired metadata type.
#'
#' These types are supported:
#'
#' - `title`.
#' - `description`.
#' - `usage`.
#' - `arguments`.
#' - `value`.
#' - `references`.
#' - `seealso`.
#' - `examples`.
#'
#' @seealso
#' - `tools::Rd_db()`.
#'
#' @examples
#' db <- tools::Rd_db("base")
#' head(names(db))
#' rd <- db[["nrow.Rd"]]
#' print(rdTags(rd))
#' examples <- parseRd(rd, tag = "examples")
#' print(examples)
parseRd <-
function(object, tag) {
stopifnot(
.is(object, "Rd"),
.isString(tag)
)
tags <- rdTags(object)
stopifnot(.isSubset(tag, tags))
## Get the metadata that matches the requested tag.
data <- object[tags == tag]
data <- unlist(data, recursive = TRUE, use.names = FALSE)
## Strip trailing newlines and superfluous whitespace.
data <- trimws(data, which = "right")
## Strip leading and trailing carriage returns, if present.
if (identical(data[[1L]], "")) {
data <- data[-1L]
}
if (identical(data[[length(data)]], "")) {
data <- data[-length(data)]
}
data
}
#' @describeIn parseRd
#' Modified version of the unexported `tools:::RdTags()` function.
#' @export
rdTags <- # nolint
function(object) {
stopifnot(.is(object, "Rd"))
tags <- vapply(
X = object,
FUN = attr,
FUN.VALUE = character(1L),
"Rd_tag"
)
if (identical(length(tags), 0L)) {
tags <- character()
} else {
## Remove the leading "\\" backslashes.
tags <- sub(pattern = "^\\\\", replacement = "", x = tags)
}
tags
}