1#' @import stringr
2NULL
3
4#' Roclet: make Rd files.
5#'
6#' @template rd
7#' @family roclets
8#' @eval rd_roclet_description()
9#' @export
10#' @examples
11#' #' The length of a string (in characters)
12#' #'
13#' #' @param x String input character vector
14#' #' @return An integer vector the same length as `x`.
15#' #'   `NA` strings have `NA` length.
16#' #' @seealso [nchar()]
17#' #' @export
18#' #' @examples
19#' #' str_length(letters)
20#' #' str_length(c("i", "like", "programming", NA))
21#' str_length <- function(x) {
22#' }
23rd_roclet <- function() {
24  roclet("rd")
25}
26
27rd_roclet_description <- function() {
28  c(
29    "@description",
30    "Generally you will not call this function directly",
31    "but will instead use roxygenise() specifying the rd roclet"
32  )
33}
34
35#' @export
36roclet_process.roclet_rd <- function(x, blocks, env, base_path) {
37
38  # Convert each block into a topic, indexed by filename
39  topics <- RoxyTopics$new()
40
41  for (block in blocks) {
42    rd <- block_to_rd(block, base_path, env)
43    topics$add(rd)
44  }
45  topics_process_family(topics, env)
46  topics_process_inherit(topics, env)
47  topics$drop_invalid()
48  topics_fix_params_order(topics)
49  topics_add_default_description(topics)
50
51  topics$topics
52}
53
54#' @export
55roclet_output.roclet_rd <- function(x, results, base_path, ..., is_first = FALSE) {
56  man <- normalizePath(file.path(base_path, "man"))
57
58  contents <- map_chr(results, format)
59  paths <- file.path(man, names(results))
60
61  # Always check for roxygen2 header before overwriting NAMESPACE (#436),
62  # even when running for the first time
63  mapply(write_if_different, paths, contents, MoreArgs = list(check = TRUE))
64
65  if (!is_first) {
66    # Automatically delete any files in man directory that were generated
67    # by roxygen in the past, but weren't generated in this sweep.
68
69    old_paths <- setdiff(dir(man, full.names = TRUE), paths)
70    old_paths <- old_paths[!file.info(old_paths)$isdir]
71    old_roxygen <- Filter(made_by_roxygen, old_paths)
72    if (length(old_roxygen) > 0) {
73      message(paste0("Deleting ", basename(old_roxygen), collapse = "\n"))
74      unlink(old_roxygen)
75    }
76  }
77
78  paths
79}
80
81#' @export
82roclet_clean.roclet_rd <- function(x, base_path) {
83  rd <- dir(file.path(base_path, "man"), full.names = TRUE)
84  rd <- rd[!file.info(rd)$isdir]
85  unlink(purrr::keep(rd, made_by_roxygen))
86}
87
88# Does this block get an Rd file?
89needs_doc <- function(block) {
90  if (block_has_tags(block, "noRd")) {
91    return(FALSE)
92  }
93
94  block_has_tags(block, c(
95    "description", "param", "return", "title", "example",
96    "examples", "name", "rdname", "details", "inherit", "describeIn")
97  )
98}
99
100# Tag processing functions ------------------------------------------------
101
102block_to_rd <- function(block, base_path, env) {
103  UseMethod("block_to_rd")
104}
105
106#' @export
107
108block_to_rd.default <- function(block, ...) {
109  stop("Internal roxygen error, unknown block type")
110}
111
112#' @export
113
114block_to_rd.roxy_block <- function(block, base_path, env) {
115  # Must start by processing templates
116  block <- process_templates(block, base_path)
117
118  if (!needs_doc(block)) {
119    return()
120  }
121
122  name <- block_get_tag(block, "name")$val %||% block$object$topic
123  if (is.null(name)) {
124    roxy_tag_warning(block$tags[[1]], "Missing name")
125    return()
126  }
127
128  rd <- RoxyTopic$new()
129  topic_add_name_aliases(rd, block, name)
130  for (tag in block$tags) {
131    rd$add(roxy_tag_rd(tag, env = env, base_path = base_path))
132  }
133
134  if (rd$has_section("description") && rd$has_section("reexport")) {
135    roxy_tag_warning(block$tags[[1]], "Can't use description when re-exporting")
136    return()
137  }
138
139  describe_rdname <- topic_add_describe_in(rd, block, env)
140  filename <- describe_rdname %||% block_get_tag(block, "rdname")$val %||% nice_name(name)
141  rd$filename <- paste0(filename, ".Rd")
142
143  rd
144}
145
146#' @export
147
148block_to_rd.roxy_block_r6class <- function(block, base_path, env) {
149
150  r6on <- roxy_meta_get("r6", TRUE)
151  if (!isTRUE(r6on)) return(NextMethod())
152
153  # Must start by processing templates
154  block <- process_templates(block, base_path)
155
156  if (!needs_doc(block)) {
157    return()
158  }
159
160  name <- block_get_tag(block, "name")$val %||% block$object$topic
161  if (is.null(name)) {
162    roxy_tag_warning(block$tags[[1]], "Missing name")
163    return()
164  }
165
166  rd <- RoxyTopic$new()
167  topic_add_name_aliases(rd, block, name)
168
169  rd$add(roxy_tag_rd(block_get_tag(block, "name"), env = env, base_path = base_path))
170  rd$add(roxy_tag_rd(block_get_tag(block, "title"), env = env, base_path = base_path))
171
172  if (rd$has_section("description") && rd$has_section("reexport")) {
173    roxy_tag_warning(block$tags[[1]], "Can't use description when re-exporting")
174    return()
175  }
176
177  topic_add_r6_methods(rd, block, env)
178
179  describe_rdname <- topic_add_describe_in(rd, block, env)
180  filename <- describe_rdname %||% block_get_tag(block, "rdname")$val %||% nice_name(name)
181  rd$filename <- paste0(filename, ".Rd")
182
183  rd
184}
185
186# Special cases -----------------------------------------------------------
187
188topics_add_default_description <- function(topics) {
189  for (topic in topics$topics) {
190    if (length(topic$get_section("description")) > 0)
191      next
192
193    # rexport manually generates a own description, so don't need to
194    if (!topic$has_section("reexport") &&
195        !identical(topic$get_value("docType"), "package")) {
196      topic$add(rd_section("description", topic$get_value("title")))
197    }
198  }
199
200  invisible()
201}
202
203# Tag-wise processing -----------------------------------------------------
204
205#' Generate Rd output from a tag
206#'
207#' Provide a method for this generic if you want a tag to generate output
208#' in `.Rd` files. See `vignette("extending")` for more details.
209#'
210#' @param x The tag
211#' @param base_path Path to package root directory.
212#' @param env Environment in which to evaluate code (if needed)
213#' @return Methods must return a [rd_section].
214#' @export
215#' @keywords internal
216roxy_tag_rd <- function(x, base_path, env) {
217  UseMethod("roxy_tag_rd")
218}
219
220roxy_tag_rd.default <- function(x, base_path, env) {
221}
222
223# Special tags ------------------------------------------------------------
224# These tags do not directly affect the output, and are no complicated enough
225# to require their own files.
226
227#' @export
228roxy_tag_rd.roxy_tag_.formals <- function(x, base_path, env) {
229  rd_section("formals", x$val)
230}
231#' @export
232format.rd_section_formals <- function(x, ...) NULL
233
234
235#' @export
236roxy_tag_parse.roxy_tag_method <- function(x) tag_words(x, 2, 2)
237
238#' @export
239roxy_tag_parse.roxy_tag_noRd <- function(x) tag_toggle(x)
240
241#' @export
242roxy_tag_parse.roxy_tag_rdname <- function(x) tag_value(x)
243